Commit 733afdf4 authored by Ted Zlatanov's avatar Ted Zlatanov Committed by Katsumi Yamaoka

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.
parent ee545c35
2011-03-08 Teodor Zlatanov <tzz@lifelogs.com>
* auth.texi (Help for developers): Show example of using
`auth-source-search' with prompts and :save-function.
2011-03-07 Antoine Levitt <antoine.levitt@gmail.com>
* message.texi (Message Buffers): Update default value of
......
......@@ -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?
......
2011-03-09 Teodor Zlatanov <tzz@lifelogs.com>
* 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 <tzz@lifelogs.com>
* 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 <larsi@gnus.org>
* shr.el (shr-table-horizontal-line): Change the defaults for the table
......
......@@ -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
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment