Add text for suspicious links

* lisp/international/textsec-check.el (textsec-check): Note `link'.
(textsec-propertize): Fix typo.

* lisp/international/textsec.el (textsec-link-suspicious-p): New
function.

* lisp/net/shr.el (shr-tag-a): Check for sus links.

diff --git a/lisp/international/textsec-check.el b/lisp/international/textsec-check.el
index 464845d5b63485940019183c1204ff9f38d5b04c..8f641e5a66d8b777a3202724289129c47bd6e0cb 100644 (file)
--- a/lisp/international/textsec-check.el
+++ b/lisp/international/textsec-check.el
@@ -44,8 +44,8 @@ If nil, these checks are disabled."
 If STRING is suspicious, a string explaining the possible problem
 is returned.
 
-Available types include `url', `domain', `local-address', `name',
-`email-address', and `email-address-headers'.
+Available types include `url', `link', `domain', `local-address',
+`name', `email-address', and `email-address-headers'.
 
 If the `textsec-check' user option is nil, these checks are
 disabled, and this function always returns nil."
@@ -67,7 +67,7 @@ verbatim.
 
 See `texsec-check' for further information about TYPE."
   (let ((warning (textsec-check string type)))
-    (if (not wardning)
+    (if (not warning)
         string
       (propertize string
                   'face 'textsec-suspicious

diff --git a/lisp/international/textsec.el b/lisp/international/textsec.el
index 4e9fb10ad77f4fef45014f14cc387c29326910fe..89ef38e93e05999b188b7b83e5d9ea50b72f0d9c 100644 (file)
--- a/lisp/international/textsec.el
+++ b/lisp/international/textsec.el
@@ -376,6 +376,32 @@ potential problem."
     (and (url-host parsed)
          (textsec-domain-suspicious-p (url-host parsed)))))
 
+(defun textsec-link-suspicious-p (link)
+  "Say whether LINK is suspicious.
+LINK should be a cons cell where the first element is the URL,
+and the second element is the link text.
+
+This function will return non-nil if it seems like the link text
+is misleading about where the URL takes you.  This is typical
+when the link text looks like an URL itself, but doesn't lead to
+the same domain as the URL."
+  (let ((url (car link))
+        (text (string-trim (cdr link))))
+    (when (string-match-p "\\`[a-z]+\\.[.a-z]+\\'" text)
+      (setq text (concat "http://" text)))
+    (let ((udomain (url-host (url-generic-parse-url url)))
+          (tdomain (url-host (url-generic-parse-url text))))
+      (and udomain
+           tdomain
+           (not (equal udomain tdomain))
+           ;; One may be a sub-domain of the other, but don't allow too
+           ;; short domains.
+           (not (or (and (string-suffix-p udomain tdomain)
+                         (url-domsuf-cookie-allowed-p udomain))
+                    (and (string-suffix-p tdomain udomain)
+                         (url-domsuf-cookie-allowed-p tdomain))))
+           (format "Text `%s' doesn't point to link URL `%s'" text url)))))
+
 (provide 'textsec)
 
 ;;; textsec.el ends here

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index c3950acd3d8f889fe6e826668b5cd3e83edcd883..79a8e9ba2629fd5e988f99597770c43106062702 100644 (file)
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1469,7 +1469,12 @@ ones, in case fg and bg are nil."
     (when url
       (shr-urlify (or shr-start start) (shr-expand-url url) title)
       ;; Check whether the URL is suspicious.
-      (when-let ((warning (textsec-check (shr-expand-url url) 'url)))
+      (when-let ((warning (or (textsec-check (shr-expand-url url) 'url)
+                              (textsec-check (cons (shr-expand-url url)
+                                                   (buffer-substring
+                                                    (or shr-start start)
+                                                    (point)))
+                                             'link))))
         (add-text-properties (or shr-start start) (point)
                              (list 'face '(shr-link textsec-suspicious)))
         (insert (propertize "⚠️" 'help-echo warning))))))

diff --git a/test/lisp/international/textsec-tests.el b/test/lisp/international/textsec-tests.el
index c7cf56757cd34b09f11a30dbc886b70278781bea..416490aa085f283c44de69b09dde86cf181a14b4 100644 (file)
--- a/test/lisp/international/textsec-tests.el
+++ b/test/lisp/international/textsec-tests.el
@@ -168,4 +168,22 @@
   (should-not (textsec-url-suspicious-p "http://example.ru/bar"))
   (should (textsec-url-suspicious-p "http://Сгсе.ru/bar")))
 
+(ert-deftest test-suspicious-link ()
+  (should-not (textsec-link-suspicious-p
+               (cons "https://gnu.org/" "Hello")))
+  (should-not (textsec-link-suspicious-p
+               (cons "https://gnu.org/" "https://gnu.org/")))
+  (should-not (textsec-link-suspicious-p
+               (cons "https://gnu.org/" "https://www.gnu.org/")))
+  (should-not (textsec-link-suspicious-p
+               (cons "https://www.gnu.org/" "https://gnu.org/")))
+  (should (textsec-link-suspicious-p
+           (cons "https://www.gnu.org/" "https://org/")))
+  (should (textsec-link-suspicious-p
+           (cons "https://www.gnu.org/" "https://fsf.org/")))
+  (should (textsec-link-suspicious-p
+           (cons "https://www.gnu.org/" "http://fsf.org/")))
+  (should (textsec-link-suspicious-p
+           (cons "https://www.gnu.org/" "fsf.org"))))
+
 ;;; textsec-tests.el ends here