[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 1bfc086391: Make shr mark links with suspicious URLs
From: |
Lars Ingebrigtsen |
Subject: |
master 1bfc086391: Make shr mark links with suspicious URLs |
Date: |
Wed, 19 Jan 2022 10:37:18 -0500 (EST) |
branch: master
commit 1bfc086391c3ee0ae8a5ae667b67f1109aa74dc9
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Make shr mark links with suspicious URLs
* lisp/international/textsec-check.el (textsec-propertize): New
function.
(textsec-check): Only check, don't alter STRING.
* lisp/international/textsec.el (textsec-url-suspicious-p): New
function.
* lisp/net/shr.el (shr-tag-a): Mark suspicious links.
---
lisp/international/textsec-check.el | 35 +++++++++++++++++++++-----------
lisp/international/textsec.el | 8 ++++++++
lisp/net/shr.el | 7 ++++++-
test/lisp/international/textsec-tests.el | 4 ++++
4 files changed, 41 insertions(+), 13 deletions(-)
diff --git a/lisp/international/textsec-check.el
b/lisp/international/textsec-check.el
index ff1b985d93..464845d5b6 100644
--- a/lisp/international/textsec-check.el
+++ b/lisp/international/textsec-check.el
@@ -41,26 +41,37 @@ If nil, these checks are disabled."
;;;###autoload
(defun textsec-check (string type)
"Test whether STRING is suspicious when considered as TYPE.
-If STRING is suspicious, text properties will be added to the
-string to mark it as suspicious, and with tooltip texts that says
-what's suspicious about it.
+If STRING is suspicious, a string explaining the possible problem
+is returned.
-Available types include `domain', `local-address', `name',
+Available types include `url', `domain', `local-address', `name',
`email-address', and `email-address-headers'.
-If the `textsec-check' user option is nil, these checks are disabled."
+If the `textsec-check' user option is nil, these checks are
+disabled, and this function always returns nil."
(if (not textsec-check)
- string
+ nil
(require 'textsec)
(let ((func (intern (format "textsec-%s-suspicious-p" type))))
(unless (fboundp func)
(error "%s is not a valid function" func))
- (let ((warning (funcall func string)))
- (if (not warning)
- string
- (propertize string
- 'face 'textsec-suspicious
- 'help-echo warning))))))
+ (funcall func string))))
+
+;;;###autoload
+(defun textsec-propertize (string type)
+ "Test whether STRING is suspicious when considered as TYPE.
+If STRING is suspicious, text properties will be added to the
+string to mark it as suspicious, and with tooltip texts that says
+what's suspicious about it. Otherwise STRING is returned
+verbatim.
+
+See `texsec-check' for further information about TYPE."
+ (let ((warning (textsec-check string type)))
+ (if (not wardning)
+ string
+ (propertize string
+ 'face 'textsec-suspicious
+ 'help-echo warning))))
(provide 'textsec-check)
diff --git a/lisp/international/textsec.el b/lisp/international/textsec.el
index a7b9ed9f9b..90c37bf2b3 100644
--- a/lisp/international/textsec.el
+++ b/lisp/international/textsec.el
@@ -29,6 +29,7 @@
(require 'idna-mapping)
(require 'puny)
(require 'mail-parse)
+(require 'url)
(defvar textsec--char-scripts nil)
@@ -366,6 +367,13 @@ and `textsec-name-suspicious-p'."
(textsec-email-address-suspicious-p address)
(and name (textsec-name-suspicious-p name))))))
+(defun textsec-url-suspicious-p (url)
+ "Say whether EMAIL looks suspicious.
+If it isn't, return nil. If it is, return a string explaining the
+potential problem."
+ (let ((parsed (url-generic-parse-url url)))
+ (textsec-domain-suspicious-p (url-host parsed))))
+
(provide 'textsec)
;;; textsec.el ends here
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 7363874cf3..3ace872474 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1467,7 +1467,12 @@ ones, in case fg and bg are nil."
(dom-attr dom 'name)))) ; Obsolete since HTML5.
(push (cons id (point)) shr--link-targets))
(when url
- (shr-urlify (or shr-start start) (shr-expand-url url) title))))
+ (shr-urlify (or shr-start start) (shr-expand-url url) title)
+ (when-let ((warning (textsec-check (shr-expand-url url) 'url)))
+ (add-text-properties (or shr-start start) (point)
+ (list 'help-echo warning
+ 'face '(shr-link textsec-suspicious)))
+ (insert "⚠️")))))
(defun shr-tag-abbr (dom)
(let ((title (dom-attr dom 'title))
diff --git a/test/lisp/international/textsec-tests.el
b/test/lisp/international/textsec-tests.el
index c6268d14c7..c7cf56757c 100644
--- a/test/lisp/international/textsec-tests.el
+++ b/test/lisp/international/textsec-tests.el
@@ -164,4 +164,8 @@
(should (textsec-email-address-header-suspicious-p
"דגבא <foo@bar.com>")))
+(ert-deftest test-suspicious-url ()
+ (should-not (textsec-url-suspicious-p "http://example.ru/bar"))
+ (should (textsec-url-suspicious-p "http://Сгсе.ru/bar")))
+
;;; textsec-tests.el ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 1bfc086391: Make shr mark links with suspicious URLs,
Lars Ingebrigtsen <=