Re: Handling "via" addresses
Sam Steingold <[email protected]> Thu, 25 Aug 2022 10:46:56 -0400
| Newsgroups | gmane.emacs.bbdb.user |
|---|---|
| Message-ID | <[email protected]> |
--=-=-= Content-Type: text/plain > * Sam Steingold <[email protected]> [2022-07-06 13:45:58 -0400]: > > From feff548533797f5060c6fd7e40e987e2693c396a Mon Sep 17 00:00:00 2001 > From: Sam Steingold <[email protected]> > 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. --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Parse-addresses-before-mime-decoding.patch Content-Description: Parse From 4aa0c06e624ef14319281c43cb846a5b4665b5e9 Mon Sep 17 00:00:00 2001 From: Sam Steingold <[email protected]> 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 <[email protected]> + 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 <[email protected]> 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) --=-=-= Content-Type: text/plain -- 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. --=-=-=--