[gnus git] branch tzz-auth-source-rewrite updated: =1= Use new auth-source search API for mail-source, nnimap, nntp.

Julien Danjou <[email protected]>
Newsgroups gmane.emacs.gnus.cvs
Message-ID <[email protected]>
       via  8894cb17aa25f5de7672f93fd52f4731f42ed9e0 (commit)
      from  e0f083f85fb22ef0c4aa3db9aa9f3e95dc3b7c30 (commit)


- Log -----------------------------------------------------------------
commit 8894cb17aa25f5de7672f93fd52f4731f42ed9e0
Author: Ted Zlatanov <[email protected]>
Date:   Tue Feb 8 16:24:44 2011 -0600

    Use new auth-source search API for mail-source, nnimap, nntp.
    
    * nntp.el: Autoload `auth-source-search'.
    (nntp-send-authinfo): Use it.  Note TODO.
    
    * nnimap.el: Autoload `auth-source-search'.
    (nnimap-credentials): Use it.
    (nnimap-open-connection-1): Ask for the virtual server and physical
    address in one shot.
    
    * mail-source.el: Autoload `auth-source-search'.
    (mail-source-keyword-map): Note order matters.
    (mail-source-set-1): Get all the mail-source source values and
    defaults and search auth-source on those if needed.  This can all
    probably be simplified.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 81cbf70..31d890d 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,19 @@
+2011-02-08  Teodor Zlatanov  <[email protected]>
+
+	* mail-source.el: Autoload `auth-source-search'.
+	(mail-source-keyword-map): Note order matters.
+	(mail-source-set-1): Get all the mail-source source values and
+	defaults and search auth-source on those if needed.  This can all
+	probably be simplified.
+
+	* nnimap.el: Autoload `auth-source-search'.
+	(nnimap-credentials): Use it.
+	(nnimap-open-connection-1): Ask for the virtual server and physical
+	address in one shot.
+
+	* nntp.el: Autoload `auth-source-search'.
+	(nntp-send-authinfo): Use it.  Note TODO.
+
 2011-02-08  Julien Danjou  <[email protected]>
 
 	* message.el (message-options): Make message-options a local variable.
