Re: Outgoing mail defaults

[Ted Zlatanov <tzz@lifelogs.com>]

[-- Attachment #1: Type: text/plain, Size: 1812 bytes --]

On Mon, 21 Mar 2011 10:20:22 -0400 Stefan Monnier <monnier@iro.umontreal.ca> wrote: 

>> 1) ask the user about the SMTP server name if `smtpmail-auth-source' is
>> nil (the default)

>> 2) ask the user if the server connection info should be saved through
>> auth-source

SM> I guess such a question might sound unclear to an unsuspecting user;
SM> but if you phrase it as "do you need to use authentication" or something
SM> like that, it would be fine.

>> 3) if yes, do the auth-source creation prompts for user, port, and
>> password

>> 4) use Customize to save `smtpmail-host', `smtpmail-port', and
>> `smtpmail-auth-source' to t or 'never according to (2).  From now on the
>> user will either just use `smtpmail-host' and `smtpmail-port' or call
>> `auth-source-search' with :host ,smtpmail-host and (if the port is not
>> nil) :port ,smtpmail-port

This is implemented with `smtpmail-use-auth-source' set to 'ask by
default and then either t or nil as the user may desire.

`smtpmail-smtp-server' and `smtpmail-smtp-service' are obtained with
`read-string' and then we call `customize-save-variable' on them.  All
this happens in `smtpmail-via-smtp' and not `smtpmail-try-auth-methods'.

The :save-function is called on a successful auth exchange.

The patch is pretty simple overall.  You'll see that the creation
prompts are just for the user and the password, since the port and host
are guaranteed to be defined from earlier.

I'd also like to remove the netrc-* function calls if no one objects.
It would break people that expect ~/.authinfo and ~/.netrc to work.
Those are the usual defaults of `netrc-file' but we strongly encourage
~/.authinfo.gpg now, so I think the damage is justified as it may get
former netrc.el users to consider secure alternatives like EPA/EPG or
the Secrets API.

Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: smtpmail-create-auth.patch --]
[-- Type: text/x-diff, Size: 4105 bytes --]

=== modified file 'lisp/mail/smtpmail.el'
--- lisp/mail/smtpmail.el	2011-02-12 17:51:02 +0000
+++ lisp/mail/smtpmail.el	2011-03-21 19:40:38 +0000
@@ -103,6 +103,13 @@
   :type '(choice (integer :tag "Port") (string :tag "Service"))
   :group 'smtpmail)
 
+(defcustom smtpmail-use-auth-source 'ask
+  "Whether `auth-sources' should be consulted for username and password."
+  :type '(choice (const :tag "Ask" ask)
+                 (const :tag "Don't use auth-source" nil)
+                 (const :tag "Use auth-source" t))
+  :group 'smtpmail)
+
 (defcustom smtpmail-local-domain nil
   "Local domain name without a host name.
 If the function `system-name' returns the full internet address,
@@ -480,6 +487,9 @@
 (defsubst smtpmail-cred-passwd (cred)
   (nth 3 cred))
 
+(defsubst smtpmail-cred-saver-function (cred)
+  (nth 4 cred))
+
 (defun smtpmail-find-credentials (cred server port)
   (catch 'done
     (let ((l cred) el)
@@ -536,18 +546,33 @@
 (declare-function password-cache-add "password-cache" (key password))
 
 (defun smtpmail-try-auth-methods (process supported-extensions host port)
+
+  ;; Find out if auth-source should be consulted
+  (when (eq smtpmail-use-auth-source 'ask)
+    (customize-save-variable
+     'smtpmail-use-auth-source
+     (y-or-n-p "Do you need authentication for SMTP? ")))
+
   (let* ((mechs (cdr-safe (assoc 'auth supported-extensions)))
 	 (mech (car (smtpmail-intersection mechs smtpmail-auth-supported)))
-         (auth-info (auth-source-search :max 1
-                                        :host host
-                                        :port (or port "smtp")))
-         (auth-user (plist-get (nth 0 auth-info) :user))
-         (auth-pass (plist-get (nth 0 auth-info) :secret))
+         (auth-source-creation-prompts
+          '((user . "SMTP user at %h: ")
+            (secret . "SMTP password for %u@%h: ")))
+         (auth-results (and smtpmail-use-auth-source
+                            (auth-source-search :max 1
+                                                :create t
+                                                :host host
+                                                :port (or port "smtp"))))
+         (auth-info (nth 0 auth-results))
+         (auth-user (plist-get auth-info :user))
+         (auth-pass (plist-get auth-info :secret))
          (auth-pass (if (functionp auth-pass)
                         (funcall auth-pass)
                       auth-pass))
+         (auth-saver (plist-get auth-info :save-function))
 	 (cred (if (and auth-user auth-pass) ; try user-auth-* before netrc-*
-		   (list host port auth-user auth-pass)
+                   ;; remember the :save-function for later
+		   (list host port auth-user auth-pass auth-saver)
 		 ;; else, if auth-source didn't return them...
 		 (if (stringp smtpmail-auth-credentials)
 		     (let* ((netrc (netrc-parse smtpmail-auth-credentials))
@@ -636,9 +661,11 @@
 
        (t
 	(error "Mechanism %s not implemented" mech)))
-      ;; Remember the password.
-      (when (null (smtpmail-cred-passwd cred))
-	(password-cache-add prompt passwd)))))
+      ;; Remember the password or call the auth-source :save-function.
+      (cond ((null (smtpmail-cred-passwd cred))
+             (password-cache-add prompt passwd))
+            ((functionp (smtpmail-cred-saver-function cred))
+             (funcall (smtpmail-cred-saver-function cred)))))))
 
 (defun smtpmail-via-smtp (recipient smtpmail-text-buffer)
   (let ((process nil)
@@ -655,6 +682,17 @@
 	greeting
 	process-buffer
 	(supported-extensions '()))
+    ;; If the host is nil, read host and port and save them in Customize.
+    (unless host
+      (setq host (customize-save-variable
+                  'smtpmail-smtp-server
+                  (read-string "SMTP server: ")))
+      (setq port (customize-save-variable
+                  'smtpmail-smtp-service
+                  (read-string
+                   "SMTP port number or service name: "
+                   nil nil (or port smtpmail-smtp-service)))))
+
     (unwind-protect
 	(catch 'done
 	  ;; get or create the trace buffer