procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make Gnus check for suspicious headers

Browse source 
* lisp/gnus/gnus-art.el (gnus-treat-suspicious-headers): New user
option.
(gnus-article-treat-suspicious-headers): New function.
(article-decode-encoded-words): Hook into the machinery to check
headers.
(article--check-suspicious-addresses): New function.
This commit is contained in:
Lars Ingebrigtsen 2022-01-19 18:43:34 +01:00
parent 689e865a9b
commit b28f420737
1 changed files with 51 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

60
lisp/gnus/gnus-art.el
View file

@ -1395,6 +1395,15 @@ predicate. See Info node `(gnus)Customizing Articles'."
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-suspicious-headers 'head
"Mark headers that are suspicious.
Valid values are nil, t, `head', `first', `last', an integer or a
predicate. See Info node `(gnus)Customizing Articles'."
:version "29.1"
:group 'gnus-article-treat
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
(defcustom gnus-treat-fold-newsgroups 'head
"Fold the Newsgroups and Followup-To headers.
Valid values are nil, t, `head', `first', `last', an integer or a
@ -1712,6 +1721,7 @@ regexp."
(gnus-treat-unfold-headers gnus-article-treat-unfold-headers)
(gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups)
(gnus-treat-fold-headers gnus-article-treat-fold-headers)
(gnus-treat-suspicious-headers gnus-article-treat-suspicious-headers)
(gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
(gnus-treat-display-smileys gnus-treat-smiley)
(gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
@ -2236,6 +2246,20 @@ unfolded."
(pixel-fill-region (point) (point-max) (pixel-fill-width)))
(goto-char (point-max))))))
(defun gnus-article-treat-suspicious-headers ()
"Mark suspicious headers."
(interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-headers
(let (match)
(while (setq match (text-property-search-forward 'textsec-suspicious))
(add-text-properties (prop-match-beginning match)
(prop-match-end match)
(list 'help-echo (prop-match-value match)
'face 'textsec-suspicious))
(overlay-put (make-overlay (prop-match-end match)
(prop-match-end match))
'after-string "⚠️")))))
(defun gnus-treat-smiley ()
"Toggle display of textual emoticons (\"smileys\") as small graphical icons."
(interactive nil gnus-article-mode gnus-summary-mode)
@ -2612,17 +2636,35 @@ If PROMPT (the prefix), prompt for a coding system to use."
(forward-line -1))
(setq end (point))
(while (not (bobp))
(while (progn
(forward-line -1)
(and (not (bobp))
(memq (char-after) '(?\t ? )))))
(setq start (point))
(if (looking-at "\
(let (addresses)
(while (progn
(forward-line -1)
(and (not (bobp))
(memq (char-after) '(?\t ? )))))
(setq start (point))
(save-restriction
(narrow-to-region start end)
(if (looking-at "\
\\(?:Resent-\\)?\\(?:From\\|Cc\\|To\\|Bcc\\|\\(?:In-\\)?Reply-To\\|Sender\
\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\):")
(funcall gnus-decode-address-function start end)
(funcall gnus-decode-header-function start end))
(goto-char (setq end start)))))
(progn
(setq addresses (buffer-string))
(funcall gnus-decode-address-function (point-min) (point-max)))
(funcall gnus-decode-header-function (point-min) (point-max))))
(when addresses
(article--check-suspicious-addresses addresses))
(goto-char (point-max))
(goto-char (setq end start))))))
(defun article--check-suspicious-addresses (addresses)
(setq addresses (replace-regexp-in-string "\\`[^:]+:[ \t\n]*" "" addresses))
(dolist (header (mail-header-parse-addresses addresses t))
(let ((address (car (mail-header-parse-address header))))
(when-let ((warning (textsec-check address 'email-address)))
(goto-char (point-min))
(while (search-forward address nil t)
(put-text-property (match-beginning 0) (match-end 0)
'textsec-suspicious warning))))))
(defun article-decode-group-name ()
"Decode group names in Newsgroups, Followup-To and Xref headers."