unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* auth-source.el API change: Gnus and Emacs sync
@ 2011-02-10 22:37 Ted Zlatanov
  2011-02-11  8:21 ` Michael Albinus
  2011-02-12 13:48 ` auth-source.el API change: Gnus and Emacs sync Ted Zlatanov
  0 siblings, 2 replies; 14+ messages in thread
From: Ted Zlatanov @ 2011-02-10 22:37 UTC (permalink / raw)
  To: emacs-devel; +Cc: tramp-devel, ding

[-- 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)
 


^ permalink raw reply	[flat|nested] 14+ messages in thread

end of thread, other threads:[~2011-02-13 13:27 UTC | newest]

Thread overview: 14+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2011-02-10 22:37 auth-source.el API change: Gnus and Emacs sync 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-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

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

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 read-only IMAP folder(s) and NNTP newsgroup(s).