Make sendmail-query-once update send-mail-function directly.

[bpt/emacs.git] / lisp / mail / smtpmail.el

diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 3b406fa..544570a 100644 (file)
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -55,15 +55,12 @@
 ;;; Code:
 
 (require 'sendmail)
+(require 'auth-source)
 (autoload 'mail-strip-quoted-names "mail-utils")
 (autoload 'message-make-date "message")
 (autoload 'message-make-message-id "message")
 (autoload 'rfc2104-hash "rfc2104")
-(autoload 'netrc-parse "netrc")
-(autoload 'netrc-machine "netrc")
-(autoload 'netrc-get "netrc")
 (autoload 'password-read "password-cache")
-(autoload 'auth-source-search "auth-source")
 
 ;;;
 (defgroup smtpmail nil
@@ -89,6 +86,12 @@ The default value would be \"smtp\" or 25."
   :type '(choice (integer :tag "Port") (string :tag "Service"))
   :group 'smtpmail)
 
+(defcustom smtpmail-smtp-user nil
+  "User name to use when looking up credentials."
+  :version "24.1"
+  :type '(choice (const nil) string)
+  :group 'smtpmail)
+
 (defcustom smtpmail-local-domain nil
   "Local domain name without a host name.
 If the function `system-name' returns the full internet address,
@@ -487,12 +490,13 @@ The list is in preference order.")
   (let* ((mechs (cdr-safe (assoc 'auth supported-extensions)))
         (mech (car (smtpmail-intersection mechs smtpmail-auth-supported)))
         (auth-source-creation-prompts
-          '((user  . "SMTP user at %h: ")
+          '((user  . "SMTP user name for %h: ")
             (secret . "SMTP password for %u@%h: ")))
          (auth-info (car
                     (auth-source-search
                      :host host
                      :port port
+                     :user smtpmail-smtp-user
                      :max 1
                      :require (and ask-for-password
                                    '(:user :secret))
@@ -502,6 +506,8 @@ The list is in preference order.")
         (save-function (and ask-for-password
                             (plist-get auth-info :save-function)))
         ret)
+    (when (functionp password)
+      (setq password (funcall password)))
     (when (and user
               (not password))
       ;; The user has stored the user name, but not the password, so
@@ -513,6 +519,7 @@ The list is in preference order.")
              :max 1
              :host host
              :port port
+             :user smtpmail-smtp-user
              :require '(:user :secret)
              :create t))
            password (plist-get auth-info :secret)))
@@ -596,8 +603,10 @@ The list is in preference order.")
       (push smtpmail-smtp-server ports))
     (while (and (not smtpmail-smtp-server)
                (setq port (pop ports)))
-      (when (setq stream (ignore-errors
-                          (open-network-stream "smtp" nil server port)))
+      (when (setq stream (condition-case ()
+                            (open-network-stream "smtp" nil server port)
+                          (quit nil)
+                          (error nil)))
        (customize-save-variable 'smtpmail-smtp-server server)
        (customize-save-variable 'smtpmail-smtp-service port)
        (delete-process stream)))
@@ -618,8 +627,6 @@ The list is in preference order.")
                            (and mail-specify-envelope-from
                                 (mail-envelope-from))
                            user-mail-address))
-       (coding-system-for-read 'binary)
-       (coding-system-for-write 'binary)
        response-code
        process-buffer
        result
@@ -638,21 +645,23 @@ The list is in preference order.")
            (erase-buffer))
 
          ;; open the connection to the server
-         (setq result
-               (open-network-stream
-                "smtpmail" process-buffer host port
-                :type smtpmail-stream-type
-                :return-list t
-                :capability-command (format "EHLO %s\r\n" (smtpmail-fqdn))
-                :end-of-command "^[0-9]+ .*\r\n"
-                :success "^2.*\n"
-                :always-query-capabilities t
-                :starttls-function
-                (lambda (capabilities)
-                  (and (string-match "-STARTTLS" capabilities)
-                       "STARTTLS\r\n"))
-                :client-certificate t
-                :use-starttls-if-possible t))
+         (let ((coding-system-for-read 'binary)
+               (coding-system-for-write 'binary))
+           (setq result
+                 (open-network-stream
+                  "smtpmail" process-buffer host port
+                  :type smtpmail-stream-type
+                  :return-list t
+                  :capability-command (format "EHLO %s\r\n" (smtpmail-fqdn))
+                  :end-of-command "^[0-9]+ .*\r\n"
+                  :success "^2.*\n"
+                  :always-query-capabilities t
+                  :starttls-function
+                  (lambda (capabilities)
+                    (and (string-match "-STARTTLS" capabilities)
+                         "STARTTLS\r\n"))
+                  :client-certificate t
+                  :use-starttls-if-possible t)))
 
          ;; If we couldn't access the server at all, we give up.
          (unless (setq process (car result))
@@ -669,7 +678,7 @@ The list is in preference order.")
              (throw 'done (format "No greeting: %s" greeting)))
            (when (>= code 400)
              (throw 'done (format "Connection not allowed: %s" greeting))))
-         
+
          (with-current-buffer process-buffer
            (set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix)
            (make-local-variable 'smtpmail-read-point)
@@ -722,7 +731,7 @@ The list is in preference order.")
 
            (when (member 'xusr supported-extensions)
              (smtpmail-command-or-throw process (format "XUSR")))
-           
+
            ;; MAIL FROM:<sender>
            (let ((size-part
                   (if (or (member 'size supported-extensions)
@@ -761,7 +770,7 @@ The list is in preference order.")
                )
               ((and auth-mechanisms
                     (not ask-for-password)
-                    (= (car result) 530))
+                    (eq (car result) 530))
                ;; We got a "530 auth required", so we close and try
                ;; again, this time asking the user for a password.
                (smtpmail-send-command process "QUIT")
@@ -788,6 +797,7 @@ The list is in preference order.")
                  nil)
                 ((and auth-mechanisms
                       (not ask-for-password)
+                      (integerp (car result))
                       (>= (car result) 550)
                       (<= (car result) 554))
                  ;; We got a "550 relay not permitted" (or the like),