emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] /srv/bzr/emacs/trunk r103601: Merge changes made in Gnus t


From: Katsumi Yamaoka
Subject: [Emacs-diffs] /srv/bzr/emacs/trunk r103601: Merge changes made in Gnus trunk.
Date: Wed, 09 Mar 2011 13:39:35 +0000
User-agent: Bazaar (2.0.3)

------------------------------------------------------------
revno: 103601
author: Teodor Zlatanov <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Wed 2011-03-09 13:39:35 +0000
message:
  Merge changes made in Gnus trunk.
  
  auth-source.el (auth-source-read-char-choice): New function to read a 
character choice using `dropdown-list', `read-char-choice', or `read-char'.  It 
appends "[a/b/c] " to the prompt if the choices were '(?a ?b ?c).  The 
`dropdown-list' support is disabled for now.  Use `eval-when-compile' to load 
`dropdown-list'.
   (auth-source-netrc-saver): Use it.
  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.
   (nnimap-credentials): Add IMAP-specific user and password prompt.
  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.  Set up clearer default prompts for 
user, host, port, and secret.
   (auth-source-netrc-saver): New function, intended to be wrapped for 
:save-function.
modified:
  doc/misc/ChangeLog
  doc/misc/auth.texi
  lisp/gnus/ChangeLog
  lisp/gnus/auth-source.el
  lisp/gnus/nnimap.el
=== modified file 'doc/misc/ChangeLog'
--- a/doc/misc/ChangeLog        2011-03-08 14:26:05 +0000
+++ b/doc/misc/ChangeLog        2011-03-09 13:39:35 +0000
@@ -1,3 +1,8 @@
+2011-03-08  Teodor Zlatanov  <address@hidden>
+
+       * auth.texi (Help for developers): Show example of using
+       `auth-source-search' with prompts and :save-function.
+
 2011-03-07  Antoine Levitt  <address@hidden>
 
        * message.texi (Message Buffers): Update default value of

=== modified file 'doc/misc/auth.texi'
--- a/doc/misc/auth.texi        2011-02-23 13:35:35 +0000
+++ b/doc/misc/auth.texi        2011-03-09 13:39:35 +0000
@@ -131,11 +131,11 @@
 later.
 
 If you have problems with the search, set @code{auth-source-debug} to
address@hidden and see what host, port, and user the library is checking in
-the @code{*Messages*} buffer.  Ditto for any other problems, your
-first step is always to see what's being checked.  The second step, of
-course, is to write a blog entry about it and wait for the answer in
-the comments.
address@hidden'trivia} and see what host, port, and user the library is
+checking in the @code{*Messages*} buffer.  Ditto for any other
+problems, your first step is always to see what's being checked.  The
+second step, of course, is to write a blog entry about it and wait for
+the answer in the comments.
 
 You can customize the variable @code{auth-sources}.  The following may
 be needed if you are using an older version of Emacs or if the
@@ -232,6 +232,14 @@
 @node Help for developers
 @chapter Help for developers
 
+The auth-source library lets you control logging output easily.
+
address@hidden auth-source-debug
+Set this variable to 'trivia to see lots of output in *Messages*, or
+set it to a function that behaves like @code{message} to do your own
+logging.
address@hidden defvar
+
 The auth-source library only has a few functions for external use.
 
 @defun auth-source-search SPEC
@@ -240,6 +248,52 @@
 
 @end defun
 
