Changes committed gnus/lisp (6 files)

"Ted Zlatanov" <[email protected]> Mon, 26 Jan 2009 16:23:27 +0100
Newsgroups gmane.emacs.gnus.commits
Message-ID <[email protected]>
Modified: ChangeLog auth-source.el mail-source.el netrc.el nnimap.el
          nntp.el

* auth-source.el (auth-source-forget-user-or-password): Clarify docs.
(auth-source-forget-all-cached): New convenience function.
(auth-source-user-or-password): Accept list of modes or a single mode.

* mail-source.el (mail-source-bind, mail-source-set-1): Use list of
auth-source modes.

* netrc.el (netrc-machine-user-or-password): Use list of
auth-source modes.

* nnimap.el (nnimap-open-connection): Use list of
auth-source modes.

* nntp.el (nntp-send-authinfo): Use list of
auth-source modes.


Index: ChangeLog
diff -u gnus/lisp/ChangeLog:7.1982 gnus/lisp/ChangeLog:7.1983
--- ChangeLog:7.1982	Thu Jan 22 08:02:16 2009
+++ ChangeLog	Mon Jan 26 16:23:27 2009
@@ -1,3 +1,25 @@
+2009-01-26  Teodor Zlatanov  <[email protected]>
+
+	* auth-source.el (auth-source-forget-user-or-password): Clarify docs.
+	(auth-source-forget-all-cached): New convenience function.
+	(auth-source-user-or-password): Accept list of modes or a single mode.
+
+	* mail-source.el (mail-source-bind, mail-source-set-1): Use list of
+	auth-source modes.
+
+	* netrc.el (netrc-machine-user-or-password): Use list of
+	auth-source modes.
+
+	* nnimap.el (nnimap-open-connection): Use list of
+	auth-source modes.
+
+	* nntp.el (nntp-send-authinfo): Use list of
+	auth-source modes.
+
+2009-01-26  Teodor Zlatanov  <[email protected]>
+
+	* nntp.el (nntp-send-authinfo): 
+
 2009-01-16  Teodor Zlatanov  <[email protected]>
 
 	* auth-source.el: Update docs to reflect epa-file-enable is to be used
Index: auth-source.el
diff -u gnus/lisp/auth-source.el:7.15 gnus/lisp/auth-source.el:7.16
--- auth-source.el:7.15	Thu Jan 22 08:02:16 2009
+++ auth-source.el	Mon Jan 26 16:23:27 2009
@@ -163,12 +163,20 @@
   (interactive "slogin/password: \nsHost: \nsProtocol: \n") ;for testing
   (remhash (format "%s %s:%s" mode host protocol) auth-source-cache))
 
