diff options
| author | Lars Ingebrigtsen | 2022-01-19 16:22:16 +0100 |
|---|---|---|
| committer | Lars Ingebrigtsen | 2022-01-19 16:22:16 +0100 |
| commit | 00a694628382ba378978aa4de33bff7d17034c84 (patch) | |
| tree | 198d79faf91f141a38b3abe0644ebf3c63b2af98 | |
| parent | 598038643f483eabe788d4910bea5d1518ee0015 (diff) | |
| download | emacs-00a694628382ba378978aa4de33bff7d17034c84.tar.gz emacs-00a694628382ba378978aa4de33bff7d17034c84.zip | |
Add new file textsec-check.el
* lisp/international/textsec-check.el: New file.
* lisp/international/textsec.el
(textsec-email-address-header-suspicious-p): Rename.
| -rw-r--r-- | lisp/international/textsec-check.el | 67 | ||||
| -rw-r--r-- | lisp/international/textsec.el | 2 | ||||
| -rw-r--r-- | 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 00000000000..ff1b985d93a --- /dev/null +++ b/lisp/international/textsec-check.el | |||
| @@ -0,0 +1,67 @@ | |||
| 1 | ;;; textsec-check.el --- Check for suspicious texts -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2022 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; This file is part of GNU Emacs. | ||
| 6 | |||
| 7 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 8 | ;; it under the terms of the GNU General Public License as published by | ||
| 9 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 10 | ;; (at your option) any later version. | ||
| 11 | |||
| 12 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 | ;; GNU General Public License for more details. | ||
| 16 | |||
| 17 | ;; You should have received a copy of the GNU General Public License | ||
| 18 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 19 | |||
| 20 | ;;; Commentary: | ||
| 21 | |||
| 22 | ;; | ||
| 23 | |||
| 24 | ;;; Code: | ||
| 25 | |||
| 26 | (defgroup textsec nil | ||
| 27 | "Suspicious text identification." | ||
| 28 | :group 'security | ||
| 29 | :version "29.1") | ||
| 30 | |||
| 31 | (defcustom textsec-check t | ||
| 32 | "If non-nil, perform some checks on certain texts. | ||
| 33 | If nil, these checks are disabled." | ||
| 34 | :type 'boolean | ||
| 35 | :version "29.1") | ||
| 36 | |||
| 37 | (defface textsec-suspicious | ||
| 38 | '((t (:weight bold :background "red"))) | ||
| 39 | "Face used to highlight suspicious strings.") | ||
| 40 | |||
| 41 | ;;;###autoload | ||
| 42 | (defun textsec-check (string type) | ||
| 43 | "Test whether STRING is suspicious when considered as TYPE. | ||
| 44 | If STRING is suspicious, text properties will be added to the | ||
| 45 | string to mark it as suspicious, and with tooltip texts that says | ||
| 46 | what's suspicious about it. | ||
| 47 | |||
| 48 | Available types include `domain', `local-address', `name', | ||
| 49 | `email-address', and `email-address-headers'. | ||
| 50 | |||
| 51 | If the `textsec-check' user option is nil, these checks are disabled." | ||
| 52 | (if (not textsec-check) | ||
| 53 | string | ||
| 54 | (require 'textsec) | ||
| 55 | (let ((func (intern (format "textsec-%s-suspicious-p" type)))) | ||
| 56 | (unless (fboundp func) | ||
| 57 | (error "%s is not a valid function" func)) | ||
| 58 | (let ((warning (funcall func string))) | ||
| 59 | (if (not warning) | ||
| 60 | string | ||
| 61 | (propertize string | ||
| 62 | 'face 'textsec-suspicious | ||
| 63 | 'help-echo warning)))))) | ||
| 64 | |||
| 65 | (provide 'textsec-check) | ||
| 66 | |||
| 67 | ;;; textsec-check.el ends here | ||
diff --git a/lisp/international/textsec.el b/lisp/international/textsec.el index 63860d22508..a7b9ed9f9b9 100644 --- a/lisp/international/textsec.el +++ b/lisp/international/textsec.el | |||
| @@ -344,7 +344,7 @@ and `textsec-domain-suspicious-p'." | |||
| 344 | (textsec-domain-suspicious-p domain) | 344 | (textsec-domain-suspicious-p domain) |
| 345 | (textsec-local-address-suspicious-p local)))) | 345 | (textsec-local-address-suspicious-p local)))) |
| 346 | 346 | ||
| 347 | (defun textsec-email-suspicious-p (email) | 347 | (defun textsec-email-address-header-suspicious-p (email) |
| 348 | "Say whether EMAIL looks suspicious. | 348 | "Say whether EMAIL looks suspicious. |
| 349 | If it isn't, return nil. If it is, return a string explaining the | 349 | If it isn't, return nil. If it is, return a string explaining the |
| 350 | potential problem. | 350 | potential problem. |
diff --git a/test/lisp/international/textsec-tests.el b/test/lisp/international/textsec-tests.el index 8385c116f4f..c6268d14c7d 100644 --- a/test/lisp/international/textsec-tests.el +++ b/test/lisp/international/textsec-tests.el | |||
| @@ -149,14 +149,19 @@ | |||
| 149 | 149 | ||
| 150 | (ert-deftest test-suspicious-email () | 150 | (ert-deftest test-suspicious-email () |
| 151 | (should-not | 151 | (should-not |
| 152 | (textsec-email-suspicious-p "Lars Ingebrigtsen <larsi@gnus.org>")) | 152 | (textsec-email-address-header-suspicious-p |
| 153 | "Lars Ingebrigtsen <larsi@gnus.org>")) | ||
| 153 | (should | 154 | (should |
| 154 | (textsec-email-suspicious-p "LÅrs Ingebrigtsen <larsi@gnus.org>")) | 155 | (textsec-email-address-header-suspicious-p |
| 156 | "LÅrs Ingebrigtsen <larsi@gnus.org>")) | ||
| 155 | (should | 157 | (should |
| 156 | (textsec-email-suspicious-p "Lars Ingebrigtsen <.larsi@gnus.org>")) | 158 | (textsec-email-address-header-suspicious-p |
| 159 | "Lars Ingebrigtsen <.larsi@gnus.org>")) | ||
| 157 | (should | 160 | (should |
| 158 | (textsec-email-suspicious-p "Lars Ingebrigtsen <larsi@gn\N{LEFT-TO-RIGHT ISOLATE}us.org>")) | 161 | (textsec-email-address-header-suspicious-p |
| 162 | "Lars Ingebrigtsen <larsi@gn\N{LEFT-TO-RIGHT ISOLATE}us.org>")) | ||
| 159 | 163 | ||
| 160 | (should (textsec-email-suspicious-p "דגבא <foo@bar.com>"))) | 164 | (should (textsec-email-address-header-suspicious-p |
| 165 | "דגבא <foo@bar.com>"))) | ||
| 161 | 166 | ||
| 162 | ;;; textsec-tests.el ends here | 167 | ;;; textsec-tests.el ends here |