bug#13321: 24.3.0.50; Gmail error when replying from Gnus to github

[Thierry Volpiatto <thierry.volpiatto@gmail.com>]

Katsumi Yamaoka <yamaoka@jpl.org> writes:

> thierry.volpiatto@gmail.com wrote:
>> Katsumi Yamaoka <yamaoka@jpl.org> writes:
>>> Please let me say that a wide reply doesn't contain the author
>>> of an original mail in the recipient list is a bug.  To exclude
>>> an invalid address from a wide reply is not a feature;
>
>> It is not excluded in the patch, it is added to "cc" only if "wide" is
>> specified.
> [...]
>> Please have a look at the mail examples I sent in other posts.
>
> Hm, I haven't gotten it yet.  Could you try replying to a mail
> attached in this message as well (copy it to a mail group and do
> F)?
>
> [...]
>> The point is that with the patch I sent + the headers of the rejected
>> mail and the original mail where I reply to, you will be able to
>> understand what happen and fix it.
>
> Ok, I'll surely try it.

To summarize the problem here some more example, with also the patch
modified to fix previous errors when removing duplicates.
Note that the changes applied further in the patch are not related with
this bug, they just try to improve the code.
Note also that one loop is removing extra spaces (I have noticed that in
some mails, addresses are separated with two spaces in "CC").

,----[ Replying on github ]
| A "reply-to" header exists:
| 
| From: Le Wang <notifications@github.com>
| Reply-To: emacs-helm/helm <reply+i-5357313-fd4754a13604e0814f8932f6f63f437dff55f8d0-1533939@reply.github.com>
| To: emacs-helm/helm <helm@noreply.github.com>
| 
| I send a reply with my patch applied:
| 
| From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
| To: emacs-helm/helm <reply+i-5357313-fd4754a13604e0814f8932f6f63f437dff55f8d0-1533939@reply.github.com>
| Cc: emacs-helm/helm <helm@noreply.github.com>
| 
| I send a reply with actual code (bug)
| 
| From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
| To: Le Wang <notifications@github.com>
| Cc: emacs-helm/helm <helm@noreply.github.com>,  emacs-helm/helm <reply+i-5357313-fd4754a13604e0814f8932f6f63f437dff55f8d0-1533939@reply.github.com>
`----

,----[ Replying on emacs.dev ]
| No "reply-to" header:
| 
| From: Katsumi Yamaoka <yamaoka@jpl.org>
| To: thierry.volpiatto@gmail.com
| Cc: 13321@debbugs.gnu.org
| 
| I send a reply with my patch applied:
| 
| From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
| To: Katsumi Yamaoka <yamaoka@jpl.org>
| Cc: 13321@debbugs.gnu.org
| 
| With original code it is the same (no bug in this case)
| 
| From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
| To: Katsumi Yamaoka <yamaoka@jpl.org>
| Cc: 13321@debbugs.gnu.org
`----

And here the last version of patch:

diff --git a/lisp/message.el b/lisp/message.el
index 21847ac..44f1ee4 100644
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -6753,8 +6753,7 @@ The function is called with one parameter, a cons cell ..."
       ;; message-header-synonyms.
       (setq to (or (message-fetch-field "to")
 		   (and (loop for synonym in message-header-synonyms
-			      when (memq 'Original-To synonym)
-			      return t)
+			      thereis (memq 'Original-To synonym))
 			(message-fetch-field "original-to")))
 	    cc (message-fetch-field "cc")
 	    extra (when message-extra-wide-headers
@@ -6764,16 +6763,19 @@ The function is called with one parameter, a cons cell ..."
 			       ", "))
 	    mct (message-fetch-field "mail-copies-to")
 	    author (or (message-fetch-field "mail-reply-to")
-		       (message-fetch-field "reply-to"))
+		       (message-fetch-field "reply-to")
+		       (message-fetch-field "from") "")
 	    mft (and message-use-mail-followup-to
 		     (message-fetch-field "mail-followup-to")))
