From 733afdf4d9df952a2d06c40b067de3a62bceb26b Mon Sep 17 00:00:00 2001 From: Teodor Zlatanov Date: Wed, 9 Mar 2011 13:39:35 +0000 Subject: [PATCH] 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. --- doc/misc/ChangeLog | 5 + doc/misc/auth.texi | 64 +++++++++- lisp/gnus/ChangeLog | 31 +++++ lisp/gnus/auth-source.el | 258 +++++++++++++++++++++++++-------------- lisp/gnus/nnimap.el | 22 +++- 5 files changed, 277 insertions(+), 103 deletions(-) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 75674c7fd17..96a2576355a 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,8 @@ +2011-03-08 Teodor Zlatanov + + * auth.texi (Help for developers): Show example of using + `auth-source-search' with prompts and :save-function. + 2011-03-07 Antoine Levitt * message.texi (Message Buffers): Update default value of diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 23ac23dce5b..e16d7b49b63 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -131,11 +131,11 @@ library encourages this confusion by accepting both, as you'll see later. If you have problems with the search, set @code{auth-source-debug} to -@code{t} 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. +@code{'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 @@ TODO: how does it work generally, how does secrets.el work, some examples. @node Help for developers @chapter Help for developers +The auth-source library lets you control logging output easily. + +@defvar 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. +@end defvar + The auth-source library only has a few functions for external use. @defun auth-source-search SPEC @@ -240,6 +248,52 @@ TODO: how to include docstring? @end defun +Let's take a look at an example of using @code{auth-source-search} +from Gnus' @code{nnimap.el}. + +@example +(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))) +@end 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 +@code{:save-function} like so: + +@example +(when (functionp (nth 2 credentials)) + (funcall (nth 2 credentials))) +@end example + +Which will work whether the @code{:save-function} was provided or not. +@code{: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? diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index b30cfdcfcd3..aa1f013dd35 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,34 @@ +2011-03-09 Teodor Zlatanov + + * 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 + + * 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 * shr.el (shr-table-horizontal-line): Change the defaults for the table diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index 500de10b71c..108871974a0 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -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 @@ If the value is not a list, symmetric encryption will be used." 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 @@ 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. @@ -487,6 +526,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. @@ -516,11 +560,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))) @@ -539,6 +589,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) @@ -562,8 +616,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" @@ -577,9 +632,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)) @@ -589,18 +644,19 @@ 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 - (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 @@ 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." @@ -828,7 +884,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 @@ -853,7 +917,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 @@ -893,7 +957,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. @@ -905,6 +969,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) @@ -992,12 +1057,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 @@ -1020,10 +1085,10 @@ See `auth-source-search' for details on SPEC." "[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 %u@%h: ") + (user "%p user name for %h: ") + (host "%p host name for user %u: ") + (port "%p port for %u@%h: ")) (format "Enter %s (%%u@%%h:%%p): " r))) (prompt (auth-source-format-prompt prompt @@ -1071,70 +1136,79 @@ See `auth-source-search' for details on SPEC." 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 diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 638097abd7d..e76ead515c5 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -279,16 +279,21 @@ textual parts.") (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 %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))) + secret)) + (plist-get found :save-function)) nil))) (defun nnimap-keepalive () @@ -396,7 +401,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) -- 2.39.5