[gnus git] branch master updated: n0-13-84-g586b9b2 =1= Bring in :require and :save-function support.

Ted Zlatanov <[email protected]>
Newsgroups gmane.emacs.gnus.cvs
Message-ID <[email protected]>
       via  586b9b22b277798623e2d4c983c36891e0fd61fb (commit)
      from  1a2936cbc8b4b584becd8426ac4959957e0595fd (commit)


- Log -----------------------------------------------------------------
commit 586b9b22b277798623e2d4c983c36891e0fd61fb
Author: Ted Zlatanov <[email protected]>
Date:   Tue Mar 8 12:22:28 2011 -0600

    Bring in :require and :save-function support.
    
    * auth-source.el (auth-source-search): Add :require parameter, taking a
    list.  Document it and the :save-function return token.  Pass :require
    down.  Change the CREATED message from a warning to a debug statement.
    (auth-source-search-backends): Pass :require down.
    (auth-source-netrc-search): Pass :require down.
    (auth-source-netrc-parse): Use :require, if it's given, as a filter.
    Change save prompt to indicate all modifications saved here are
    deletions.
    (auth-source-netrc-create): Take user login name as default in user
    prompt.  Move all the save functionality to a lexically bound function
    under the :save-function token in the returned list.
    (auth-source-netrc-saver): New function, intended to be wrapped for
    :save-function.
    
    * nnimap.el (nnimap-credentials): Keep the :save-function as the third
    parameter in the credentials.
    (nnimap-open-connection-1): Use it after a successful login.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index e3afe7c..238f091 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,23 @@
+2011-03-08  Teodor Zlatanov  <[email protected]>
+
+	* nnimap.el (nnimap-credentials): Keep the :save-function as the third
+	parameter in the credentials.
+	(nnimap-open-connection-1): Use it after a successful login.
+
+	* auth-source.el (auth-source-search): Add :require parameter, taking a
+	list.  Document it and the :save-function return token.  Pass :require
+	down.  Change the CREATED message from a warning to a debug statement.
+	(auth-source-search-backends): Pass :require down.
+	(auth-source-netrc-search): Pass :require down.
+	(auth-source-netrc-parse): Use :require, if it's given, as a filter.
+	Change save prompt to indicate all modifications saved here are
+	deletions.
+	(auth-source-netrc-create): Take user login name as default in user
+	prompt.  Move all the save functionality to a lexically bound function
+	under the :save-function token in the returned list.
+	(auth-source-netrc-saver): New function, intended to be wrapped for
+	:save-function.
+
 2011-03-07  Lars Magne Ingebrigtsen  <[email protected]>
 
 	* shr.el (shr-table-horizontal-line): Change the defaults for the table
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 26e23a7..24d4fad 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -403,7 +403,7 @@ parameters."
 
 (defun* auth-source-search (&rest spec
                                   &key type max host user port secret
-                                  create delete
+                                  require create delete
                                   &allow-other-keys)
   "Search or modify authentication backends according to SPEC.
 
@@ -497,6 +497,11 @@ should `catch' the backend-specific error as usual.  Some
 backends (netrc, at least) will prompt the user rather than throw
 an error.
 
+:require (A B C) means that only results that contain those
+tokens will be returned.  Thus for instance requiring :secret
+will ensure that any results will actually have a :secret
+property.
+
 :delete t means to delete any found entries.  nil by default.
 Use `auth-source-delete' in ELisp code instead of calling
 `auth-source-search' directly with this parameter.
@@ -526,11 +531,17 @@ is a plist with keys :backend :host :port :user, plus any other
 keys provided by the backend (notably :secret).  But note the
 exception for :max 0, which see above.
 
+The token can hold a :save-function key.  If you call that, the
+user will be prompted to save the data to the backend.  You can't
+request that this should happen right after creation, because
+`auth-source-search' has no way of knowing if the token is
+actually useful.  So the caller must arrange to call this function.
+
 The token's :secret key can hold a function.  In that case you
 must call it to obtain the actual value."
   (let* ((backends (mapcar 'auth-source-backend-parse auth-sources))
          (max (or max 1))
-         (ignored-keys '(:create :delete :max))
+         (ignored-keys '(:require :create :delete :max))
          (keys (loop for i below (length spec) by 2
                      unless (memq (nth i spec) ignored-keys)
                      collect (nth i spec)))
@@ -549,6 +560,10 @@ must call it to obtain the actual value."
        (or (eq t create) (listp create)) t
        "Invalid auth-source :create parameter (must be t or a list): %s %s")
 
+      (assert
+       (listp require) t
+       "Invalid auth-source :require parameter (must be a list): %s")
+
       (setq filtered-backends (copy-sequence backends))
       (dolist (backend backends)
         (dolist (key keys)
@@ -572,8 +587,9 @@ must call it to obtain the actual value."
                                                spec
                                                ;; to exit early
                                                max
-                                               ;; create and delete
-                                               nil delete))
+                                               ;; create is always nil here
+                                               nil delete
+                                               require))
 
       (auth-source-do-debug
        "auth-source-search: found %d results (max %d) matching %S"
@@ -587,9 +603,9 @@ must call it to obtain the actual value."
                                                  spec
                                                  ;; to exit early
                                                  max
-                                                 ;; create and delete
-                                                 create delete))
-        (auth-source-do-warn
+                                                 create delete
+                                                 require))
+        (auth-source-do-debug
          "auth-source-search: CREATED %d results (max %d) matching %S"
          (length found) max spec))
 
@@ -599,15 +615,16 @@ must call it to obtain the actual value."
 
       found))
 
