[Emacs-diffs] /srv/bzr/emacs/trunk r107215: Get the MAIL FROM from the From: header if no domain is configured

[Lars Ingebrigtsen]

------------------------------------------------------------
revno: 107215
committer: Lars Ingebrigtsen <address@hidden>
branch nick: trunk
timestamp: Thu 2012-02-09 23:42:12 +0100
message:
  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.
modified:
  lisp/ChangeLog
  lisp/mail/smtpmail.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-02-09 21:51:03 +0000
+++ b/lisp/ChangeLog    2012-02-09 22:42:12 +0000
@@ -1,3 +1,9 @@
+2012-02-09  Lars Ingebrigtsen  <address@hidden>
+
+       * 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  <address@hidden>
 
        * emacs-lisp/bytecomp.el (byte-compile-file-form-defvar):

=== modified file 'lisp/mail/smtpmail.el'
--- a/lisp/mail/smtpmail.el     2012-01-19 07:21:25 +0000
+++ b/lisp/mail/smtpmail.el     2012-02-09 22:42:12 +0000
@@ -200,7 +200,10 @@
        ;; 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 @@
     (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 @@
        (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