From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Thu, 9 Feb 2012 22:42:12 +0000 (+0100)
Subject: Get the MAIL FROM from the From: header if no domain is configured
X-Git-Tag: emacs-pretest-24.0.94~206
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=4c7e65bf4f3fb9d24ec23f68047486c3c182ff65;p=emacs.git

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.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index a0de2c88ac4..0769badf4f5 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2012-02-09  Lars Ingebrigtsen  <larsi@rusty>
+
+	* 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.
+
 2012-02-09  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* emacs-lisp/bytecomp.el (byte-compile-file-form-defvar):
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