+Let's take a look at an example of using @code{auth-source-search}
+from Gnus' @code{nnimap.el}.
+
address@hidden
+(defun nnimap-credentials (address ports)
+  (let* ((auth-source-creation-prompts
+          '((user  . "IMAP user at %h: ")
+            (secret . "IMAP password for %u@@%h: ")))
+         (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))
+             (plist-get found :save-function))
+      nil)))
address@hidden example
+
+This call requires the user and password (secret) to be in the
+results.  It also requests that an entry be created if it doesn't
+exist already.  While the created entry is being assembled, the shown
+prompts will be used to interact with the user.  The caller can also
+pass data in @code{auth-source-creation-defaults} to supply defaults
+for any of the prompts.
+
+Note that the password needs to be evaluated if it's a function.  It's
+wrapped in a function to provide some security.
+
+Later, after a successful login, @code{nnimal.el} calls the
address@hidden:save-function} like so:
+
address@hidden
+(when (functionp (nth 2 credentials))
+   (funcall (nth 2 credentials)))
address@hidden example  
+
+Which will work whether the @code{:save-function} was provided or not.
address@hidden:save-function} will be provided only when a new entry was
+created, so this effectively says ``after a successful login, save the
+authentication information we just used, if it was newly created.''
+
 @defun auth-source-delete SPEC
 
 TODO: how to include docstring?

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2011-03-08 14:26:05 +0000
+++ b/lisp/gnus/ChangeLog       2011-03-09 13:39:35 +0000
@@ -1,3 +1,34 @@
+2011-03-09  Teodor Zlatanov  <address@hidden>
+
+       * auth-source.el (auth-source-read-char-choice): New function to read a
+       character choice using `dropdown-list', `read-char-choice', or
+       `read-char'.  It appends "[a/b/c] " to the prompt if the choices were
+       '(?a ?b ?c).  The `dropdown-list' support is disabled for now.  Use
+       `eval-when-compile' to load `dropdown-list'.
+       (auth-source-netrc-saver): Use it.
+
+2011-03-08  Teodor Zlatanov  <address@hidden>
+
+       * 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.
+       (nnimap-credentials): Add IMAP-specific user and password prompt.
+
+       * 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.  Set up clearer
+       default prompts for user, host, port, and secret.
+       (auth-source-netrc-saver): New function, intended to be wrapped for
+       :save-function.
+
 2011-03-07  Lars Magne Ingebrigtsen  <address@hidden>
 
        * shr.el (shr-table-horizontal-line): Change the defaults for the table

