From 563790b6db1fed5d81809ca826e19685b78461f4 Mon Sep 17 00:00:00 2001 From: Ted Zlatanov Date: Sat, 12 Feb 2011 11:51:02 -0600 Subject: [PATCH] Use `auto-source-search' instead of `auto-source-user-or-password'. * mail/smtpmail.el: Autoload `auto-source-search' instead of `auto-source-user-or-password. (smtpmail-try-auth-methods): Use it. * net/imap-hash.el: Autoload `auto-source-search' instead of `auto-source-user-or-password. (imap-hash-open-connection): Use it. * net/tramp-imap.el: Autoload `auto-source-search' instead of `auto-source-user-or-password. (tramp-imap-passphrase-callback-function): Use it. * net/tramp.el (tramp-default-method): Also check if `auth-source-search' is bound. (tramp-read-passwd): Use `auth-source-search' instead of `auto-source-user-or-password'. * url-parse.el (url-bit-for-url, url-user-for-url) (url-password-for-url): Use `auto-source-search' instead of `auto-source-user-or-password'. * url-auth.el: Autoload `auto-source-search' instead of `auto-source-user-or-password'. (url-basic-auth, url-digest-auth, url-do-auth-source-search): Use it. --- lisp/ChangeLog | 19 +++++++++++++++++++ lisp/mail/smtpmail.el | 14 +++++++++----- lisp/net/imap-hash.el | 13 +++++++------ lisp/net/tramp-imap.el | 12 +++++++++--- lisp/net/tramp.el | 24 ++++++++++++++++++++---- lisp/url/ChangeLog | 10 ++++++++++ lisp/url/url-auth.el | 25 ++++++++++++++++--------- lisp/url/url-parse.el | 17 +++++++++++------ 8 files changed, 101 insertions(+), 33 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e8308059963..797624be6fb 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,22 @@ +2011-02-12 Teodor Zlatanov + + * net/tramp.el (tramp-default-method): Also check if + `auth-source-search' is bound. + (tramp-read-passwd): Use `auth-source-search' instead of + `auto-source-user-or-password'. + + * net/tramp-imap.el: Autoload `auto-source-search' instead of + `auto-source-user-or-password. + (tramp-imap-passphrase-callback-function): Use it. + + * net/imap-hash.el: Autoload `auto-source-search' instead of + `auto-source-user-or-password. + (imap-hash-open-connection): Use it. + + * mail/smtpmail.el: Autoload `auto-source-search' instead of + `auto-source-user-or-password. + (smtpmail-try-auth-methods): Use it. + 2011-02-12 Phil Hagelberg * emacs-lisp/package.el: Allow packages to be reinstalled. diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index f726304704b..427d9d17746 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -77,7 +77,7 @@ (autoload 'netrc-machine "netrc") (autoload 'netrc-get "netrc") (autoload 'password-read "password-cache") -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-search "auth-source") ;;; (defgroup smtpmail nil @@ -538,10 +538,14 @@ The list is in preference order.") (defun smtpmail-try-auth-methods (process supported-extensions host port) (let* ((mechs (cdr-safe (assoc 'auth supported-extensions))) (mech (car (smtpmail-intersection mechs smtpmail-auth-supported))) - (auth-user (auth-source-user-or-password - "login" host (or port "smtp"))) - (auth-pass (auth-source-user-or-password - "password" host (or port "smtp"))) + (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-pass (if (functionp auth-pass) + (funcall auth-pass) + auth-pass)) (cred (if (and auth-user auth-pass) ; try user-auth-* before netrc-* (list host port auth-user auth-pass) ;; else, if auth-source didn't return them... diff --git a/lisp/net/imap-hash.el b/lisp/net/imap-hash.el index d21b714d950..a07277cee68 100644 --- a/lisp/net/imap-hash.el +++ b/lisp/net/imap-hash.el @@ -43,7 +43,7 @@ (require 'imap) (require 'sendmail) ; for mail-header-separator (require 'message) -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-search "auth-source") ;; retrieve these headers (defvar imap-hash-headers @@ -267,13 +267,14 @@ The function is passed the message headers (see `imap-hash-get-headers')." (imap-hash-password iht)))) ;; this will not be needed if auth-need is t (auth-info (when auth-need - (auth-source-user-or-password - '("login" "password") - server port))) + (nth 0 (auth-source-search :host server :port port)))) (auth-user (or (imap-hash-user iht) - (nth 0 auth-info))) + (plist-get auth-info :user))) (auth-passwd (or (imap-hash-password iht) - (nth 1 auth-info))) + (plist-get auth-info :secret))) + (auth-passwd (if (functionp auth-passwd) + (funcall auth-passwd) + auth-passwd)) (imap-logout-timeout nil)) ;; (debug "opening server: opened+state" (imap-opened) imap-state) diff --git a/lisp/net/tramp-imap.el b/lisp/net/tramp-imap.el index 3a536103c3d..4157265b0e1 100644 --- a/lisp/net/tramp-imap.el +++ b/lisp/net/tramp-imap.el @@ -56,7 +56,7 @@ (require 'assoc) (require 'tramp) -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-search "auth-source") (autoload 'epg-context-operation "epg") (autoload 'epg-context-set-armor "epg") (autoload 'epg-context-set-passphrase-callback "epg") @@ -639,8 +639,14 @@ HANDBACK is just carried through. KEY-ID can be 'SYM or 'PIN among others." (let* ((server tramp-current-host) (port "tramp-imap") ; this is NOT the server password! - (auth-passwd - (auth-source-user-or-password "password" server port))) + (auth-passwd (plist-get + (nth 0 (auth-source-search :max 1 + :host server + :port port)) + :secret)) + (auth-passwd (if (functionp auth-passwd) + (funcall auth-passwd) + auth-passwd))) (or (copy-sequence auth-passwd) ;; If we cache the passphrase and we have one. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 8584d4ddc92..5d0f3935884 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -297,6 +297,7 @@ shouldn't return t when it isn't." (executable-find "pscp")) (if (or (fboundp 'password-read) (fboundp 'auth-source-user-or-password) + (fboundp 'auth-source-search) ;; Pageant is running. (tramp-compat-process-running-p "Pageant")) "pscp" @@ -307,6 +308,7 @@ shouldn't return t when it isn't." ((tramp-detect-ssh-controlmaster) "scpc") ((or (fboundp 'password-read) (fboundp 'auth-source-user-or-password) + (fboundp 'auth-source-search) ;; ssh-agent is running. (getenv "SSH_AUTH_SOCK") (getenv "SSH_AGENT_PID")) @@ -3519,7 +3521,8 @@ Invokes `password-read' if available, `read-passwd' else." (or prompt (with-current-buffer (process-buffer proc) (tramp-check-for-regexp proc tramp-password-prompt-regexp) - (format "%s for %s " (capitalize (match-string 1)) key))))) + (format "%s for %s " (capitalize (match-string 1)) key)))) + auth-info auth-passwd) (with-parsed-tramp-file-name key nil (prog1 (or @@ -3527,9 +3530,22 @@ Invokes `password-read' if available, `read-passwd' else." (and (boundp 'auth-sources) (tramp-get-connection-property v "first-password-request" nil) ;; Try with Tramp's current method. - (tramp-compat-funcall - 'auth-source-user-or-password - "password" tramp-current-host tramp-current-method)) + (if (fboundp 'auth-source-search) + (progn + (setq auth-info + (tramp-compat-funcall + 'auth-source-search + :max 1 + :user (or tramp-current-user t) + :host tramp-current-host + :port tramp-current-method)) + (setq auth-passwd (plist-get (nth 0 auth-info) :secret)) + (setq auth-passwd (if (functionp auth-passwd) + (funcall auth-passwd) + auth-passwd))) + (tramp-compat-funcall + 'auth-source-user-or-password + "password" tramp-current-host tramp-current-method))) ;; Try the password cache. (when (functionp 'password-read) (unless (tramp-get-connection-property diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 742a3cfb9b5..3c7b8b6abe7 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,13 @@ +2011-02-12 Teodor Zlatanov + + * url-parse.el (url-bit-for-url, url-user-for-url) + (url-password-for-url): Use `auto-source-search' instead of + `auto-source-user-or-password'. + + * url-auth.el: Autoload `auto-source-search' instead of + `auto-source-user-or-password'. + (url-basic-auth, url-digest-auth, url-do-auth-source-search): Use it. + 2011-02-03 Lars Ingebrigtsen * url-http.el (url-http-wait-for-headers-change-function): Don't diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el index 842e2a3be8d..5261302a15c 100644 --- a/lisp/url/url-auth.el +++ b/lisp/url/url-auth.el @@ -24,7 +24,7 @@ (require 'url-vars) (require 'url-parse) (autoload 'url-warn "url") -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-search "auth-source") (defsubst url-auth-user-prompt (url realm) "String to usefully prompt for a username." @@ -81,11 +81,11 @@ instead of the filename inheritance method." (cond ((and prompt (not byserv)) (setq user (or - (auth-source-user-or-password "login" server type) + (url-do-auth-source-search server type :user) (read-string (url-auth-user-prompt url realm) (or user (user-real-login-name)))) pass (or - (auth-source-user-or-password "password" server type) + (url-do-auth-source-search server type :secret) (read-passwd "Password: " nil (or pass "")))) (set url-basic-auth-storage (cons (list server @@ -110,11 +110,11 @@ instead of the filename inheritance method." (if (or (and (not retval) prompt) overwrite) (progn (setq user (or - (auth-source-user-or-password "login" server type) + (url-do-auth-source-search server type :user) (read-string (url-auth-user-prompt url realm) (user-real-login-name))) pass (or - (auth-source-user-or-password "password" server type) + (url-do-auth-source-search server type :secret) (read-passwd "Password: ")) retval (base64-encode-string (format "%s:%s" user pass)) byserv (assoc server (symbol-value url-basic-auth-storage))) @@ -173,11 +173,11 @@ instead of hostname:portnum." (cond ((and prompt (not byserv)) (setq user (or - (auth-source-user-or-password "login" server type) + (url-do-auth-source-search server type :user) (read-string (url-auth-user-prompt url realm) (user-real-login-name))) pass (or - (auth-source-user-or-password "password" server type) + (url-do-auth-source-search server type :secret) (read-passwd "Password: ")) url-digest-auth-storage (cons (list server @@ -204,11 +204,11 @@ instead of hostname:portnum." (if overwrite (if (and (not retval) prompt) (setq user (or - (auth-source-user-or-password "login" server type) + (url-do-auth-source-search server type :user) (read-string (url-auth-user-prompt url realm) (user-real-login-name))) pass (or - (auth-source-user-or-password "password" server type) + (url-do-auth-source-search server type :secret) (read-passwd "Password: ")) retval (setq retval (cons user @@ -244,6 +244,13 @@ instead of hostname:portnum." "A list of the registered authorization schemes and various and sundry information associated with them.") +(defun url-do-auth-source-search (server type parameter) + (let* ((auth-info (auth-source-search :max 1 :host server :port type)) + (auth-info (nth 0 auth-info)) + (token (plist-get auth-info parameter)) + (token (if (functionp token) (funcall token) token))) + token)) + ;;;###autoload (defun url-get-authentication (url realm type prompt &optional args) "Return an authorization string suitable for use in the WWW-Authenticate diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index 950f666e9c7..71c03bf1edd 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el @@ -178,20 +178,25 @@ TYPE USER PASSWORD HOST PORTSPEC FILENAME TARGET ATTRIBUTES FULLNESS." `(let* ((urlobj (url-generic-parse-url url)) (bit (funcall ,method urlobj)) (methods (list 'url-recreate-url - 'url-host))) + 'url-host)) + auth-info) (while (and (not bit) (> (length methods) 0)) - (setq bit - (auth-source-user-or-password - ,lookfor (funcall (pop methods) urlobj) (url-type urlobj)))) + (setq auth-info (auth-source-search + :max 1 + :host (funcall (pop methods) urlobj) + :port (url-type urlobj))) + (setq bit (plist-get (nth 0 auth-info) ,lookfor)) + (when (functionp bit) + (setq bit (funcall bit)))) bit)) (defun url-user-for-url (url) "Attempt to use .authinfo to find a user for this URL." - (url-bit-for-url 'url-user "login" url)) + (url-bit-for-url 'url-user :user url)) (defun url-password-for-url (url) "Attempt to use .authinfo to find a password for this URL." - (url-bit-for-url 'url-password "password" url)) + (url-bit-for-url 'url-password :secret url)) (provide 'url-parse) -- 2.39.5