Re: Handling "via" addresses

[Sam Steingold]

> * 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.