summaryrefslogtreecommitdiff
path: root/lisp/international/textsec.el
diff options
context:
space:
mode:
authorLars Ingebrigtsen <larsi@gnus.org>2022-01-20 07:57:13 +0100
committerLars Ingebrigtsen <larsi@gnus.org>2022-01-20 07:57:13 +0100
commitf9f12086fb9ec037b36f74d1f12daa144c775249 (patch)
tree727f19b43aa838c3a7482cb4e407c698b1d2f22f /lisp/international/textsec.el
parent7e7974154b902f53dd1646ec0246b9e8b7c32824 (diff)
downloademacs-f9f12086fb9ec037b36f74d1f12daa144c775249.tar.gz
emacs-f9f12086fb9ec037b36f74d1f12daa144c775249.tar.bz2
emacs-f9f12086fb9ec037b36f74d1f12daa144c775249.zip
Expand textsec-link-suspicious-p checking
* lisp/international/textsec.el (textsec-link-suspicious-p): Check the text more thoroughly for link-like things.
Diffstat (limited to 'lisp/international/textsec.el')
-rw-r--r--lisp/international/textsec.el44
1 files changed, 28 insertions, 16 deletions
diff --git a/lisp/international/textsec.el b/lisp/international/textsec.el
index 6b37e925698..017eb5dc9c4 100644
--- a/lisp/international/textsec.el
+++ b/lisp/international/textsec.el
@@ -389,22 +389,34 @@ 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)))))
+ (let* ((url (car link))
+ (text (string-trim (cdr link)))
+ (text-bits (seq-filter (lambda (bit)
+ (string-match-p "\\`[^.]+\\.[^.]+.*\\'" 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)))
+ (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)))))))))
(provide 'textsec)