diff --git a/lisp/mail-source.el b/lisp/mail-source.el
index f98c195..6e6ef76 100644
--- a/lisp/mail-source.el
+++ b/lisp/mail-source.el
@@ -32,7 +32,7 @@
 (eval-when-compile
   (require 'cl)
   (require 'imap))
-(autoload 'auth-source-user-or-password "auth-source")
+(autoload 'auth-source-search "auth-source")
 (autoload 'pop3-movemail "pop3")
 (autoload 'pop3-get-message-count "pop3")
 (autoload 'nnheader-cancel-timer "nnheader")
@@ -332,6 +332,7 @@ Common keywords should be listed here.")
        (:prescript)
        (:prescript-delay)
        (:postscript)
+       ;; note server and port need to come before user and password
        (:server (getenv "MAILHOST"))
        (:port 110)
        (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
@@ -345,6 +346,7 @@ Common keywords should be listed here.")
        (:subdirs ("cur" "new"))
        (:function))
       (imap
+       ;; note server and port need to come before user and password
        (:server (getenv "MAILHOST"))
        (:port)
        (:stream)
@@ -417,11 +419,33 @@ the `mail-source-keyword-map' variable."
 (put 'mail-source-bind 'lisp-indent-function 1)
 (put 'mail-source-bind 'edebug-form-spec '(sexp body))
 
-;; TODO: use the list format for auth-source-user-or-password modes
 (defun mail-source-set-1 (source)
   (let* ((type (pop source))
 	 (defaults (cdr (assq type mail-source-keyword-map)))
-	 default value keyword auth-info user-auth pass-auth)
+         (search '(:max 1))
+         found default value keyword auth-info user-auth pass-auth)
+
+    ;; append to the search the useful info from the source and the defaults:
+    ;; user, host, and port
+
+    ;; the msname is the mail-source parameter
+    (dolist (msname '(:server :user :port))
+      ;; the asname is the auth-source parameter
+      (let* ((asname (case msname
+                       (:server :host)  ; auth-source uses :host
+                       (t msname)))
+             ;; this is the mail-source default
+             (msdef1 (or (plist-get source msname)
+                         (nth 1 (assoc msname defaults))))
+             ;; ...evaluated
+             (msdef (mail-source-value msdef1)))
+        (setq search (append (list asname
+                                   (if msdef msdef t))
+                             search))))
+    ;; if the port is unknown yet, get it from the mail-source type
+    (unless (plist-get search :port)
+      (setq search (append (list :port (symbol-name type)))))
+
     (while (setq default (pop defaults))
       ;; for each default :SYMBOL, set SYMBOL to the plist value for :SYMBOL
       ;; using `mail-source-value' to evaluate the plist value
@@ -433,23 +457,25 @@ the `mail-source-keyword-map' variable."
 	   (cond
 	    ((and
 	     (eq keyword :user)
-	     (setq user-auth
-		   (nth 0 (auth-source-user-or-password
-			   '("login" "password")
-			   ;; this is "host" in auth-sources
-			   (if (boundp 'server) (symbol-value 'server) "")
-			   type))))
+             (setq user-auth (plist-get
+                              ;; cache the search result in `found'
+                              (or found
+                                  (setq found (nth 0 (apply 'auth-source-search
+                                                            search))))
+                              :user)))
 	     user-auth)
 	    ((and
 	      (eq keyword :password)
-	      (setq pass-auth
-		    (nth 1
-			 (auth-source-user-or-password
-			  '("login" "password")
-			  ;; this is "host" in auth-sources
-			  (if (boundp 'server) (symbol-value 'server) "")
-			  type))))
-	     pass-auth)
+              (setq pass-auth (plist-get
+                               ;; cache the search result in `found'
+                               (or found
+                                   (setq found (nth 0 (apply 'auth-source-search
+                                                             search))))
+                               :secret)))
+             ;; maybe set the password to the return of the :secret function
+             (if (functionp pass-auth)
+                 (setq pass-auth (funcall pass-auth))
+               pass-auth))
 	    (t (if (setq value (plist-get source keyword))
 		 (mail-source-value value)
 	       (mail-source-value (cadr default)))))))))
diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index a6fe6b1..41817c8 100644
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -48,7 +48,7 @@
 (require 'proto-stream)
 
 (autoload 'auth-source-forget-user-or-password "auth-source")
-(autoload 'auth-source-user-or-password "auth-source")
+(autoload 'auth-source-search "auth-source")
 
 (nnoo-declare nnimap)
 
@@ -275,18 +275,18 @@ textual parts.")
     (current-buffer)))
 
 (defun nnimap-credentials (address ports &optional inhibit-create)
-  (let (port credentials)
-    ;; Request the credentials from all ports, but only query on the
-    ;; last port if all the previous ones have failed.
-    (while (and (null credentials)
-		(setq port (pop ports)))
-      (setq credentials
-	    (auth-source-user-or-password
-	     '("login" "password") address port nil
-	     (if inhibit-create
+  (let* ((found (nth 0 (auth-source-search :max 1
+                                           :host address
+                                           :port ports
+                                           :create (if inhibit-create
 		 nil
 	       (null ports)))))
-    credentials))
+         (user (plist-get found :user))
+         (secret (plist-get found :secret))
+         (secret (if (functionp secret) (funcall secret) secret)))
+    (if found
+        (list user secret)
+      nil)))
 
 (defun nnimap-keepalive ()
   (let ((now (current-time)))
@@ -381,14 +381,13 @@ textual parts.")
 			     (if (eq nnimap-authenticator 'anonymous)
 				 (list "anonymous"
 				       (message-make-address))
-			       (or
-				;; First look for the credentials based
-				;; on the virtual server name.
+                               ;; Look for the credentials based on
+                               ;; the virtual server name and the address
 				(nnimap-credentials
-				 (nnoo-current-server 'nnimap) ports t)
-				;; Then look them up based on the
-				;; physical address.
-				(nnimap-credentials nnimap-address ports)))))
+                                (list
+                                 (nnoo-current-server 'nnimap)
+                                 nnimap-address)
+                                ports t))))
 		  (setq nnimap-object nil)
 		(setq login-result
 		      (nnimap-login (car credentials) (cadr credentials)))
diff --git a/lisp/nntp.el b/lisp/nntp.el
index cae0150..173eda6 100644
--- a/lisp/nntp.el
+++ b/lisp/nntp.el
@@ -40,7 +40,7 @@
 
 (eval-when-compile (require 'cl))
 
-(autoload 'auth-source-user-or-password "auth-source")
+(autoload 'auth-source-search "auth-source")
 
 (defgroup nntp nil
   "NNTP access for Gnus."
@@ -1230,9 +1230,15 @@ If SEND-IF-FORCE, only send authinfo to the server if the
 	 (alist (netrc-machine list nntp-address "nntp"))
 	 (force (or (netrc-get alist "force") nntp-authinfo-force))
 	 (auth-info
-	  (auth-source-user-or-password '("login" "password") nntp-address "nntp"))
-	 (auth-user (nth 0 auth-info))
-	 (auth-passwd (nth 1 auth-info))
+          (nth 0 (auth-source-search :max 1
+                                     ;; TODO: allow the virtual server name too
+                                     :host nntp-address
+                                     :port '("119" "nntp"))))
+         (auth-user (plist-get auth-info :user))
+         (auth-passwd (plist-get auth-info :secret))
+         (auth-passwd (if (functionp auth-passwd)
+                          (funcall auth-passwd)
+                        auth-passwd))
 	 (user (or
 		;; this is preferred to netrc-*
 		auth-user

-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.

Summary of changes:
 lisp/ChangeLog      |   16 +++++++++
 lisp/mail-source.el |   88 +++++++++++++++++++++++++++++++++------------------
 lisp/nnimap.el      |   41 +++++++++++------------
 lisp/nntp.el        |   16 ++++++---
 4 files changed, 104 insertions(+), 57 deletions(-)

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".

The branch, tzz-auth-source-rewrite has been updated


hooks/post-receive
-- 
Gnus Project
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.