-      ;; Make sure this message goes to the author if this is a wide
-      ;; reply, since Reply-To address may be a list address a mailing
-      ;; list server added.
+      ;; Make sure this message goes to the author if this is a wide reply.
+      ;; If a '*reply-to' header is found use it, otherwise use the 'from'
+      ;; header and add it to 'cc'.
+      ;; If "wide" is not specified, "author" will end later in "to" header.
+      ;; We should not force using "from" for "author" when not using "wide"
+      ;; because it will go in this case in "to" and in some cases the address
+      ;; from "from" is invalid like on github (bug#13321).
       (when (and wide author)
-	(setq cc (concat author ", " cc)))
-      (when (or wide (not author))
-	(setq author (or (message-fetch-field "from") ""))))
+	(setq cc (concat author ", " cc))))
 
     ;; Handle special values of Mail-Copies-To.
     (when mct
@@ -6829,13 +6831,9 @@ want to get rid of this query permanently.")))
 	(setq recipients (concat ", " mft)))
        (t
 	(setq recipients (if never-mct "" (concat ", " author)))
-	(if to (setq recipients (concat recipients ", " to)))
-	(if cc (setq recipients (concat recipients ", " cc)))
-	(if extra (setq recipients (concat recipients ", " extra)))
-	(if mct (setq recipients (concat recipients ", " mct)))))
-      (if (>= (length recipients) 2)
-	  ;; Strip the leading ", ".
-	  (setq recipients (substring recipients 2)))
+	(loop for h in `(,to ,cc ,extra ,mct)
+	      for recip = (and recipients (not (string= recipients "")))
+	      when h do (setq recipients (concat recipients (and recip ", ") h)))))
       ;; Squeeze whitespace.
       (while (string-match "[ \t][ \t]+" recipients)
 	(setq recipients (replace-match " " t t recipients)))
@@ -6854,31 +6852,21 @@ want to get rid of this query permanently.")))
 			    (cons (downcase (mail-strip-quoted-names addr))
 				  addr))
 		 (cons (downcase (mail-strip-quoted-names addr)) addr)))
-	     (message-tokenize-header recipients)))
-      ;; Remove all duplicates.
-      (let ((s recipients))
-	(while s
-	  (let ((address (car (pop s))))
-	    (while (assoc address s)
-	      (setq recipients (delq (assoc address s) recipients)
-		    s (delq (assoc address s) s))))))
+	     ;; Remove all duplicates.
+	     (loop with recip for m in (message-tokenize-header recipients)
+                   for mess = (replace-regexp-in-string "^ " "" m)
+                   unless (member mess recip) collect mess into recip
+                   finally return recip)))
 
       ;; Remove hierarchical lists that are contained within each other,
       ;; if message-hierarchical-addresses is defined.
       (when message-hierarchical-addresses
-	(let ((plain-addrs (mapcar 'car recipients))
-	      subaddrs recip)
-	  (while plain-addrs
-	    (setq subaddrs (assoc (car plain-addrs)
-				  message-hierarchical-addresses)
-		  plain-addrs (cdr plain-addrs))
-	    (when subaddrs
-	      (setq subaddrs (cdr subaddrs))
-	      (while subaddrs
-		(setq recip (assoc (car subaddrs) recipients)
-		      subaddrs (cdr subaddrs))
-		(if recip
-		    (setq recipients (delq recip recipients))))))))
+        (setq recipients
+              (loop for (r . a) in recipients
+                    for assoc = (cdr (assoc r message-hierarchical-addresses))
+                    when assoc append assoc into recip
+                    unless (or (member r recip) (assoc r results))
+                    collect (cons r a) into results finally return results)))
 
       (setq recipients (message-prune-recipients recipients))

-- 
Thierry
Get my Gnupg key:
gpg --keyserver pgp.mit.edu --recv-keys 59F29997