master 00a6946283: Add new file textsec-check.el

[Lars Ingebrigtsen]

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

    Add new file textsec-check.el
    
    * lisp/international/textsec-check.el: New file.
    * lisp/international/textsec.el
    (textsec-email-address-header-suspicious-p): Rename.
---
 lisp/international/textsec-check.el      | 67 ++++++++++++++++++++++++++++++++
 lisp/international/textsec.el            |  2 +-
 test/lisp/international/textsec-tests.el | 15 ++++---
 3 files changed, 78 insertions(+), 6 deletions(-)

diff --git a/lisp/international/textsec-check.el 
b/lisp/international/textsec-check.el
new file mode 100644
index 0000000000..ff1b985d93
--- /dev/null
+++ b/lisp/international/textsec-check.el
@@ -0,0 +1,67 @@
+;;; textsec-check.el --- Check for suspicious texts  -*- lexical-binding: t; 
-*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(defgroup textsec nil
+  "Suspicious text identification."
+  :group 'security
+  :version "29.1")
+
+(defcustom textsec-check t
+  "If non-nil, perform some checks on certain texts.
+If nil, these checks are disabled."
+  :type 'boolean
+  :version "29.1")
+
+(defface textsec-suspicious
+  '((t (:weight bold :background "red")))
+  "Face used to highlight suspicious strings.")
+
+;;;###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.
+
+Available types include `domain', `local-address', `name',
+`email-address', and `email-address-headers'.
+
+If the `textsec-check' user option is nil, these checks are disabled."
+  (if (not textsec-check)
+      string
+    (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))))))
+
+(provide 'textsec-check)
+
+;;; textsec-check.el ends here
diff --git a/lisp/international/textsec.el b/lisp/international/textsec.el
index 63860d2250..a7b9ed9f9b 100644
--- a/lisp/international/textsec.el
+++ b/lisp/international/textsec.el
@@ -344,7 +344,7 @@ and `textsec-domain-suspicious-p'."
      (textsec-domain-suspicious-p domain)
      (textsec-local-address-suspicious-p local))))
 
-(defun textsec-email-suspicious-p (email)
+(defun textsec-email-address-header-suspicious-p (email)
   "Say whether EMAIL looks suspicious.
 If it isn't, return nil.  If it is, return a string explaining the
 potential problem.
diff --git a/test/lisp/international/textsec-tests.el 
b/test/lisp/international/textsec-tests.el
index 8385c116f4..c6268d14c7 100644
--- a/test/lisp/international/textsec-tests.el
+++ b/test/lisp/international/textsec-tests.el
@@ -149,14 +149,19 @@
 
 (ert-deftest test-suspicious-email ()
   (should-not
-   (textsec-email-suspicious-p "Lars Ingebrigtsen <larsi@gnus.org>"))
+   (textsec-email-address-header-suspicious-p
+    "Lars Ingebrigtsen <larsi@gnus.org>"))
   (should
-   (textsec-email-suspicious-p "LÅrs Ingebrigtsen <larsi@gnus.org>"))
+   (textsec-email-address-header-suspicious-p
+    "LÅrs Ingebrigtsen <larsi@gnus.org>"))
   (should
-   (textsec-email-suspicious-p "Lars Ingebrigtsen <.larsi@gnus.org>"))
+   (textsec-email-address-header-suspicious-p
+    "Lars Ingebrigtsen <.larsi@gnus.org>"))
   (should
-   (textsec-email-suspicious-p "Lars Ingebrigtsen <larsi@gn\N{LEFT-TO-RIGHT 
ISOLATE}us.org>"))
+   (textsec-email-address-header-suspicious-p
+    "Lars Ingebrigtsen <larsi@gn\N{LEFT-TO-RIGHT ISOLATE}us.org>"))
 
-  (should (textsec-email-suspicious-p "דגבא <foo@bar.com>")))
+  (should (textsec-email-address-header-suspicious-p
+           "דגבא <foo@bar.com>")))
 
 ;;; textsec-tests.el ends here