master cce813a4e7: Make textsec-link-suspicious-p less mistrustful

[Lars Ingebrigtsen]

branch: master
commit cce813a4e70324956d6546102e26dbb312319bbd
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Make textsec-link-suspicious-p less mistrustful
    
    * lisp/international/textsec.el (textsec-link-suspicious-p): Scale
    back the suspicion -- only warn about texts that contain a full
    explicit link.
---
 lisp/international/textsec.el            | 59 ++++++++++++--------------------
 test/lisp/international/textsec-tests.el |  8 +----
 2 files changed, 23 insertions(+), 44 deletions(-)

diff --git a/lisp/international/textsec.el b/lisp/international/textsec.el
index 09337548de..223c0d5c92 100644
--- a/lisp/international/textsec.el
+++ b/lisp/international/textsec.el
@@ -400,44 +400,29 @@ 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)))
-         (text-bits
-          (seq-filter
-           (lambda (bit)
-             (and (string-match-p "\\`[^.[:punct:]]+\\.[^.[:punct:]]+\\'" bit)
-                  ;; All-numerical texts are probably not
-                  ;; suspicious (but what about IP addresses?).
-                  (not (string-match-p "\\`[0-9.]+\\'" bit))))
-           (split-string text))))
-    (when text-bits
-      (setq text-bits (seq-map (lambda (string)
-                                 (if (not (string-match-p "\\`[^:]+:" string))
-                                     (concat "http://"; string)
-                                   string))
-                               text-bits)))
+         (text (string-trim (cdr link))))
     (catch 'found
-      (dolist (text (or text-bits (list text)))
-        (let ((udomain (url-host (url-generic-parse-url url)))
-              (tdomain (url-host (url-generic-parse-url text))))
-          (cond
-           ((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)))))
-            (throw 'found
-                   (format "Text `%s' doesn't point to link URL `%s'"
-                           text url)))
-           ((and tdomain
-                 (textsec-domain-suspicious-p tdomain))
-            (throw 'found
-                   (format "Domain `%s' in the link text is suspicious"
-                           (bidi-string-strip-control-characters
-                            tdomain))))))))))
+      (let ((udomain (url-host (url-generic-parse-url url)))
+            (tdomain (url-host (url-generic-parse-url text))))
+        (cond
+         ((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)))))
+          (throw 'found
+                 (format "Text `%s' doesn't point to link URL `%s'"
+                         text url)))
+         ((and tdomain
+               (textsec-domain-suspicious-p tdomain))
+          (throw 'found
+                 (format "Domain `%s' in the link text is suspicious"
+                         (bidi-string-strip-control-characters
+                          tdomain)))))))))
 
 (provide 'textsec)
 
diff --git a/test/lisp/international/textsec-tests.el 
b/test/lisp/international/textsec-tests.el
index d9cba57982..c3c7e9b59a 100644
--- a/test/lisp/international/textsec-tests.el
+++ b/test/lisp/international/textsec-tests.el
@@ -196,15 +196,9 @@
            (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")))
-
-  (should (textsec-link-suspicious-p
-           (cons "https://www.gnu.org/";
-                 "This is a link that doesn't point to fsf.org")))
 
   (should (textsec-link-suspicious-p
            (cons "https://www.gn\N{LEFT-TO-RIGHT ISOLATE}u.org/"
-                 "gn\N{LEFT-TO-RIGHT ISOLATE}u.org"))))
+                 "https://gn\N{LEFT-TO-RIGHT ISOLATE}u.org"))))
 
 ;;; textsec-tests.el ends here