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 cd0716675628894c21d0b8709c2325a80c8135a7..9a4c8f3c665acca0aaae3e7047f2289e09ec9166 100644 (file)
--- 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 ab58aa455e94280b7ffdaf58a28801fc22fdcce3..c1e22800331feeac7c56eb6d26c9311cd8763ae4 100644 (file)
--- 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