-(defun auth-source-search-backends (backends spec max create delete)
+(defun auth-source-search-backends (backends spec max create delete require)
   (let (matches)
     (dolist (backend backends)
       (when (> max (length matches))   ; when we need more matches...
-        (let ((bmatches (apply
+        (let* ((bmatches (apply
                          (slot-value backend 'search-function)
                          :backend backend
                          ;; note we're overriding whatever the spec
-                         ;; has for :create and :delete
+                          ;; has for :require, :create, and :delete
+                          :require require
                          :create create
                          :delete delete
                          spec)))
@@ -739,7 +756,7 @@ while \(:host t) would find all host entries."
 ;;; (auth-source-netrc-parse "~/.authinfo.gpg")
 (defun* auth-source-netrc-parse (&rest
                                  spec
-                                 &key file max host user port delete
+                                 &key file max host user port delete require
                                  &allow-other-keys)
   "Parse FILE and return a list of all entries in the file.
 Note that the MAX parameter is used so we can exit the parse early."
@@ -838,7 +855,15 @@ Note that the MAX parameter is used so we can exit the parse early."
                         (or
                          (aget alist "port")
                          (aget alist "protocol")
-                         t)))
+                         t))
+                       (or
+                        ;; the required list of keys is nil, or
+                        (null require)
+                        ;; every element of require is in the normalized list
+                        (let ((normalized (nth 0 (auth-source-netrc-normalize
+                                                 (list alist)))))
+                          (loop for req in require
+                                always (plist-get normalized req)))))
               (decf max)
               (push (nreverse alist) result)
               ;; to delete a line, we just comment it out
@@ -863,7 +888,7 @@ Note that the MAX parameter is used so we can exit the parse early."
                   (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
 
             ;; ask AFTER we've successfully opened the file
-            (when (y-or-n-p (format "Save file %s? (%d modifications)"
+            (when (y-or-n-p (format "Save file %s? (%d deletions)"
                                     file modified))
               (write-region (point-min) (point-max) file nil 'silent)
               (auth-source-do-debug
@@ -903,7 +928,7 @@ Note that the MAX parameter is used so we can exit the parse early."
 
 (defun* auth-source-netrc-search (&rest
                                   spec
-                                  &key backend create delete
+                                  &key backend require create delete
                                   type max host user port
                                   &allow-other-keys)
 "Given a property list SPEC, return search matches from the :backend.
@@ -915,6 +940,7 @@ See `auth-source-search' for details on SPEC."
   (let ((results (auth-source-netrc-normalize
                   (auth-source-netrc-parse
                    :max max
+                   :require require
                    :delete delete
                    :file (oref backend source)
                    :host (or host t)
@@ -1002,12 +1028,12 @@ See `auth-source-search' for details on SPEC."
              (data (auth-source-netrc-element-or-first data))
              ;; this is the default to be offered
              (given-default (aget auth-source-creation-defaults r))
-             ;; the default supplementals are simple: for the user,
-             ;; try (user-login-name), otherwise take given-default
+             ;; the default supplementals are simple:
+             ;; for the user, try `given-default' and then (user-login-name);
+             ;; otherwise take `given-default'
              (default (cond
-                       ;; don't default the user name
-                       ;; ((and (not given-default) (eq r 'user))
-                       ;;  (user-login-name))
+                       ((and (not given-default) (eq r 'user))
+                        (user-login-name))
                        (t given-default)))
              (printable-defaults (list
                                   (cons 'user
@@ -1081,6 +1107,19 @@ See `auth-source-search' for details on SPEC."
                                    data))))
             (setq add (concat add (funcall printer)))))))
 
+    (plist-put
+     artificial
+     :save-function
+     (lexical-let ((file file)
+                   (add add))
+       (lambda () (auth-source-netrc-saver file add))))
+
+    (list artificial)))
+
+;;(funcall (plist-get (nth 0 (auth-source-search :host '("nonesuch") :user "tzz" :port "imap" :create t :max 1)) :save-function))
+(defun auth-source-netrc-saver (file add)
+  "Save a line ADD in FILE, prompting along the way.
+Respects `auth-source-save-behavior'."
     (with-temp-buffer
       (when (file-exists-p file)
         (insert-file-contents file))
@@ -1093,7 +1132,8 @@ See `auth-source-search' for details on SPEC."
           (make-local-variable 'epa-file-encrypt-to))
         (if (listp auth-source-gpg-encrypt-to)
             (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
-      (goto-char (point-max))
+    ;; we want the new data to be found first, so insert at beginning
+    (goto-char (point-min))
 
       ;; ask AFTER we've successfully opened the file
       (let ((prompt (format "Save auth info to file %s? %s: "
@@ -1138,13 +1178,11 @@ See `auth-source-search' for details on SPEC."
               (insert "\n"))
             (insert add "\n")
             (write-region (point-min) (point-max) file nil 'silent)
-            (auth-source-do-warn
+          (auth-source-do-debug
              "auth-source-netrc-create: wrote 1 new line to %s"
              file)
-            nil))
-
-        (when (eq done t)
-          (list artificial))))))
+          (message "Saved new authentication information to %s" file)
+          nil)))))
 
 ;;; Backend specific parsing: Secrets API backend
 
diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index 638097a..998f504 100644
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -282,13 +282,15 @@ textual parts.")
   (let ((found (nth 0 (auth-source-search :max 1
 					  :host address
 					  :port ports
+					  :require '(:user :secret)
 					  :create t))))
     (if found
         (list (plist-get found :user)
 	      (let ((secret (plist-get found :secret)))
 		(if (functionp secret)
 		    (funcall secret)
-		  secret)))
+		  secret))
+	      (plist-get found :save-function))
       nil)))
 
 (defun nnimap-keepalive ()
@@ -396,7 +398,12 @@ textual parts.")
 		(let ((nnimap-inhibit-logging t))
 		  (setq login-result
 			(nnimap-login (car credentials) (cadr credentials))))
-		(unless (car login-result)
+		(if (car login-result)
+                    ;; save the credentials if a save function exists
+                    ;; (such a function will only be passed if a new
+                    ;; token was created)
+                    (when (functionp (nth 2 credentials))
+                      (funcall (nth 2 credentials)))
 		  ;; If the login failed, then forget the credentials
 		  ;; that are now possibly cached.
 		  (dolist (host (list (nnoo-current-server 'nnimap)

-----------------------------------------------------------------------
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      |   20 +++++
 lisp/auth-source.el |  212 ++++++++++++++++++++++++++++++---------------------
 lisp/nnimap.el      |   11 ++-
 3 files changed, 154 insertions(+), 89 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, master 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.