[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Handling "via" addresses
From: |
Sam Steingold |
Subject: |
Re: Handling "via" addresses |
Date: |
Thu, 25 Aug 2022 10:46:56 -0400 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (darwin) |
> * Sam Steingold <fqf@tah.bet> [2022-07-06 13:45:58 -0400]:
>
> From feff548533797f5060c6fd7e40e987e2693c396a Mon Sep 17 00:00:00 2001
> From: Sam Steingold <sds@gnu.org>
> Date: Wed, 6 Jul 2022 13:42:41 -0400
> Subject: [PATCH] Use `mail-header-parse-address' instead of
> `mail-extract-address-components'.
>
> `mail-extract-address-components' mis-handles many From headers,
> see https://debbugs.gnu.org/cgi/bugreport.cgi?bug=10406
> and https://debbugs.gnu.org/cgi/bugreport.cgi?bug=56422
> * lisp/bbdb.el (bbdb-clean-address-components): Expect
> a cons cell from `mail-header-parse-address' rather than
> a list from `mail-extract-address-components'.
> (bbdb-extract-address-components): Use `mail-header-parse-address'
> instead of `mail-extract-address-components'.
Alas, another patch is needed on top of this, because mime decoding has
to be done _after_ address parsing.
I have been using these two patches for 3 weeks without any further
issues.
>From 4aa0c06e624ef14319281c43cb846a5b4665b5e9 Mon Sep 17 00:00:00 2001
From: Sam Steingold <sds@gnu.org>
Date: Thu, 25 Aug 2022 10:37:07 -0400
Subject: [PATCH] Parse addresses before mime decoding
As per https://debbugs.gnu.org/cgi/bugreport.cgi?bug=10406
call `mail-header-parse-addresses' _first_ and
then `mail-decode-encoded-word-string'.
* lisp/bbdb-mua.el (bbdb-message-header): Split into...
(bbdb-message-header-raw): Get the raw header, do not decode.
(bbdb-message-header-decoded): Get the decoded header.
(bbdb-message-header-re): Call `bbdb-message-header-decoded'.
(bbdb-get-address-components): Call `bbdb-message-header-raw'.
(bbdb-auto-notes): Call `bbdb-message-header-decoded'.
* lisp/bbdb.el (bbdb-clean-address-components): Decode `name' here.
---
ChangeLog | 13 +++++++
lisp/bbdb-mua.el | 88 +++++++++++++++++++++++++++---------------------
lisp/bbdb.el | 4 +++
3 files changed, 66 insertions(+), 39 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 22713cf..0437e0f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2022-08-05 Sam Steingold <sds@gnu.org>
+ Parse addresses before mime decoding
+ As per https://debbugs.gnu.org/cgi/bugreport.cgi?bug=10406
+ call `mail-header-parse-addresses' _first_ and
+ then `mail-decode-encoded-word-string'.
+ * lisp/bbdb-mua.el (bbdb-message-header): Split into...
+ (bbdb-message-header-raw): Get the raw header, do not decode.
+ (bbdb-message-header-decoded): Get the decoded header.
+ (bbdb-message-header-re): Call `bbdb-message-header-decoded'.
+ (bbdb-get-address-components): Call `bbdb-message-header-raw'.
+ (bbdb-auto-notes): Call `bbdb-message-header-decoded'.
+ * lisp/bbdb.el (bbdb-clean-address-components): Decode `name' here.
+
2022-07-06 Sam Steingold <sds@gnu.org>
Use `mail-header-parse-address' instead of
`mail-extract-address-components'.
`mail-extract-address-components' mis-handles many From headers,
diff --git a/lisp/bbdb-mua.el b/lisp/bbdb-mua.el
index df0366a..417c1c4 100644
--- a/lisp/bbdb-mua.el
+++ b/lisp/bbdb-mua.el
@@ -65,8 +65,7 @@
(autoload 'bbdb/wl-header "bbdb-wl")
- (autoload 'message-field-value "message")
- (autoload 'mail-decode-encoded-word-string "mail-parse"))
+ (autoload 'message-field-value "message"))
(defconst bbdb-mua-mode-alist
'((vm vm-mode vm-virtual-mode vm-summary-mode vm-presentation-mode)
@@ -100,9 +99,13 @@ Return values include
(or mua (user-error "BBDB: MUA `%s' not supported" major-mode))))
;;;###autoload
-(defun bbdb-message-header (header)
+(defun bbdb-message-header-raw (header)
"For the current message return the value of HEADER.
-MIME encoded headers are decoded. Return nil if HEADER does not exist."
+Return nil if HEADER does not exist.
+No MIME decoding is performed, because this breaks `mail-header-parse-address'.
+Use this for email address header, e.g., To or From, then pass the return
+value to `mail-header-parse-address' and decode the names
+using `mail-decode-encoded-word-string'."
;; RW: If HEADER was allowed to be a regexp and the content of multiple
;; matching headers was concatenated as in `message-field-value',
;; this would simplify the usage of `bbdb-accept-message-alist' and
@@ -110,42 +113,49 @@ MIME encoded headers are decoded. Return nil if HEADER
does not exist."
;; RW: If this function had a remember table, it could look up the value
;; of a header if we request the value of the same header multiple times.
;; (We would reset the remember table each time we move on to a new message.)
- (let* ((mua (bbdb-mua))
- (val (cond ((eq mua 'gnus)
- ;; `gnus-fetch-field' can fetch only the content of
- ;; `gnus-visible-headers', but it ignores
- ;; `gnus-ignored-headers'. `gnus-fetch-original-field'
- ;; uses the uncensored set of headers in
- ;; `gnus-original-article-buffer'. The latter headers are
- ;; encoded, so that decoding makes this slower, but BBDB
- ;; does not get fooled by an apparent absence of some
- ;; headers. (See gmane.emacs.gnus.general #78741)
- (or (gnus-fetch-original-field header)
- ;; `gnus-fetch-original-field' returns nil in nndoc
- ;; groups (digests) because
`gnus-original-article-buffer'
- ;; is empty for the nndoc summary buffer, but not for
- ;; the parent summary buffer. (bug#54423)
- (let ((parent-summary-buffer
- (cadr (assq 'quit-config
- (gnus-info-params
- (gnus-get-info
gnus-newsgroup-name))))))
- (and parent-summary-buffer
- (with-current-buffer parent-summary-buffer
- (gnus-fetch-original-field header))))))
- ((eq mua 'vm) (bbdb/vm-header header))
- ((eq mua 'rmail)
- (with-current-buffer rmail-buffer
- (rmail-get-header header)))
- ((eq mua 'mh) (bbdb/mh-header header))
- ((eq mua 'mu4e) (message-field-value header))
- ((eq mua 'wl) (bbdb/wl-header header))
- ((memq mua '(message mail)) (message-field-value header))
- (t (error "BBDB/%s: header function undefined" mua)))))
- (if val (mail-decode-encoded-word-string val))))
+ (let ((mua (bbdb-mua)))
+ (cond ((eq mua 'gnus)
+ ;; `gnus-fetch-field' can fetch only the content of
+ ;; `gnus-visible-headers', but it ignores
+ ;; `gnus-ignored-headers'. `gnus-fetch-original-field'
+ ;; uses the uncensored set of headers in
+ ;; `gnus-original-article-buffer'. The latter headers are
+ ;; encoded, so that decoding makes this slower, but BBDB
+ ;; does not get fooled by an apparent absence of some
+ ;; headers. (See gmane.emacs.gnus.general #78741)
+ (or (gnus-fetch-original-field header)
+ ;; `gnus-fetch-original-field' returns nil in nndoc
+ ;; groups (digests) because `gnus-original-article-buffer'
+ ;; is empty for the nndoc summary buffer, but not for
+ ;; the parent summary buffer. (bug#54423)
+ (let ((parent-summary-buffer
+ (cadr (assq 'quit-config
+ (gnus-info-params
+ (gnus-get-info gnus-newsgroup-name))))))
+ (and parent-summary-buffer
+ (with-current-buffer parent-summary-buffer
+ (gnus-fetch-original-field header))))))
+ ((eq mua 'vm) (bbdb/vm-header header))
+ ((eq mua 'rmail)
+ (with-current-buffer rmail-buffer
+ (rmail-get-header header)))
+ ((eq mua 'mh) (bbdb/mh-header header))
+ ((eq mua 'mu4e) (message-field-value header))
+ ((eq mua 'wl) (bbdb/wl-header header))
+ ((memq mua '(message mail)) (message-field-value header))
+ (t (error "BBDB/%s: header function undefined" mua)))))
+
+(defun bbdb-message-header-decoded (header)
+ "Return the HEADER for the current message, MIME decoded.
+Return nil if HEADER does not exist.
+This is suitable for non-email address headers.
+See also `bbdb-message-header-raw'."
+ (let ((raw (bbdb-message-header-raw header)))
+ (and raw (mail-decode-encoded-word-string raw))))
(defsubst bbdb-message-header-re (header regexp)
"Return non-nil if REGEXP matches value of HEADER."
- (let ((val (bbdb-message-header header))
+ (let ((val (bbdb-message-header-decoded header))
(case-fold-search t)) ; RW: Is this what we want?
(and val (string-match regexp val))))
@@ -203,7 +213,7 @@ is ignored. If IGNORE-ADDRESS is nil, use value of
`bbdb-user-mail-address-re'."
address-list name mail mail-list content)
(dolist (headers message-headers)
(dolist (header (cdr headers))
- (when (setq content (bbdb-message-header header))
+ (when (setq content (bbdb-message-header-raw header))
;; Always extract all addresses because we do not know yet which
;; address might match IGNORE-ADDRESS.
(dolist (address (bbdb-extract-address-components content t))
@@ -1016,7 +1026,7 @@ For use as an element of `bbdb-notice-record-hook'."
(member-ignore-case
(nth 2 bbdb-update-records-address) from-to)
(memq (nth 3 bbdb-update-records-address) from-to))
- (setq hd-val (bbdb-message-header header)))
+ (setq hd-val (bbdb-message-header-decoded header)))
(dolist (elt (nthcdr 3 rule))
(when (and (string-match (car elt) hd-val)
(let ((ignore (cdr (assoc-string
diff --git a/lisp/bbdb.el b/lisp/bbdb.el
index d53651d..e72d730 100644
--- a/lisp/bbdb.el
+++ b/lisp/bbdb.el
@@ -53,6 +53,8 @@
(declare-function bbdb-merge-records "bbdb-com")
(declare-function mail-position-on-field "sendmail")
(declare-function vm-select-folder-buffer "vm-folder")
+(eval-and-compile
+ (autoload 'mail-decode-encoded-word-string "mail-parse"))
;; cannot use autoload for variables...
(defvar message-mode-map) ;; message.el
@@ -2228,6 +2230,8 @@ Pass NAME through `bbdb-message-clean-name-function'
and MAIL through `bbdb-message-clean-mail-function'."
(let ((name (cdr components))
(mail (car components)))
+ (when name
+ (setq name (mail-decode-encoded-word-string name)))
(if (and name bbdb-message-clean-name-function)
(setq name (funcall bbdb-message-clean-name-function name)))
(if (and name bbdb-message-ignore-name-re
--
2.24.3 (Apple Git-128)
--
Sam Steingold (https://aphar.dreamwidth.org/) on darwin Ns 10.3.2113
https://lastingimpactpsychology.com https://steingoldpsychology.com
https://iris.org.il http://think-israel.org https://www.peaceandtolerance.org/
Just because you're paranoid doesn't mean they AREN'T after you.
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- Re: Handling "via" addresses,
Sam Steingold <=