=== modified file 'lisp/gnus/auth-source.el'
--- a/lisp/gnus/auth-source.el  2011-02-25 23:52:19 +0000
+++ b/lisp/gnus/auth-source.el  2011-03-09 13:39:35 +0000
@@ -44,7 +44,18 @@
 (require 'gnus-util)
 (require 'assoc)
 (eval-when-compile (require 'cl))
-(require 'eieio)
+(eval-when-compile (require 'dropdown-list nil t))
+(eval-and-compile
+  (or (ignore-errors (require 'eieio))
+      ;; gnus-fallback-lib/ from gnus/lisp/gnus-fallback-lib
+      (ignore-errors
+       (let ((load-path (cons (expand-file-name
+                               "gnus-fallback-lib/eieio"
+                               (file-name-directory (locate-library "gnus")))
+                              load-path)))
+         (require 'eieio)))
+      (error
+       "eieio not found in `load-path' or gnus-fallback-lib/ directory.")))
 
 (autoload 'secrets-create-item "secrets")
 (autoload 'secrets-delete-item "secrets")
@@ -286,6 +297,34 @@
    msg))
 
 
+;;; (auth-source-read-char-choice "enter choice? " '(?a ?b ?q))
+(defun auth-source-read-char-choice (prompt choices)
+  "Read one of CHOICES by `read-char-choice', or `read-char'.
+`dropdown-list' support is disabled because it doesn't work reliably.
+Only one of CHOICES will be returned.  The PROMPT is augmented
+with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
+  (when choices
+    (let* ((prompt-choices
+            (apply 'concat (loop for c in choices
+                                 collect (format "%c/" c))))
+           (prompt-choices (concat "[" (substring prompt-choices 0 -1) "] "))
+           (full-prompt (concat prompt prompt-choices))
+           k)
+
+      (while (not (memq k choices))
+        (setq k (cond
+                 ((and nil (featurep 'dropdown-list))
+                  (let* ((blank (fill (copy-sequence prompt) ?.))
+                         (dlc (cons (format "%s %c" prompt (car choices))
+                                    (loop for c in (cdr choices)
+                                          collect (format "%s %c" blank c)))))
+                    (nth (dropdown-list dlc) choices)))
+                 ((fboundp 'read-char-choice)
+                  (read-char-choice full-prompt choices))
+                 (t (message "%s" full-prompt)
+                    (setq k (read-char))))))
+      k)))
+
 ;; (auth-source-pick nil :host "any" :port 'imap :user "joe")
 ;; (auth-source-pick t :host "any" :port 'imap :user "joe")
 ;; (setq auth-sources '((:source (:secrets default) :host t :port t :user 
"joe")
@@ -393,7 +432,7 @@
 
 (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.
 
@@ -487,6 +526,11 @@
 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.
@@ -516,11 +560,17 @@
 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)))
@@ -539,6 +589,10 @@
        (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)
@@ -562,8 +616,9 @@
                                                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"
@@ -577,9 +632,9 @@
                                                  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))
 
@@ -589,18 +644,19 @@
 
       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
-                         (slot-value backend 'search-function)
-                         :backend backend
-                         ;; note we're overriding whatever the spec
-                         ;; has for :create and :delete
-                         :create create
-                         :delete delete
-                         spec)))
+        (let* ((bmatches (apply
+                          (slot-value backend 'search-function)
+                          :backend backend
+                          ;; note we're overriding whatever the spec
+                          ;; has for :require, :create, and :delete
+                          :require require
+                          :create create
+                          :delete delete
+                          spec)))
           (when bmatches
             (auth-source-do-trivia
              "auth-source-search-backend: got %d (max %d) in %s:%s matching %S"
@@ -729,7 +785,7 @@
 ;;; (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."
@@ -828,7 +884,15 @@
                         (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
@@ -853,7 +917,7 @@
                   (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
@@ -893,7 +957,7 @@
 
 (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.
@@ -905,6 +969,7 @@
   (let ((results (auth-source-netrc-normalize
                   (auth-source-netrc-parse
                    :max max
+                   :require require
                    :delete delete
                    :file (oref backend source)
                    :host (or host t)
@@ -992,12 +1057,12 @@
              (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
@@ -1020,10 +1085,10 @@
                                          "[any port]"))))
              (prompt (or (aget auth-source-creation-prompts r)
                          (case r
-                           ('secret "%p password for user %u, host %h: ")
-                           ('user "%p user name: ")
-                           ('host "%p host name for user %u: ")
-                           ('port "%p port for user %u and host %h: "))
+                           (secret "%p password for address@hidden: ")
+                           (user "%p user name for %h: ")
+                           (host "%p host name for user %u: ")
+                           (port "%p port for address@hidden: "))
                          (format "Enter %s (address@hidden:%%p): " r)))
              (prompt (auth-source-format-prompt
                       prompt
@@ -1071,70 +1136,79 @@
                                    data))))
             (setq add (concat add (funcall printer)))))))
 
-    (with-temp-buffer
-      (when (file-exists-p file)
-        (insert-file-contents file))
-      (when auth-source-gpg-encrypt-to
-        ;; (see bug#7487) making `epa-file-encrypt-to' local to
-        ;; this buffer lets epa-file skip the key selection query
-        ;; (see the `local-variable-p' check in
-        ;; `epa-file-write-region').
-        (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
-          (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))
-
-      ;; ask AFTER we've successfully opened the file
-      (let ((prompt (format "Save auth info to file %s? %s: "
-                            file
-                            "y/n/N/e/?"))
-            (done (not (eq auth-source-save-behavior 'ask)))
-            (bufname "*auth-source Help*")
-            k)
-        (while (not done)
-          (message "%s" prompt)
-          (setq k (read-char))
-          (case k
-            (?y (setq done t))
-            (?? (save-excursion
-                  (with-output-to-temp-buffer bufname
-                    (princ
-                     (concat "(y)es, save\n"
-                             "(n)o but use the info\n"
-                             "(N)o and don't ask to save again\n"
-                             "(e)dit the line\n"
-                             "(?) for help as you can see.\n"))
+    (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))
+    (when auth-source-gpg-encrypt-to
+      ;; (see bug#7487) making `epa-file-encrypt-to' local to
+      ;; this buffer lets epa-file skip the key selection query
+      ;; (see the `local-variable-p' check in
+      ;; `epa-file-write-region').
+      (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
+        (make-local-variable 'epa-file-encrypt-to))
+      (if (listp auth-source-gpg-encrypt-to)
+          (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
+    ;; 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? " file))
+          (done (not (eq auth-source-save-behavior 'ask)))
+          (bufname "*auth-source Help*")
+          k)
+      (while (not done)
+        (setq k (auth-source-read-char-choice prompt '(?y ?n ?N ?e ??)))
+        (case k
+          (?y (setq done t))
+          (?? (save-excursion
+                (with-output-to-temp-buffer bufname
+                  (princ
+                   (concat "(y)es, save\n"
+                           "(n)o but use the info\n"
+                           "(N)o and don't ask to save again\n"
+                           "(e)dit the line\n"
+                           "(?) for help as you can see.\n"))
                   (set-buffer standard-output)
                   (help-mode))))
-            (?n (setq add ""
-                      done t))
-            (?N (setq add ""
-                      done t
-                      auth-source-save-behavior nil))
-            (?e (setq add (read-string "Line to add: " add)))
-            (t nil)))
-
-        (when (get-buffer-window bufname)
-          (delete-window (get-buffer-window bufname)))
-
-        ;; make sure the info is not saved
-        (when (null auth-source-save-behavior)
-          (setq add ""))
-
-        (when (< 0 (length add))
-          (progn
-            (unless (bolp)
-              (insert "\n"))
-            (insert add "\n")
-            (write-region (point-min) (point-max) file nil 'silent)
-            (auth-source-do-warn
-             "auth-source-netrc-create: wrote 1 new line to %s"
-             file)
-            nil))
-
-        (when (eq done t)
-          (list artificial))))))
+          (?n (setq add ""
+                    done t))
+          (?N (setq add ""
+                    done t
+                    auth-source-save-behavior nil))
+          (?e (setq add (read-string "Line to add: " add)))
+          (t nil)))
+
+      (when (get-buffer-window bufname)
+        (delete-window (get-buffer-window bufname)))
+
+      ;; make sure the info is not saved
+      (when (null auth-source-save-behavior)
+        (setq add ""))
+
+      (when (< 0 (length add))
+        (progn
+          (unless (bolp)
+            (insert "\n"))
+          (insert add "\n")
+          (write-region (point-min) (point-max) file nil 'silent)
+          (auth-source-do-debug
+           "auth-source-netrc-create: wrote 1 new line to %s"
+           file)
+          (message "Saved new authentication information to %s" file)
+          nil)))))
 
 ;;; Backend specific parsing: Secrets API backend
 

=== modified file 'lisp/gnus/nnimap.el'
--- a/lisp/gnus/nnimap.el       2011-03-08 14:26:05 +0000
+++ b/lisp/gnus/nnimap.el       2011-03-09 13:39:35 +0000
@@ -279,16 +279,21 @@
     (current-buffer)))
 
 (defun nnimap-credentials (address ports)
-  (let ((found (nth 0 (auth-source-search :max 1
-                                         :host address
-                                         :port ports
-                                         :create t))))
+  (let* ((auth-source-creation-prompts
+          '((user  . "IMAP user at %h: ")
+            (secret . "IMAP password for address@hidden: ")))
+         (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 +401,12 @@
                (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)


reply via email to

[Prev in Thread] Current Thread [Next in Thread]