From: Sam Steingold <sds@gnu.org>
Date: Thu, 6 Jan 2022 19:42:10 +0000 (-0500)
Subject: Add `auth-info-password' and use it instead of ad hoc code
X-Git-Tag: emacs-29.0.90~3207
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ad5cf84fa737d26ed12e75e09e5f079df0efe5f6;p=emacs.git

Add `auth-info-password' and use it instead of ad hoc code

* lisp/auth-source.el (auth-info-password):
  Extract from `auth-source-pick-first-password'.
(auth-source-pick-first-password, auth-source-secrets-create)
(auth-source-user-and-password): Use `auth-info-password'.
* lisp/erc/erc-services.el (erc-nickserv-get-password):
  Use `auth-source-pick-first-password'.
* lisp/erc/erc.el (erc-open, erc-server-join-channel): Likewise.
* lisp/gnus/mail-source.el (mail-source-set-1): Add a comment.
* lisp/gnus/nnimap.el (nnimap-credentials): Use `auth-info-password'.
* lisp/gnus/nntp.el (nntp-send-authinfo): Likewise.
* lisp/mail/rmail.el (rmail-get-remote-password): Likewise.
* lisp/mail/smtpmail.el (smtpmail-try-auth-methods): Likewise.
* lisp/net/sieve-manage.el (sieve-sasl-auth): Likewise.
* lisp/net/tramp.el (tramp-read-passwd): Likewise.
* lisp/net/rcirc.el (rcirc): Likewise (fixes a bug: the possibility
  that password might be a function was not handled).
---

diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 80c220561a6..046a685d744 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -853,15 +853,17 @@ while \(:host t) would find all host entries."
               (cl-return 'no)))
           'no))))
 
-(defun auth-source-pick-first-password (&rest spec)
-  "Pick the first secret found from applying SPEC to `auth-source-search'."
-  (let* ((result (nth 0 (apply #'auth-source-search (plist-put spec :max 1))))
-         (secret (plist-get result :secret)))
-
+(defun auth-info-password (auth-info)
+  "Return the :secret password from the AUTH-INFO."
+  (let ((secret (plist-get auth-info :secret)))
     (if (functionp secret)
         (funcall secret)
       secret)))
 
+(defun auth-source-pick-first-password (&rest spec)
+  "Pick the first secret found from applying SPEC to `auth-source-search'."
+  (auth-info-password (car (apply #'auth-source-search (plist-put spec :max 1)))))
+
 (defun auth-source-format-prompt (prompt alist)
   "Format PROMPT using %x (for any character x) specifiers in ALIST.
 Remove trailing \": \"."
@@ -1800,10 +1802,9 @@ authentication tokens:
       (plist-put
        artificial
        :save-function
-       (let* ((collection collection)
-              (item (plist-get artificial :label))
-              (secret (plist-get artificial :secret))
-              (secret (if (functionp secret) (funcall secret) secret)))
+       (let ((collection collection)
+             (item (plist-get artificial :label))
+             (secret (auth-info-password artificial)))
          (lambda ()
 	   (auth-source-secrets-saver collection item secret args)))))
 
@@ -2410,9 +2411,7 @@ MODE can be \"login\" or \"password\"."
                         :require '(:user :secret)
                         :create nil))))
          (user (plist-get auth-info :user))
-         (password (plist-get auth-info :secret)))
-    (when (functionp password)
-      (setq password (funcall password)))
+         (password (auth-info-password auth-info)))
     (list user password auth-info)))
 
 ;;; Tiny mode for editing .netrc/.authinfo modes (that basically just
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index dcd786411f2..4b3ca7d23f7 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -444,15 +444,12 @@ it returns nil."
                           (cl-second (assoc network
                                             erc-nickserv-passwords)))))
             (when erc-use-auth-source-for-nickserv-password
-              (let ((secret (cl-first (auth-source-search
-                                       :max 1 :require '(:secret)
-                                       :host server
-                                       ;; Ensure a string for :port
-                                       :port (format "%s" port)
-                                       :user nick))))
-                (when secret
-                  (let ((passwd (plist-get secret :secret)))
-                    (if (functionp passwd) (funcall passwd) passwd)))))
+              (auth-source-pick-first-password
+               :require '(:secret)
+               :host server
+               ;; Ensure a string for :port
+               :port (format "%s" port)
+               :user nick))
             (when erc-prompt-for-nickserv-password
               (read-passwd
                (format "NickServ password for %s on %s (RET to cancel): "
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 24f47625711..5faeda9a132 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2062,19 +2062,12 @@ Returns the buffer for the given server or channel."
     ;; password stuff
     (setq erc-session-password
           (or passwd
-              (let ((secret
-                     (plist-get
-                      (nth 0
-                           (auth-source-search :host server
-                                               :max 1
-                                               :user nick
-                                               ;; secrets.el wouldn’t accept a number
-                                               :port (if (numberp port) (number-to-string port) port)
-                                               :require '(:secret)))
-                      :secret)))
-                (if (functionp secret)
-                    (funcall secret)
-                  secret))))
+              (auth-source-pick-first-password
+               :host server
+               :user nick
+               ;; secrets.el wouldn’t accept a number
+               :port (if (numberp port) (number-to-string port) port)
+               :require '(:secret))))
     ;; client certificate (only useful if connecting over TLS)
     (setq erc-session-client-certificate client-certificate)
     ;; debug output buffer
@@ -3187,16 +3180,12 @@ For a list of user commands (/join /part, ...):
 (put 'erc-cmd-HELP 'process-not-needed t)
 
 (defun erc-server-join-channel (server channel &optional secret)
-  (let* ((secret (or secret
-		     (plist-get (nth 0 (auth-source-search
-					:max 1
-					:host server
-					:port "irc"
-					:user channel))
-				:secret)))
-	 (password (if (functionp secret)
-		       (funcall secret)
-		     secret)))
+  (let ((password
+         (or secret
+             (auth-source-pick-first-password
+	      :host server
+	      :port "irc"
+	      :user channel))))
     (erc-log (format "cmd: JOIN: %s" channel))
     (erc-server-send (concat "JOIN " channel
 			     (if password
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index d2f5b9a97e2..9a48f710e55 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -454,7 +454,7 @@ the `mail-source-keyword-map' variable."
                                                   search))))
                     :user)))
              user-auth)
-            ((and
+            ((and               ; cf. 'auth-source-pick-first-password'
               (eq keyword :password)
               (setq pass-auth
                     (plist-get
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index ab4243e867f..090cb9b245b 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -40,6 +40,7 @@
 
 (autoload 'auth-source-forget+ "auth-source")
 (autoload 'auth-source-search "auth-source")
+(autoload 'auth-info-password "auth-source")
 
 (nnoo-declare nnimap)
 
@@ -407,10 +408,7 @@ during splitting, which may be slow."
                                            :create t))))
     (if found
         (list (plist-get found :user)
-	      (let ((secret (plist-get found :secret)))
-		(if (functionp secret)
-		    (funcall secret)
-		  secret))
+	      (auth-info-password found)
 	      (plist-get found :save-function))
       nil)))
 
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 990bb4426f4..624c64d4d75 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -36,6 +36,7 @@
 (eval-when-compile (require 'cl-lib))
 
 (autoload 'auth-source-search "auth-source")
+(autoload 'auth-info-password "auth-source")
 
 (defgroup nntp nil
   "NNTP access for Gnus."
@@ -1175,10 +1176,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the
 			  "563" "nntps" "snews"))))
          (auth-user (plist-get auth-info :user))
          (auth-force (plist-get auth-info :force))
-         (auth-passwd (plist-get auth-info :secret))
-         (auth-passwd (if (functionp auth-passwd)
-                          (funcall auth-passwd)
-                        auth-passwd))
+         (auth-passwd (auth-info-password auth-info))
 	 (force (or (netrc-get alist "force")
                     nntp-authinfo-force
                     auth-force))
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 55921eca685..3795377cd2b 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -4489,10 +4489,7 @@ password."
                                    :max 1 :user user :host host
                                    :require '(:secret)))))
                 (if found
-                    (let ((secret (plist-get found :secret)))
-                      (if (functionp secret)
-                          (funcall secret)
-                        secret))
+                    (auth-info-password found)
                   (read-passwd (if imap
                                    "IMAP password: "
                                  "POP password: "))))))
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 8ac0cd7e7c0..88e55e968c4 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -554,11 +554,9 @@ for `smtpmail-try-auth-method'.")
 		      :create ask-for-password)))
          (mech (or (plist-get auth-info :smtp-auth) (car mechs)))
          (user (plist-get auth-info :user))
-         (password (plist-get auth-info :secret))
+         (password (auth-info-password auth-info))
 	 (save-function (and ask-for-password
 			     (plist-get auth-info :save-function))))
-    (when (functionp password)
-      (setq password (funcall password)))
     (when (and user
 	       (not password))
       ;; The user has stored the user name, but not the password, so
@@ -573,9 +571,7 @@ for `smtpmail-try-auth-method'.")
 	      :user smtpmail-smtp-user
 	      :require '(:user :secret)
 	      :create t))
-	    password (plist-get auth-info :secret)))
-    (when (functionp password)
-      (setq password (funcall password)))
+	    password (auth-info-password auth-info)))
     (let ((result (catch 'done
                     (if (and mech user password)
 		        (smtpmail-try-auth-method process mech user password)
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 9a1153b3c6a..9d1600ed72f 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -560,8 +560,8 @@ If ARG is non-nil, instead prompt for connection parameters."
                      (auth (auth-source-search :host server
                                                :user user-name
                                                :port port))
-                     (fn (plist-get (car auth) :secret)))
-            (setq password (funcall fn)))
+                     (pwd (auth-info-password (car auth))))
+            (setq password pwd))
 	  (when server
 	    (let (connected)
 	      (dolist (p (rcirc-process-list))
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 468bc90a9d7..50342b9105a 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -79,6 +79,7 @@
 (require 'sasl)
 (autoload 'sasl-find-mechanism "sasl")
 (autoload 'auth-source-search "auth-source")
+(autoload 'auth-info-password "auth-source")
 
 ;; User customizable variables:
 
@@ -230,10 +231,7 @@ Return the buffer associated with the connection."
                                           :max 1
                                           :create t))
            (user-name (or (plist-get (nth 0 auth-info) :user) ""))
-           (user-password (or (plist-get (nth 0 auth-info) :secret) ""))
-           (user-password (if (functionp user-password)
-                              (funcall user-password)
-                            user-password))
+           (user-password (or (auth-info-password (nth 0 auth-info)) ""))
            (client (sasl-make-client (sasl-find-mechanism (list mech))
                                      user-name "sieve" sieve-manage-server))
            (sasl-read-passphrase
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index adde443fdd6..fdbb78123df 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -5756,10 +5756,7 @@ Invokes `password-read' if available, `read-passwd' else."
 			      :create t))
 			    tramp-password-save-function
 			    (plist-get auth-info :save-function)
-			    auth-passwd (plist-get auth-info :secret)))
-		 (while (functionp auth-passwd)
-		   (setq auth-passwd (funcall auth-passwd)))
-		 auth-passwd)
+			    auth-passwd (auth-info-password auth-info))))
 
 	       ;; Try the password cache.
 	       (progn