Get the MAIL FROM from the From: header if no domain is configured

* mail/smtpmail.el (smtpmail-user-mail-address): New function.
(smtpmail-via-smtp): Use it, or fall back on the From address.
(smtpmail-send-it): Ditto.

1 files changed, 23 insertions, 5 deletions

diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index e3051fd0c9f..99283bebf9d 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -200,7 +200,10 @@ The list is in preference order.")
 	;; local binding in the mail buffer will take effect.
 	(smtpmail-mail-address
          (or (and mail-specify-envelope-from (mail-envelope-from))
-             user-mail-address))
+             (smtpmail-user-mail-address)
+	     (let ((from (mail-fetch-field "from")))
+	       (and from
+		    (cadr (mail-extract-address-components from))))))
 	(smtpmail-code-conv-from
 	 (if enable-multibyte-characters
 	     (let ((sendmail-coding-system smtpmail-code-conv-from))
@@ -611,6 +614,15 @@ The list is in preference order.")
     (unless smtpmail-smtp-server
       (error "Couldn't contact an SMTP server"))))
 
+(defun smtpmail-user-mail-address ()
+  "Return `user-mail-address' if it's a valid email address."
+  (and user-mail-address
+       (let ((parts (split-string user-mail-address "@")))
+	 (and (= (length parts) 2)
+	      ;; There's a dot in the domain name.
+	      (string-match "\\." (cadr parts))
+	      user-mail-address))))
+
 (defun smtpmail-via-smtp (recipient smtpmail-text-buffer
 				    &optional ask-for-password)
   (unless smtpmail-smtp-server
@@ -621,10 +633,16 @@ The list is in preference order.")
 	(port smtpmail-smtp-service)
         ;; `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))
-                           user-mail-address))
+        (envelope-from
+	 (or smtpmail-mail-address
+	     (and mail-specify-envelope-from
+		  (mail-envelope-from))
+	     (smtpmail-user-mail-address)
+	     ;; Fall back on the From: header as the envelope From
+	     ;; address.
+	     (let ((from (mail-fetch-field "from")))
+	       (and from
+		    (cadr (mail-extract-address-components from))))))
 	response-code
 	process-buffer
 	result