From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Thu, 6 May 2021 10:21:11 +0000 (+0200)
Subject: Only look at the headers when computing the envelope from address
X-Git-Tag: emacs-28.0.90~2594
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b69e2699aaae6c13a14d8904b0b21e519c770336;p=emacs.git

Only look at the headers when computing the envelope from address

* lisp/mail/smtpmail.el (smtpmail-send-it)
(smtpmail-send-queued-mail, smtpmail-via-smtp):
* lisp/mail/sendmail.el (sendmail-send-it): Only look at the
headers when computing the envelope from (bug#47616).
---

diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index cd071667562..9a4c8f3c665 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -30,6 +30,7 @@
 (require 'mail-utils)
 (require 'rfc2047)
 (autoload 'message-make-date "message")
+(autoload 'message-narrow-to-headers "message")
 
 (defgroup sendmail nil
   "Mail sending commands for Emacs."
@@ -1177,7 +1178,12 @@ external program defined by `sendmail-program'."
 	;; local binding in the mail buffer will take effect.
 	(envelope-from
 	 (and mail-specify-envelope-from
-	      (or (mail-envelope-from) user-mail-address))))
+	      (or (save-restriction
+                    ;; Only look at the headers when fetching the
+                    ;; envelope address.
+                    (message-narrow-to-headers)
+                    (mail-envelope-from))
+                  user-mail-address))))
     (unwind-protect
 	(with-current-buffer tembuf
 	  (erase-buffer)
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index ab58aa455e9..c1e22800331 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -207,11 +207,15 @@ for `smtpmail-try-auth-method'.")
         ;; Examine this variable now, so that
 	;; local binding in the mail buffer will take effect.
 	(smtpmail-mail-address
-         (or (and mail-specify-envelope-from (mail-envelope-from))
-             (let ((from (mail-fetch-field "from")))
-	       (and from
-		    (cadr (mail-extract-address-components from))))
-	     (smtpmail-user-mail-address)))
+         (save-restriction
+           ;; Only look at the headers when fetching the
+           ;; envelope address.
+           (message-narrow-to-headers)
+           (or (and mail-specify-envelope-from (mail-envelope-from))
+               (let ((from (mail-fetch-field "from")))
+	         (and from
+		      (cadr (mail-extract-address-components from))))
+	       (smtpmail-user-mail-address))))
 	(smtpmail-code-conv-from
 	 (if enable-multibyte-characters
 	     (let ((sendmail-coding-system smtpmail-code-conv-from))
@@ -434,7 +438,12 @@ for `smtpmail-try-auth-method'.")
 	  (let ((coding-system-for-read 'no-conversion))
 	    (insert-file-contents file-data))
           (let ((smtpmail-mail-address
-                 (or (and mail-specify-envelope-from (mail-envelope-from))
+                 (or (and mail-specify-envelope-from
+                          (save-restriction
+                            ;; Only look at the headers when fetching the
+                            ;; envelope address.
+                            (message-narrow-to-headers)
+                            (mail-envelope-from)))
                      user-mail-address)))
             (if (not (null smtpmail-recipient-address-list))
                 (when (setq result (smtpmail-via-smtp
@@ -677,13 +686,17 @@ Returns an error if the server cannot be contacted."
         ;; `smtpmail-mail-address' should be set to the appropriate
         ;; buffer-local value by the caller, but in case not:
         (envelope-from
-	 (or smtpmail-mail-address
-	     (and mail-specify-envelope-from
-		  (mail-envelope-from))
-	     (let ((from (mail-fetch-field "from")))
-	       (and from
-		    (cadr (mail-extract-address-components from))))
-	     (smtpmail-user-mail-address)))
+         (save-restriction
+           ;; Only look at the headers when fetching the
+           ;; envelope address.
+           (message-narrow-to-headers)
+	   (or smtpmail-mail-address
+	       (and mail-specify-envelope-from
+		    (mail-envelope-from))
+	       (let ((from (mail-fetch-field "from")))
+	         (and from
+		      (cadr (mail-extract-address-components from))))
+	       (smtpmail-user-mail-address))))
 	process-buffer
 	result
 	auth-mechanisms