=== modified file 'lisp/mail/smtpmail.el' --- lisp/mail/smtpmail.el 2011-01-25 04:08:28 +0000 +++ lisp/mail/smtpmail.el 2011-02-10 22:10:16 +0000 @@ -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 @@ (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... === modified file 'lisp/net/imap-hash.el' --- lisp/net/imap-hash.el 2011-01-25 04:08:28 +0000 +++ lisp/net/imap-hash.el 2011-02-10 22:07:15 +0000 @@ -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 @@ (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) === modified file 'lisp/net/tramp-imap.el' --- lisp/net/tramp-imap.el 2011-02-05 09:52:07 +0000 +++ lisp/net/tramp-imap.el 2011-02-10 22:05:33 +0000 @@ -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 @@ 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. === modified file 'lisp/net/tramp.el' --- lisp/net/tramp.el 2011-02-05 09:58:45 +0000 +++ lisp/net/tramp.el 2011-02-10 22:01:47 +0000 @@ -297,6 +297,7 @@ (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 @@ ((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 @@ (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) (with-parsed-tramp-file-name key nil (prog1 (or @@ -3527,9 +3530,17 @@ (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)) + (setq auth-info + (tramp-compat-funcall + 'auth-source-search + :max 1 + :host tramp-current-host + :port tramp-current-method)) + ;; TODO: load assoc or use something besides plist-get + (setq auth-passwd (plist-get (nth 0 auth-info) :secret)) + (setq auth-passwd (if (functionp auth-passwd) + (funcall auth-passwd) + auth-passwd))) ;; Try the password cache. (when (functionp 'password-read) (unless (tramp-get-connection-property === modified file 'lisp/url/url-auth.el' --- lisp/url/url-auth.el 2011-01-25 04:08:28 +0000 +++ lisp/url/url-auth.el 2011-02-10 22:24:14 +0000 @@ -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 @@ (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 @@ (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 @@ (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 @@ (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 @@ "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 === modified file 'lisp/url/url-parse.el' --- lisp/url/url-parse.el 2011-01-25 04:08:28 +0000 +++ lisp/url/url-parse.el 2011-02-10 22:18:07 +0000 @@ -178,20 +178,25 @@ `(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)