+(defun auth-source-forget-all-cached ()
+  "Forget all cached auth-source authentication tokens."
+  (interactive)
+  (setq auth-source-cache (make-hash-table :test 'equal)))
+
 (defun auth-source-user-or-password (mode host protocol)
-  "Find user or password (from the string MODE) matching HOST and PROTOCOL."
+  "Find MODE (string or list of strings) matching HOST and PROTOCOL.
+MODE can be \"login\" or \"password\" for example."
   (gnus-message 9
 		"auth-source-user-or-password: get %s for %s (%s)"
 		mode host protocol)
-  (let* ((cname (format "%s %s:%s" mode host protocol))
+  (let* ((listy (listp mode))
+	 (mode (if listy mode (list mode)))
+	 (cname (format "%s %s:%s" mode host protocol))
 	 (found (gethash cname auth-source-cache)))
     (if found
 	(progn
@@ -176,7 +184,7 @@
 			"auth-source-user-or-password: cached %s=%s for %s (%s)"
 			mode
 			;; don't show the password
-			(if (equal mode "password") "SECRET" found)
+			(if (member "password" mode) "SECRET" found)
 			host protocol)
 	  found)
       (dolist (choice (auth-source-pick host protocol))
@@ -191,8 +199,9 @@
 			"auth-source-user-or-password: found %s=%s for %s (%s)"
 			mode
 			;; don't show the password
-			(if (equal mode "password") "SECRET" found)
+			(if (member "password" mode) "SECRET" found)
 			host protocol)
+	  (setq found (if listy found (car-safe found)))
 	  (when auth-source-do-cache
 	    (puthash cname found auth-source-cache)))
 	(return found)))))
Index: mail-source.el
diff -u gnus/lisp/mail-source.el:7.39 gnus/lisp/mail-source.el:7.40
--- mail-source.el:7.39	Thu Jan 22 08:02:16 2009
+++ mail-source.el	Mon Jan 26 16:23:27 2009
@@ -453,10 +453,11 @@
 (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 user-auth pass-auth)
+	 default value keyword auth-info user-auth pass-auth)
     (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
@@ -469,20 +470,21 @@
 	    ((and
 	     (eq keyword :user)
 	     (setq user-auth 
-		   (auth-source-user-or-password
-		    "login"
-		    ;; this is "host" in auth-sources
-		    (if (boundp 'server) (symbol-value 'server) "")
-		    type)))
+		   (nth 0 (auth-source-user-or-password
+			   '("login" "password")
+			   ;; this is "host" in auth-sources
+			   (if (boundp 'server) (symbol-value 'server) "")
+			   type))))
 	     user-auth)
 	    ((and
-	     (eq keyword :password)
-	     (setq pass-auth 
-		   (auth-source-user-or-password
-		    "password"
-		    ;; this is "host" in auth-sources
-		    (if (boundp 'server) (symbol-value 'server) "")
-		    type)))
+	      (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)
 	    (t (if (setq value (plist-get source keyword))
 		 (mail-source-value value)
Index: netrc.el
diff -u gnus/lisp/netrc.el:7.27 gnus/lisp/netrc.el:7.28
--- netrc.el:7.27	Thu Jan 22 08:02:16 2009
+++ netrc.el	Mon Jan 26 16:23:27 2009
@@ -158,11 +158,22 @@
 	(ports (or ports '(nil)))
 	(defaults (or defaults '(nil)))
 	info)
-    (dolist (machine machines)
-      (dolist (default defaults)
-	(dolist (port ports)
-	  (let ((alist (netrc-machine authinfo-list machine port default)))
-	    (setq info (or (netrc-get alist mode) info))))))
+    (if (listp mode)
+	(setq info 
+	      (mapcar 
+	       (lambda (mode-element) 
+		 (netrc-machine-user-or-password
+		  mode-element
+		  authinfo-list
+		  machines
+		  ports
+		  defaults))
+	       mode))
+      (dolist (machine machines)
+	(dolist (default defaults)
+	  (dolist (port ports)
+	    (let ((alist (netrc-machine authinfo-list machine port default)))
+	      (setq info (or (netrc-get alist mode) info)))))))
     info))
 
 (defun netrc-get (alist type)
Index: nnimap.el
diff -u gnus/lisp/nnimap.el:7.58 gnus/lisp/nnimap.el:7.59
--- nnimap.el:7.58	Thu Jan 22 08:02:16 2009
+++ nnimap.el	Mon Jan 26 16:23:27 2009
@@ -805,8 +805,12 @@
  	   (port (if nnimap-server-port
  		     (int-to-string nnimap-server-port)
  		   "imap"))
+	   (auth-info 
+	    (auth-source-user-or-password '("login" "password") server port))
+	   (auth-user (nth 0 auth-info))
+	   (auth-passwd (nth 1 auth-info))
 	   (user (or
-		  (auth-source-user-or-password "login" server port) ; this is preferred to netrc-*
+		  auth-user ; this is preferred to netrc-*
 		  (netrc-machine-user-or-password
 		   "login"
 		   list
@@ -816,7 +820,7 @@
 		   (list port)
 		   (list "imap" "imaps" "143" "993"))))
 	   (passwd (or
-		    (auth-source-user-or-password "password" server port) ; this is preferred to netrc-*
+		    auth-passwd ; this is preferred to netrc-*
 		    (netrc-machine-user-or-password
 		     "password"
 		     list
Index: nntp.el
diff -u gnus/lisp/nntp.el:7.51 gnus/lisp/nntp.el:7.52
--- nntp.el:7.51	Thu Jan 22 08:02:16 2009
+++ nntp.el	Mon Jan 26 16:23:27 2009
@@ -1179,14 +1179,18 @@
   (let* ((list (netrc-parse nntp-authinfo-file))
 	 (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))
 	 (user (or
 		;; this is preferred to netrc-*
-		(auth-source-user-or-password "login" nntp-address "nntp")
+		auth-user
 		(netrc-get alist "login")
 		nntp-authinfo-user))
 	 (passwd (or
 		  ;; this is preferred to netrc-*
-		  (auth-source-user-or-password "password" nntp-address "nntp")
+		  auth-passwd
 		  (netrc-get alist "password"))))
     (when (or (not send-if-force)
 	      force)