master b69e269: Only look at the headers when computing the envelope from address

[Lars Ingebrigtsen]

branch: master
commit b69e2699aaae6c13a14d8904b0b21e519c770336
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    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).
---
 lisp/mail/sendmail.el |  8 +++++++-
 lisp/mail/smtpmail.el | 39 ++++++++++++++++++++++++++-------------
 2 files changed, 33 insertions(+), 14 deletions(-)

diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index cd07166..9a4c8f3 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 ab58aa4..c1e2280 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