From: Ted Zlatanov <tzz@lifelogs.com>
To: emacs-devel@gnu.org
Cc: tramp-devel@mail.freesoftware.fsf.org, ding@gnus.org
Subject: auth-source.el API change: Gnus and Emacs sync
Date: Thu, 10 Feb 2011 16:37:10 -0600 [thread overview]
Message-ID: <87oc6j8qjt.fsf@lifelogs.com> (raw)
[-- Attachment #1: Type: text/plain, Size: 1041 bytes --]
I have an important change to the auth-source API. I am attaching a
patch against the Emacs trunk (including Tramp) to change calls of
`auth-source-user-or-password' to calls of `auth-source-search'. The
code is not well tested yet and I will do a final test before pushing it
out in addition to revising the auth.texi manual and providing ChangeLog
entries. I want to know if there are any comments or protests before
doing this. Katsumi Yamaoka will have to synchronize his push from Gnus
with applying the patch, so I want this to be a smooth transition for
all the Emacs users and developers. I plan to make it by Saturday
2011-02-10 so please let me know beforehand.
auth-source.el lives inside Gnus; the new version is in a branch there.
That branch also has *tested* fixes for all the Gnus calls of
auth-source-*. That's why the attached Emacs patch doesn't include Gnus
changes.
I am attaching 1) auth-source.el from the Gnus tzz-auth-source-rewrite
branch; 2) the patch against the Emacs trunk including Tramp.
Thanks
Ted
[-- Attachment #2: auth-source.el --]
[-- Type: application/emacs-lisp, Size: 48193 bytes --]
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: auth-source-search.patch --]
[-- Type: text/x-diff, Size: 10145 bytes --]
=== 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)
next reply other threads:[~2011-02-10 22:37 UTC|newest]
Thread overview: 20+ messages / expand[flat|nested] mbox.gz Atom feed top
2011-02-10 22:37 Ted Zlatanov [this message]
2011-02-11 4:13 ` Joseph Gay
2011-02-11 14:12 ` Ted Zlatanov
2011-02-11 21:16 ` Joseph Gay
2011-02-11 22:06 ` Ted Zlatanov
2011-02-11 8:21 ` Michael Albinus
2011-02-11 13:54 ` Ted Zlatanov
2011-02-11 16:37 ` Michael Albinus
2011-02-11 17:28 ` Ted Zlatanov
2011-02-12 13:49 ` Ted Zlatanov
2011-02-12 14:05 ` Michael Albinus
2011-02-12 18:00 ` Ted Zlatanov
2011-02-11 17:30 ` tramp-imap removal? (was: auth-source.el API change: Gnus and Emacs sync) Ted Zlatanov
2011-02-11 18:15 ` tramp-imap removal? Robert Pluim
2011-02-12 13:55 ` Ted Zlatanov
2011-02-12 18:56 ` Steinar Bang
2011-02-14 15:21 ` Ted Zlatanov
2011-02-13 13:00 ` Michael Albinus
2011-02-13 13:27 ` imap-hash.el and imap.el removed (was: tramp-imap removal?) Ted Zlatanov
2011-02-12 13:48 ` auth-source.el API change: Gnus and Emacs sync Ted Zlatanov
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87oc6j8qjt.fsf@lifelogs.com \
--to=tzz@lifelogs.com \
--cc=ding@gnus.org \
--cc=emacs-devel@gnu.org \
--cc=tramp-devel@mail.freesoftware.fsf.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).