aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGnus developers2011-02-13 00:25:29 +0000
committerKatsumi Yamaoka2011-02-13 00:25:29 +0000
commitb8e0f0cd20799c025cf4d353c6b1ee74b3c44aad (patch)
tree6c2440a24a4e1d4c7bee75c076b3de3baee560f5
parente730aabed55f3b65020672f1d58afc55fda4eef2 (diff)
downloademacs-b8e0f0cd20799c025cf4d353c6b1ee74b3c44aad.tar.gz
emacs-b8e0f0cd20799c025cf4d353c6b1ee74b3c44aad.zip
Merge changes made in Gnus trunk.
auth.texi (Overview, Help for users, Help for developers): Update docs. (Help for users): Talk about spaces. sieve-manage.el: Autoload `auth-source-search'. (sieve-sasl-auth): Use it. nnimap.el: Autoload `auth-source-forget+'. (nnimap-open-connection-1): Use it if the connection fails. auth-source.el: Require `password-cache'. (auth-source-hide-passwords, auth-source-cache): Remove and mark obsolete. (auth-source-magic): Marker for `password-cache' keys. (auth-source-do-cache): Update docstring. (auth-source-search): Use and check cache. (auth-source-forget-all-cached, auth-source-remember) (auth-source-recall, auth-source-forget, auth-source-forget+) (auth-source-specmatchp): Caching support functions. (auth-source-forget-user-or-password, auth-source-forget-all-cached): Remove and obsolete. (auth-source-user-or-password): Remove caching to further discourage using it. Always hide passwords. password-cache.el (password-cache-remove): Accept secrets that are not strings. mail-source.el: Autoload `auth-source-search'. (mail-source-keyword-map): Note order matters. (mail-source-set-1): Get all the mail-source source values and defaults and search auth-source on those if needed. This can all probably be simplified. nnimap.el: Autoload `auth-source-search'. (nnimap-credentials): Use it. (nnimap-open-connection-1): Ask for the virtual server and physical address in one shot. nntp.el: Autoload `auth-source-search'. (nntp-send-authinfo): Use it. Note TODO. auth-source.el (auth-source-secrets-search, auth-source-user-or-password): Use `append' instead of `nconc'. (auth-source-user-or-password): Build return list better and protect against nil :secret. auth-source.el (top): Require 'eieio unconditionally. Autoload `secrets-get-attributes' instead of `secrets-get-attribute'. (auth-source-secrets-search): Limit search when `max' is greater than number of results. auth-source.el (auth-source-secrets-search): Add examples. auth-source.el (auth-sources): Allow for simpler defaults for Secrets API with a string "secrets:collection-name" and with 'default. (auth-source-backend-parse): Parse "secrets:collection-name" and 'default. Recurse on parses instead of repeating code. Use the Secrets API is the source is not nil and 'ignore otherwise. Emit a message when ignoring a source. (auth-source-search): List ignored search keys at the top level. (auth-source-netrc-create): Use `case' instead of `cond'. (auth-source-secrets-search): Created with TODOs. (auth-source-secrets-create): Created with TODOs. (auth-source-retrieve, auth-source-create, auth-source-delete) (auth-source-protocol-defaults, auth-source-user-or-password-imap) (auth-source-user-or-password-pop3, auth-source-user-or-password-ssh) (auth-source-user-or-password-sftp) (auth-source-user-or-password-smtp): Removed. (auth-source-user-or-password): Deprecated and modified to be a wrapper around `auth-source-search'. Not tested thoroughly. auth-source.el: Bring in assoc and eioeio libraries. (secrets-enabled): New variable to track the status of the Secrets API. (auth-source-backend): New EIOEIO class to represent a backend. (auth-source-creation-defaults): New variable to set prompt defaults during token creation (see the `auth-source-search' docstring for details). (auth-sources): Simplify to allow a simple string as a netrc backend spec. (auth-source-backend-parse): Parse a backend from an `auth-sources' spec. (auth-source-backend-parse-parameters): Fill in the backend parameters. (auth-source-search): Main auth-source API entry point. (auth-source-delete): Wrapper around `auth-source-search' for deletion. (auth-source-search-collection): Helper function for searching. (auth-source-netrc-parse, auth-source-netrc-normalize) (auth-source-netrc-search, auth-source-netrc-create): Netrc backend. Supports search, create, and delete. (auth-source-secrets-search, auth-source-secrets-create): Secrets API backend stubs. (auth-source-user-or-password): Call `auth-source-search' but it's not ready yet.
-rw-r--r--doc/misc/ChangeLog5
-rw-r--r--doc/misc/auth.texi147
-rw-r--r--lisp/ChangeLog5
-rw-r--r--lisp/gnus/ChangeLog101
-rw-r--r--lisp/gnus/auth-source.el1232
-rw-r--r--lisp/gnus/mail-source.el88
-rw-r--r--lisp/gnus/nnimap.el47
-rw-r--r--lisp/gnus/nntp.el16
-rw-r--r--lisp/gnus/sieve-manage.el18
-rw-r--r--lisp/password-cache.el7
10 files changed, 1197 insertions, 469 deletions
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 71de76e4d91..0832e02fb2b 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -6,6 +6,11 @@
6 6
7 * url.texi: Remove duplicate @dircategory (Bug#7942). 7 * url.texi: Remove duplicate @dircategory (Bug#7942).
8 8
92011-02-11 Teodor Zlatanov <tzz@lifelogs.com>
10
11 * auth.texi (Overview, Help for users, Help for developers): Update docs.
12 (Help for users): Talk about spaces.
13
92011-02-09 Paul Eggert <eggert@cs.ucla.edu> 142011-02-09 Paul Eggert <eggert@cs.ucla.edu>
10 15
11 * texinfo.tex: Update to version 2011-02-07.16. 16 * texinfo.tex: Update to version 2011-02-07.16.
diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi
index bad37dbe85a..2541dba9873 100644
--- a/doc/misc/auth.texi
+++ b/doc/misc/auth.texi
@@ -5,7 +5,7 @@
5@setfilename ../../info/auth 5@setfilename ../../info/auth
6@settitle Emacs auth-source Library @value{VERSION} 6@settitle Emacs auth-source Library @value{VERSION}
7 7
8@set VERSION 0.2 8@set VERSION 0.3
9 9
10@copying 10@copying
11This file describes the Emacs auth-source library. 11This file describes the Emacs auth-source library.
@@ -78,15 +78,19 @@ It is a way for multiple applications to share a single configuration
78@chapter Overview 78@chapter Overview
79 79
80The auth-source library is simply a way for Emacs and Gnus, among 80The auth-source library is simply a way for Emacs and Gnus, among
81others, to answer the old burning question ``I have a server name and 81others, to answer the old burning question ``What are my user name and
82a port, what are my user name and password?'' 82password?''
83 83
84The auth-source library actually supports more than just the user name 84(This is different from the old question about burning ``Where is the
85(known as the login) or the password, but only those two are in use 85fire extinguisher, please?''.)
86today in Emacs or Gnus. Similarly, the auth-source library supports 86
87multiple storage formats, currently either the classic ``netrc'' 87The auth-source library supports more than just the user name or the
88format, examples of which you can see later in this document, or the 88password (known as the secret).
89Secret Service API. 89
90Similarly, the auth-source library supports multiple storage backend,
91currently either the classic ``netrc'' backend, examples of which you
92can see later in this document, or the Secret Service API. This is
93done with EIEIO-based backends and you can write your own if you want.
90 94
91@node Help for users 95@node Help for users
92@chapter Help for users 96@chapter Help for users
@@ -96,25 +100,41 @@ Secret Service API.
96machine @var{mymachine} login @var{myloginname} password @var{mypassword} port @var{myport} 100machine @var{mymachine} login @var{myloginname} password @var{mypassword} port @var{myport}
97@end example 101@end example
98 102
99The machine is the server (either a DNS name or an IP address). 103The @code{machine} is the server (either a DNS name or an IP address).
104It's known as @var{:host} in @code{auth-source-search} queries. You
105can also use @code{host}.
106
107The @code{port} is the connection port or protocol. It's known as
108@var{:port} in @code{auth-source-search} queries. You can also use
109@code{protocol}.
110
111The @code{user} is the user name. It's known as @var{:user} in
112@code{auth-source-search} queries. You can also use @code{login} and
113@code{account}.
114
115Spaces are always OK as far as auth-source is concerned (but other
116programs may not like them). Just put the data in quotes, escaping
117quotes as you'd expect with @code{\}.
118
119All these are optional. You could just say (but we don't recommend
120it, we're just showing that it's possible)
100 121
101The port is optional. If it's missing, auth-source will assume any 122@example
102port is OK. Actually the port is a protocol name or a port number so 123password @var{mypassword}
103you can have separate entries for port @var{143} and for protocol 124@end example
104@var{imap} if you fancy that. Anyway, you can just omit the port if
105you don't need it.
106 125
107The login and password are simply your login credentials to the server. 126to use the same password everywhere. Again, @emph{DO NOT DO THIS} or
127you will be pwned as the kids say.
108 128
109``Netrc'' files are usually called @code{.authinfo} or @code{.netrc}; 129``Netrc'' files are usually called @code{.authinfo} or @code{.netrc};
110nowadays @code{.authinfo} seems to be more popular and the auth-source 130nowadays @code{.authinfo} seems to be more popular and the auth-source
111library encourages this confusion by making it the default, as you'll 131library encourages this confusion by making it the default, as you'll
112see later. 132see later.
113 133
114If you have problems with the port, set @code{auth-source-debug} to 134If you have problems with the search, set @code{auth-source-debug} to
115@code{t} and see what port the library is checking in the 135@code{t} and see what host, port, and user the library is checking in
116@code{*Messages*} buffer. Ditto for any other problems, your first 136the @code{*Messages*} buffer. Ditto for any other problems, your
117step is always to see what's being checked. The second step, of 137first step is always to see what's being checked. The second step, of
118course, is to write a blog entry about it and wait for the answer in 138course, is to write a blog entry about it and wait for the answer in
119the comments. 139the comments.
120 140
@@ -139,56 +159,36 @@ and simplest configuration is:
139(setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t))) 159(setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t)))
140;;; mostly equivalent (see below about fallbacks) but shorter: 160;;; mostly equivalent (see below about fallbacks) but shorter:
141(setq auth-sources '((:source "~/.authinfo.gpg"))) 161(setq auth-sources '((:source "~/.authinfo.gpg")))
162;;; even shorter and the @emph{default}:
163(setq auth-sources '("~/.authinfo.gpg" "~/.authinfo"))
164;;; use the Secrets API @var{login} collection (@pxref{Secret Service API})
165(setq auth-sources '("secrets:login"))
142@end lisp 166@end lisp
143 167
144This says ``for any host and any protocol, use just that one file.''
145Sweet simplicity. In fact, the latter is already the default, so
146unless you want to move your netrc file, it will just work if you have
147that file. Make sure it exists.
148
149By adding multiple entries to @code{auth-sources} with a particular 168By adding multiple entries to @code{auth-sources} with a particular
150host or protocol, you can have specific netrc files for that host or 169host or protocol, you can have specific netrc files for that host or
151protocol. Usually this is unnecessary but may make sense if you have 170protocol. Usually this is unnecessary but may make sense if you have
152shared netrc files or some other unusual setup (90% of Emacs users 171shared netrc files or some other unusual setup (90% of Emacs users
153have unusual setups and the remaining 10% are @emph{really} unusual). 172have unusual setups and the remaining 10% are @emph{really} unusual).
154 173
155Here's an example that uses the Secret Service API for all lookups, 174Here's a mixed example using two sources:
156using the default collection:
157
158@lisp
159(setq auth-sources '((:source (:secrets default))))
160@end lisp
161
162And here's a mixed example, using two sources:
163 175
164@lisp 176@lisp
165(setq auth-sources '((:source (:secrets default) :host "myserver" :user "joe") 177(setq auth-sources '((:source (:secrets default) :host "myserver" :user "joe")
166 (:source "~/.authinfo.gpg"))) 178 "~/.authinfo.gpg"))
167@end lisp 179@end lisp
168 180
169The best match is determined by order (starts from the bottom) only
170for the first pass, where things are checked exactly. In the example
171above, the first pass would find a single match for host
172@code{myserver}. The netrc choice would fail because it matches any
173host and protocol implicitly (as a @emph{fallback}). A specified
174value of @code{:host t} in @code{auth-sources} is considered a match
175on the first pass, unlike a missing @code{:host}.
176
177Now if you look for host @code{missing}, it won't match either source
178explicitly. The second pass (the @emph{fallback} pass) will look at
179all the implicit matches and collect them. They will be scored and
180returned sorted by score. The score is based on the number of
181explicit parameters that matched. See the @code{auth-pick} function
182for details.
183
184@end defvar 181@end defvar
185 182
186If you don't customize @code{auth-sources}, you'll have to live with 183If you don't customize @code{auth-sources}, you'll have to live with
187the defaults: any host and any port are looked up in the netrc 184the defaults: any host and any port are looked up in the netrc
188file @code{~/.authinfo.gpg}, which is a GnuPG encrypted file 185file @code{~/.authinfo.gpg}, which is a GnuPG encrypted file
189(@pxref{GnuPG and EasyPG Assistant Configuration}). 186(@pxref{GnuPG and EasyPG Assistant Configuration}).
187
188If that fails, the unencrypted netrc file @code{~/.authinfo} will
189be used.
190 190
191The simplest working netrc line example is one without a port. 191The typical netrc line example is without a port.
192 192
193@example 193@example
194machine YOURMACHINE login YOU password YOURPASSWORD 194machine YOURMACHINE login YOU password YOURPASSWORD
@@ -233,42 +233,29 @@ TODO: how does it work generally, how does secrets.el work, some examples.
233@node Help for developers 233@node Help for developers
234@chapter Help for developers 234@chapter Help for developers
235 235
236The auth-source library only has one function for external use. 236The auth-source library only has a few functions for external use.
237 237
238@defun auth-source-user-or-password mode host port &optional username 238@defun auth-source-search SPEC
239 239
240Retrieve appropriate authentication tokens, determined by @var{mode}, 240TODO: how to include docstring?
241for host @var{host} and @var{port}. If @var{username} is provided it
242will also be checked. If @code{auth-source-debug} is t, debugging
243messages will be printed. Set @code{auth-source-debug} to a function
244to use that function for logging. The parameters passed will be the
245same that the @code{message} function takes, that is, a string
246formatting spec and optional parameters.
247 241
248If @var{mode} is a list of strings, the function will return a list of 242@end defun
249strings or @code{nil} objects (thus you can avoid parsing the netrc
250file or checking the Secret Service API more than once). If it's a
251string, the function will return a string or a @code{nil} object.
252Currently only the modes ``login'' and ``password'' are recognized but
253more may be added in the future.
254 243
255@var{host} is a string containing the host name. 244@defun auth-source-delete SPEC
256 245
257@var{port} contains the protocol name (e.g. ``imap'') or 246TODO: how to include docstring?
258a port number. It must be a string, corresponding to the port in the
259users' netrc files.
260 247
261@var{username} contains the user name (e.g. ``joe'') as a string. 248@end defun
262 249
263@example 250@defun auth-source-forget SPEC
264;; IMAP example 251
265(setq auth (auth-source-user-or-password 252TODO: how to include docstring?
266 '("login" "password") 253
267 "anyhostnamehere" 254@end defun
268 "imap")) 255
269(nth 0 auth) ; the login name 256@defun auth-source-forget+ SPEC
270(nth 1 auth) ; the password 257
271@end example 258TODO: how to include docstring?
272 259
273@end defun 260@end defun
274 261
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index a3fa53b1b7a..440354e0fd2 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -191,6 +191,11 @@
191 (allout-after-copy-or-kill-hook): No arguments - hook implementers 191 (allout-after-copy-or-kill-hook): No arguments - hook implementers
192 should concentrate on the kill ring. 192 should concentrate on the kill ring.
193 193
1942011-02-09 Teodor Zlatanov <tzz@lifelogs.com>
195
196 * password-cache.el (password-cache-remove): Accept secrets that are
197 not strings.
198
1942011-02-09 Stefan Monnier <monnier@iro.umontreal.ca> 1992011-02-09 Stefan Monnier <monnier@iro.umontreal.ca>
195 200
196 * progmodes/sh-script.el (sh-font-lock-open-heredoc): Fix case 201 * progmodes/sh-script.el (sh-font-lock-open-heredoc): Fix case
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 8781ab3c0ec..e484c5701fe 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -7,6 +7,30 @@
7 7
8 * gnus-sum.el (gnus-summary-save-parts): Use read-directory-name. 8 * gnus-sum.el (gnus-summary-save-parts): Use read-directory-name.
9 9
102011-02-10 Teodor Zlatanov <tzz@lifelogs.com>
11
12 * sieve-manage.el: Autoload `auth-source-search'.
13 (sieve-sasl-auth): Use it.
14
152011-02-09 Teodor Zlatanov <tzz@lifelogs.com>
16
17 * nnimap.el: Autoload `auth-source-forget+'.
18 (nnimap-open-connection-1): Use it if the connection fails.
19
20 * auth-source.el: Require `password-cache'.
21 (auth-source-hide-passwords, auth-source-cache): Remove and mark
22 obsolete.
23 (auth-source-magic): Marker for `password-cache' keys.
24 (auth-source-do-cache): Update docstring.
25 (auth-source-search): Use and check cache.
26 (auth-source-forget-all-cached, auth-source-remember)
27 (auth-source-recall, auth-source-forget, auth-source-forget+)
28 (auth-source-specmatchp): Caching support functions.
29 (auth-source-forget-user-or-password, auth-source-forget-all-cached):
30 Remove and obsolete.
31 (auth-source-user-or-password): Remove caching to further discourage
32 using it. Always hide passwords.
33
102011-02-09 Lars Ingebrigtsen <larsi@gnus.org> 342011-02-09 Lars Ingebrigtsen <larsi@gnus.org>
11 35
12 * nntp.el (nntp-retrieve-group-data-early-disabled): Disable the async 36 * nntp.el (nntp-retrieve-group-data-early-disabled): Disable the async
@@ -17,6 +41,22 @@
17 * message.el (message-options): Make message-options really buffer 41 * message.el (message-options): Make message-options really buffer
18 local. 42 local.
19 43
442011-02-08 Teodor Zlatanov <tzz@lifelogs.com>
45
46 * mail-source.el: Autoload `auth-source-search'.
47 (mail-source-keyword-map): Note order matters.
48 (mail-source-set-1): Get all the mail-source source values and
49 defaults and search auth-source on those if needed. This can all
50 probably be simplified.
51
52 * nnimap.el: Autoload `auth-source-search'.
53 (nnimap-credentials): Use it.
54 (nnimap-open-connection-1): Ask for the virtual server and physical
55 address in one shot.
56
57 * nntp.el: Autoload `auth-source-search'.
58 (nntp-send-authinfo): Use it. Note TODO.
59
202011-02-08 Julien Danjou <julien@danjou.info> 602011-02-08 Julien Danjou <julien@danjou.info>
21 61
22 * shr.el (shr-tag-body): Add support for text attribute in body 62 * shr.el (shr-tag-body): Add support for text attribute in body
@@ -24,6 +64,13 @@
24 64
25 * message.el (message-options): Make message-options a local variable. 65 * message.el (message-options): Make message-options a local variable.
26 66
672011-02-07 Teodor Zlatanov <tzz@lifelogs.com>
68
69 * auth-source.el (auth-source-secrets-search)
70 (auth-source-user-or-password): Use `append' instead of `nconc'.
71 (auth-source-user-or-password): Build return list better and protect
72 against nil :secret.
73
272011-02-07 Lars Ingebrigtsen <larsi@gnus.org> 742011-02-07 Lars Ingebrigtsen <larsi@gnus.org>
28 75
29 * nnimap.el (nnimap-update-info): Refactor slightly. 76 * nnimap.el (nnimap-update-info): Refactor slightly.
@@ -35,6 +82,13 @@
35 (nnimap-update-info): Fix macrology bug-out. 82 (nnimap-update-info): Fix macrology bug-out.
36 (nnimap-update-info): Simplify split history test. 83 (nnimap-update-info): Simplify split history test.
37 84
852011-02-06 Michael Albinus <michael.albinus@gmx.de>
86
87 * auth-source.el (top): Require 'eieio unconditionally. Autoload
88 `secrets-get-attributes' instead of `secrets-get-attribute'.
89 (auth-source-secrets-search): Limit search when `max' is greater than
90 number of results.
91
382011-02-06 Lars Ingebrigtsen <larsi@gnus.org> 922011-02-06 Lars Ingebrigtsen <larsi@gnus.org>
39 93
40 * nntp.el (nntp-finish-retrieve-group-infos): Protect against the first 94 * nntp.el (nntp-finish-retrieve-group-infos): Protect against the first
@@ -42,11 +96,58 @@
42 96
43 * proto-stream.el (open-protocol-stream): Document the return value. 97 * proto-stream.el (open-protocol-stream): Document the return value.
44 98
992011-02-06 Teodor Zlatanov <tzz@lifelogs.com>
100
101 * auth-source.el (auth-source-secrets-search): Add examples.
102
452011-02-06 Julien Danjou <julien@danjou.info> 1032011-02-06 Julien Danjou <julien@danjou.info>
46 104
47 * message.el (message-setup-1): Handle message-generate-headers-first 105 * message.el (message-setup-1): Handle message-generate-headers-first
48 set to t. 106 set to t.
49 107
1082011-02-06 Teodor Zlatanov <tzz@lifelogs.com>
109
110 * auth-source.el (auth-sources): Allow for simpler defaults for Secrets
111 API with a string "secrets:collection-name" and with 'default.
112 (auth-source-backend-parse): Parse "secrets:collection-name" and
113 'default. Recurse on parses instead of repeating code. Use the
114 Secrets API is the source is not nil and 'ignore otherwise. Emit a
115 message when ignoring a source.
116 (auth-source-search): List ignored search keys at the top level.
117 (auth-source-netrc-create): Use `case' instead of `cond'.
118 (auth-source-secrets-search): Created with TODOs.
119 (auth-source-secrets-create): Created with TODOs.
120 (auth-source-retrieve, auth-source-create, auth-source-delete)
121 (auth-source-protocol-defaults, auth-source-user-or-password-imap)
122 (auth-source-user-or-password-pop3, auth-source-user-or-password-ssh)
123 (auth-source-user-or-password-sftp)
124 (auth-source-user-or-password-smtp): Removed.
125 (auth-source-user-or-password): Deprecated and modified to be a wrapper
126 around `auth-source-search'. Not tested thoroughly.
127
1282011-02-04 Teodor Zlatanov <tzz@lifelogs.com>
129
130 * auth-source.el: Bring in assoc and eioeio libraries.
131 (secrets-enabled): New variable to track the status of the Secrets API.
132 (auth-source-backend): New EIOEIO class to represent a backend.
133 (auth-source-creation-defaults): New variable to set prompt defaults
134 during token creation (see the `auth-source-search' docstring for
135 details).
136 (auth-sources): Simplify to allow a simple string as a netrc backend
137 spec.
138 (auth-source-backend-parse): Parse a backend from an `auth-sources' spec.
139 (auth-source-backend-parse-parameters): Fill in the backend parameters.
140 (auth-source-search): Main auth-source API entry point.
141 (auth-source-delete): Wrapper around `auth-source-search' for deletion.
142 (auth-source-search-collection): Helper function for searching.
143 (auth-source-netrc-parse, auth-source-netrc-normalize)
144 (auth-source-netrc-search, auth-source-netrc-create): Netrc backend.
145 Supports search, create, and delete.
146 (auth-source-secrets-search, auth-source-secrets-create): Secrets API
147 backend stubs.
148 (auth-source-user-or-password): Call `auth-source-search' but it's not
149 ready yet.
150
502011-02-04 Lars Ingebrigtsen <larsi@gnus.org> 1512011-02-04 Lars Ingebrigtsen <larsi@gnus.org>
51 152
52 * message.el (message-setup-1): Remove the read-only stuff, since it 153 * message.el (message-setup-1): Remove the read-only stuff, since it
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el
index e94cfb137b0..b7a7b41049c 100644
--- a/lisp/gnus/auth-source.el
+++ b/lisp/gnus/auth-source.el
@@ -39,23 +39,64 @@
39 39
40;;; Code: 40;;; Code:
41 41
42(require 'password-cache)
42(require 'gnus-util) 43(require 'gnus-util)
43(require 'netrc) 44(require 'netrc)
44 45(require 'assoc)
45(eval-when-compile (require 'cl)) 46(eval-when-compile (require 'cl))
47(require 'eieio)
48
46(autoload 'secrets-create-item "secrets") 49(autoload 'secrets-create-item "secrets")
47(autoload 'secrets-delete-item "secrets") 50(autoload 'secrets-delete-item "secrets")
48(autoload 'secrets-get-alias "secrets") 51(autoload 'secrets-get-alias "secrets")
49(autoload 'secrets-get-attribute "secrets") 52(autoload 'secrets-get-attributes "secrets")
50(autoload 'secrets-get-secret "secrets") 53(autoload 'secrets-get-secret "secrets")
51(autoload 'secrets-list-collections "secrets") 54(autoload 'secrets-list-collections "secrets")
52(autoload 'secrets-search-items "secrets") 55(autoload 'secrets-search-items "secrets")
53 56
57(defvar secrets-enabled)
58
54(defgroup auth-source nil 59(defgroup auth-source nil
55 "Authentication sources." 60 "Authentication sources."
56 :version "23.1" ;; No Gnus 61 :version "23.1" ;; No Gnus
57 :group 'gnus) 62 :group 'gnus)
58 63
64(defclass auth-source-backend ()
65 ((type :initarg :type
66 :initform 'netrc
67 :type symbol
68 :custom symbol
69 :documentation "The backend type.")
70 (source :initarg :source
71 :type string
72 :custom string
73 :documentation "The backend source.")
74 (host :initarg :host
75 :initform t
76 :type t
77 :custom string
78 :documentation "The backend host.")
79 (user :initarg :user
80 :initform t
81 :type t
82 :custom string
83 :documentation "The backend user.")
84 (protocol :initarg :protocol
85 :initform t
86 :type t
87 :custom string
88 :documentation "The backend protocol.")
89 (create-function :initarg :create-function
90 :initform ignore
91 :type function
92 :custom function
93 :documentation "The create function.")
94 (search-function :initarg :search-function
95 :initform ignore
96 :type function
97 :custom function
98 :documentation "The search function.")))
99
59(defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993") 100(defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993")
60 (pop3 "pop3" "pop" "pop3s" "110" "995") 101 (pop3 "pop3" "pop" "pop3s" "110" "995")
61 (ssh "ssh" "22") 102 (ssh "ssh" "22")
@@ -81,11 +122,15 @@
81 p))) 122 p)))
82 auth-source-protocols)) 123 auth-source-protocols))
83 124
84(defvar auth-source-cache (make-hash-table :test 'equal) 125(defvar auth-source-creation-defaults nil
85 "Cache for auth-source data") 126 "Defaults for creating token values. Usually let-bound.")
127
128(make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1")
129
130(defvar auth-source-magic "auth-source-magic ")
86 131
87(defcustom auth-source-do-cache t 132(defcustom auth-source-do-cache t
88 "Whether auth-source should cache information." 133 "Whether auth-source should cache information with `password-cache'."
89 :group 'auth-source 134 :group 'auth-source
90 :version "23.2" ;; No Gnus 135 :version "23.2" ;; No Gnus
91 :type `boolean) 136 :type `boolean)
@@ -108,65 +153,71 @@ If the value is a function, debug messages are logged by calling
108 (function :tag "Function that takes arguments like `message'") 153 (function :tag "Function that takes arguments like `message'")
109 (const :tag "Don't log anything" nil))) 154 (const :tag "Don't log anything" nil)))
110 155
111(defcustom auth-source-hide-passwords t 156(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo")
112 "Whether auth-source should hide passwords in log messages.
113Only relevant if `auth-source-debug' is not nil."
114 :group 'auth-source
115 :version "23.2" ;; No Gnus
116 :type `boolean)
117
118(defcustom auth-sources '((:source "~/.authinfo.gpg")
119 (:source "~/.authinfo"))
120 "List of authentication sources. 157 "List of authentication sources.
121 158
122The default will get login and password information from a .gpg 159The default will get login and password information from
123file, which you should set up with the EPA/EPG packages to be 160\"~/.authinfo.gpg\", which you should set up with the EPA/EPG
124encrypted. See the auth.info manual for details. 161packages to be encrypted. If that file doesn't exist, it will
162try the unencrypted version \"~/.authinfo\".
163
164See the auth.info manual for details.
125 165
126Each entry is the authentication type with optional properties. 166Each entry is the authentication type with optional properties.
127 167
128It's best to customize this with `M-x customize-variable' because the choices 168It's best to customize this with `M-x customize-variable' because the choices
129can get pretty complex." 169can get pretty complex."
130 :group 'auth-source 170 :group 'auth-source
131 :version "23.2" ;; No Gnus 171 :version "24.1" ;; No Gnus
132 :type `(repeat :tag "Authentication Sources" 172 :type `(repeat :tag "Authentication Sources"
133 (list :tag "Source definition" 173 (choice
134 (const :format "" :value :source) 174 (string :tag "Just a file")
135 (choice :tag "Authentication backend choice" 175 (const :tag "Default Secrets API Collection" 'default)
136 (string :tag "Authentication Source (file)") 176 (const :tag "Login Secrets API Collection" "secrets:login")
137 (list :tag "secrets.el (Secret Service API/KWallet/GNOME Keyring)" 177 (const :tag "Temp Secrets API Collection" "secrets:session")
138 (const :format "" :value :secrets) 178 (list :tag "Source definition"
139 (choice :tag "Collection to use" 179 (const :format "" :value :source)
140 (string :tag "Collection name") 180 (choice :tag "Authentication backend choice"
141 (const :tag "Default" 'default) 181 (string :tag "Authentication Source (file)")
142 (const :tag "Login" "login") 182 (list
143 (const :tag "Temporary" "session")))) 183 :tag "Secret Service API/KWallet/GNOME Keyring"
144 (repeat :tag "Extra Parameters" :inline t 184 (const :format "" :value :secrets)
145 (choice :tag "Extra parameter" 185 (choice :tag "Collection to use"
146 (list :tag "Host (omit to match as a fallback)" 186 (string :tag "Collection name")
147 (const :format "" :value :host) 187 (const :tag "Default" 'default)
148 (choice :tag "Host (machine) choice" 188 (const :tag "Login" "login")
149 (const :tag "Any" t) 189 (const
150 (regexp :tag "Host (machine) regular expression"))) 190 :tag "Temporary" "session"))))
151 (list :tag "Protocol (omit to match as a fallback)" 191 (repeat :tag "Extra Parameters" :inline t
152 (const :format "" :value :protocol) 192 (choice :tag "Extra parameter"
153 (choice :tag "Protocol" 193 (list
154 (const :tag "Any" t) 194 :tag "Host"
155 ,@auth-source-protocols-customize)) 195 (const :format "" :value :host)
156 (list :tag "User (omit to match as a fallback)" :inline t 196 (choice :tag "Host (machine) choice"
157 (const :format "" :value :user) 197 (const :tag "Any" t)
158 (choice :tag "Personality or username" 198 (regexp
159 (const :tag "Any" t) 199 :tag "Regular expression")))
160 (string :tag "Specific user name")))))))) 200 (list
201 :tag "Protocol"
202 (const :format "" :value :protocol)
203 (choice
204 :tag "Protocol"
205 (const :tag "Any" t)
206 ,@auth-source-protocols-customize))
207 (list :tag "User" :inline t
208 (const :format "" :value :user)
209 (choice :tag "Personality/Username"
210 (const :tag "Any" t)
211 (string :tag "Name")))))))))
161 212
162(defcustom auth-source-gpg-encrypt-to t 213(defcustom auth-source-gpg-encrypt-to t
163 "List of recipient keys that `authinfo.gpg' encrypted to. 214 "List of recipient keys that `authinfo.gpg' encrypted to.
164If the value is not a list, symmetric encryption will be used." 215If the value is not a list, symmetric encryption will be used."
165 :group 'auth-source 216 :group 'auth-source
166 :version "23.2" ;; No Gnus 217 :version "24.1" ;; No Gnus
167 :type '(choice (const :tag "Symmetric encryption" t) 218 :type '(choice (const :tag "Symmetric encryption" t)
168 (repeat :tag "Recipient public keys" 219 (repeat :tag "Recipient public keys"
169 (string :tag "Recipient public key")))) 220 (string :tag "Recipient public key"))))
170 221
171;; temp for debugging 222;; temp for debugging
172;; (unintern 'auth-source-protocols) 223;; (unintern 'auth-source-protocols)
@@ -211,229 +262,799 @@ If the value is not a list, symmetric encryption will be used."
211 262
212;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t))) 263;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t)))
213 264
214(defun auth-get-source (entry) 265;; (auth-source-backend-parse "myfile.gpg")
215 "Return the source string of ENTRY, which is one entry in `auth-sources'. 266;; (auth-source-backend-parse 'default)
216If it is a Secret Service API, return the collection name, otherwise 267;; (auth-source-backend-parse "secrets:login")
217the file name." 268
218 (let ((source (plist-get entry :source))) 269(defun auth-source-backend-parse (entry)
219 (if (stringp source) 270 "Creates an auth-source-backend from an ENTRY in `auth-sources'."
220 source 271 (auth-source-backend-parse-parameters
221 ;; Secret Service API. 272 entry
222 (setq source (plist-get source :secrets)) 273 (cond
223 (when (eq source 'default) 274 ;; take 'default and recurse to get it as a Secrets API default collection
224 (setq source (or (secrets-get-alias "default") "login"))) 275 ;; matching any user, host, and protocol
225 (or source "session")))) 276 ((eq entry 'default)
226 277 (auth-source-backend-parse '(:source (:secrets default))))
227(defun auth-source-pick (&rest spec) 278 ;; take secrets:XYZ and recurse to get it as Secrets API collection "XYZ"
228 "Parse `auth-sources' for matches of the SPEC plist. 279 ;; matching any user, host, and protocol
229 280 ((and (stringp entry) (string-match "^secrets:\\(.+\\)" entry))
230Common keys are :host, :protocol, and :user. A value of t in 281 (auth-source-backend-parse `(:source (:secrets ,(match-string 1 entry)))))
231SPEC means to always succeed in the match. A string value is 282 ;; take just a file name and recurse to get it as a netrc file
232matched as a regex." 283 ;; matching any user, host, and protocol
233 (let ((keys (loop for i below (length spec) by 2 collect (nth i spec))) 284 ((stringp entry)
234 choices) 285 (auth-source-backend-parse `(:source ,entry)))
235 (dolist (choice (copy-tree auth-sources) choices) 286
236 (let ((source (plist-get choice :source)) 287 ;; a file name with parameters
237 (match t)) 288 ((stringp (plist-get entry :source))
238 (when 289 (auth-source-backend
239 (and 290 (plist-get entry :source)
240 ;; Check existence of source. 291 :source (plist-get entry :source)
241 (if (consp source) 292 :type 'netrc
242 ;; Secret Service API. 293 :search-function 'auth-source-netrc-search
243 (member (auth-get-source choice) (secrets-list-collections)) 294 :create-function 'auth-source-netrc-create))
244 ;; authinfo file. 295
245 (file-exists-p source)) 296 ;; the Secrets API. We require the package, in order to have a
246 297 ;; defined value for `secrets-enabled'.
247 ;; Check keywords. 298 ((and
248 (dolist (k keys match) 299 (not (null (plist-get entry :source))) ; the source must not be nil
249 (let* ((v (plist-get spec k)) 300 (listp (plist-get entry :source)) ; and it must be a list
250 (choicev (if (plist-member choice k) 301 (require 'secrets nil t) ; and we must load the Secrets API
251 (plist-get choice k) t))) 302 secrets-enabled) ; and that API must be enabled
252 (setq match 303
253 (and match 304 ;; the source is either the :secrets key in ENTRY or
254 (or 305 ;; if that's missing or nil, it's "session"
255 ;; source always matches spec key 306 (let ((source (or (plist-get (plist-get entry :source) :secrets)
256 (eq t choicev) 307 "session")))
257 ;; source key gives regex to match against spec 308
258 (and (stringp choicev) (string-match choicev v)) 309 ;; if the source is a symbol, we look for the alias named so,
259 ;; source key gives symbol to match against spec 310 ;; and if that alias is missing, we use "login"
260 (and (symbolp choicev) (eq choicev v)))))))) 311 (when (symbolp source)
261 312 (setq source (or (secrets-get-alias (symbol-name source))
262 (add-to-list 'choices choice 'append)))))) 313 "login")))
263 314
264(defun auth-source-retrieve (mode entry &rest spec) 315 (auth-source-backend
265 "Retrieve MODE credentials according to SPEC from ENTRY." 316 (format "Secrets API (%s)" source)
266 (catch 'no-password 317 :source source
267 (let ((host (plist-get spec :host)) 318 :type 'secrets
268 (user (plist-get spec :user)) 319 :search-function 'auth-source-secrets-search
269 (prot (plist-get spec :protocol)) 320 :create-function 'auth-source-secrets-create)))
270 (source (plist-get entry :source)) 321
271 result) 322 ;; none of them
272 (cond 323 (t
273 ;; Secret Service API. 324 (auth-source-do-debug
274 ((consp source) 325 "auth-source-backend-parse: invalid backend spec: %S" entry)
275 (let ((coll (auth-get-source entry)) 326 (auth-source-backend
276 item) 327 "Empty"
277 ;; Loop over candidates with a matching host attribute. 328 :source ""
278 (dolist (elt (secrets-search-items coll :host host) item) 329 :type 'ignore)))))
279 (when (and (or (not user) 330
280 (string-equal 331(defun auth-source-backend-parse-parameters (entry backend)
281 user (secrets-get-attribute coll elt :user))) 332 "Fills in the extra auth-source-backend parameters of ENTRY.
282 (or (not prot) 333Using the plist ENTRY, get the :host, :protocol, and :user search
283 (string-equal 334parameters. Accepts :port as an alias to :protocol. Sets all
284 prot (secrets-get-attribute coll elt :protocol)))) 335the parameters to t if they are missing."
285 (setq item elt) 336 (let (val)
286 (return elt))) 337 (when (setq val (plist-get entry :host))
287 ;; Compose result. 338 (oset backend host val))
288 (when item 339 (when (setq val (plist-get entry :user))
289 (setq result 340 (oset backend user val))
290 (mapcar (lambda (m) 341 ;; accept :port as an alias for :protocol
291 (if (string-equal "password" m) 342 (when (setq val (or (plist-get entry :protocol) (plist-get entry :port)))
292 (or (secrets-get-secret coll item) 343 (oset backend protocol val)))
293 ;; When we do not find a password, 344 backend)
294 ;; we return nil anyway. 345
295 (throw 'no-password nil)) 346;; (mapcar 'auth-source-backend-parse auth-sources)
296 (or (secrets-get-attribute coll item :user) 347
297 user))) 348(defun* auth-source-search (&rest spec
298 (if (consp mode) mode (list mode))))) 349 &key type max host user protocol secret
299 (if (consp mode) result (car result)))) 350 create delete
300 ;; Anything else is netrc. 351 &allow-other-keys)
301 (t 352 "Search or modify authentication backends according to SPEC.
302 (let ((search (list source (list host) (list (format "%s" prot)) 353
303 (auth-source-protocol-defaults prot)))) 354This function parses `auth-sources' for matches of the SPEC
304 (setq result 355plist. It can optionally create or update an authentication
305 (mapcar (lambda (m) 356token if requested. A token is just a standard Emacs property
306 (if (string-equal "password" m) 357list with a :secret property that can be a function; all the
307 (or (apply 358other properties will always hold scalar values.
308 'netrc-machine-user-or-password m search) 359
309 ;; When we do not find a password, we 360Typically the :secret property, if present, contains a password.
310 ;; return nil anyway. 361
311 (throw 'no-password nil)) 362Common search keys are :max, :host, :protocol, and :user. In
312 (or (apply 363addition, :create specifies how tokens will be or created.
313 'netrc-machine-user-or-password m search) 364Finally, :type can specify which backend types you want to check.
314 user))) 365
315 (if (consp mode) mode (list mode))))) 366A string value is always matched literally. A symbol is matched
316 (if (consp mode) result (car result))))))) 367as its string value, literally. All the SPEC values can be
317 368single values (symbol or string) or lists thereof (in which case
318(defun auth-source-create (mode entry &rest spec) 369any of the search terms matches).
319 "Create interactively credentials according to SPEC in ENTRY. 370
320Return structure as specified by MODE." 371:create t means to create a token if possible.
321 (let* ((host (plist-get spec :host)) 372
322 (user (plist-get spec :user)) 373A new token will be created if no matching tokens were found.
323 (prot (plist-get spec :protocol)) 374The new token will have only the keys the backend requires. For
324 (source (plist-get entry :source)) 375the netrc backend, for instance, that's the user, host, and
325 (name (concat (if user (format "%s@" user)) 376protocol keys.
326 host 377
327 (if prot (format ":%s" prot)))) 378Here's an example:
328 result) 379
329 (setq result 380\(let ((auth-source-creation-defaults '((user . \"defaultUser\")
330 (mapcar 381 (A . \"default A\"))))
331 (lambda (m) 382 (auth-source-search :host \"mine\" :type 'netrc :max 1
332 (cons 383 :P \"pppp\" :Q \"qqqq\"
333 m 384 :create t))
334 (cond 385
335 ((equal "password" m) 386which says:
336 (let ((passwd (read-passwd 387
337 (format "Password for %s on %s: " prot host)))) 388\"Search for any entry matching host 'mine' in backends of type
338 (cond 389 'netrc', maximum one result.
339 ;; Secret Service API. 390
340 ((consp source) 391 Create a new entry if you found none. The netrc backend will
341 (apply 392 automatically require host, user, and protocol. The host will be
342 'secrets-create-item 393 'mine'. We prompt for the user with default 'defaultUser' and
343 (auth-get-source entry) name passwd spec)) 394 for the protocol without a default. We will not prompt for A, Q,
344 (t)) ;; netrc not implemented yes. 395 or P. The resulting token will only have keys user, host, and
345 passwd)) 396 protocol.\"
346 ((equal "login" m) 397
347 (or user 398:create '(A B C) also means to create a token if possible.
348 (read-string 399
349 (format "User name for %s on %s (default %s): " prot host 400The behavior is like :create t but if the list contains any
350 (user-login-name)) 401parameter, that parameter will be required in the resulting
351 nil nil (user-login-name)))) 402token. The value for that parameter will be obtained from the
352 (t 403search parameters or from user input. If any queries are needed,
353 "unknownuser")))) 404the alist `auth-source-creation-defaults' will be checked for the
354 (if (consp mode) mode (list mode)))) 405default prompt.
355 ;; Allow the source to save the data. 406
356 (cond 407Here's an example:
357 ((consp source) 408
358 ;; Secret Service API -- not implemented. 409\(let ((auth-source-creation-defaults '((user . \"defaultUser\")
359 ) 410 (A . \"default A\"))))
360 (t 411 (auth-source-search :host '(\"nonesuch\" \"twosuch\") :type 'netrc :max 1
361 ;; netrc interface. 412 :P \"pppp\" :Q \"qqqq\"
362 (when (y-or-n-p (format "Do you want to save this password in %s? " 413 :create '(A B Q)))
363 source)) 414
364 ;; the code below is almost same as `netrc-store-data' except 415which says:
365 ;; the `epa-file-encrypt-to' hack (see bug#7487). 416
366 (with-temp-buffer 417\"Search for any entry matching host 'nonesuch'
367 (when (file-exists-p source) 418 or 'twosuch' in backends of type 'netrc', maximum one result.
368 (insert-file-contents source)) 419
369 (when auth-source-gpg-encrypt-to 420 Create a new entry if you found none. The netrc backend will
370 ;; making `epa-file-encrypt-to' local to this buffer lets 421 automatically require host, user, and protocol. The host will be
371 ;; epa-file skip the key selection query (see the 422 'nonesuch' and Q will be 'qqqq'. We prompt for A with default
372 ;; `local-variable-p' check in `epa-file-write-region'). 423 'default A', for B and protocol with default nil, and for the
373 (unless (local-variable-p 'epa-file-encrypt-to (current-buffer)) 424 user with default 'defaultUser'. We will not prompt for Q. The
374 (make-local-variable 'epa-file-encrypt-to)) 425 resulting token will have keys user, host, protocol, A, B, and Q.
375 (if (listp auth-source-gpg-encrypt-to) 426 It will not have P with any value, even though P is used in the
376 (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) 427 search to find only entries that have P set to 'pppp'.\"
377 (goto-char (point-max)) 428
378 (unless (bolp) 429When multiple values are specified in the search parameter, the
379 (insert "\n")) 430first one is used for creation. So :host (X Y Z) would create a
380 (insert (format "machine %s login %s password %s port %s\n" 431token for host X, for instance.
381 host 432
382 (or user (cdr (assoc "login" result))) 433This creation can fail if the search was not specific enough to
383 (cdr (assoc "password" result)) 434create a new token (it's up to the backend to decide that). You
384 prot)) 435should `catch' the backend-specific error as usual. Some
385 (write-region (point-min) (point-max) source nil 'silent))))) 436backends (netrc, at least) will prompt the user rather than throw
386 (if (consp mode) 437an error.
387 (mapcar #'cdr result) 438
388 (cdar result)))) 439:delete t means to delete any found entries. nil by default.
389 440Use `auth-source-delete' in ELisp code instead of calling
390(defun auth-source-delete (entry &rest spec) 441`auth-source-search' directly with this parameter.
391 "Delete credentials according to SPEC in ENTRY." 442
392 (let ((host (plist-get spec :host)) 443:type (X Y Z) will check only those backend types. 'netrc and
393 (user (plist-get spec :user)) 444'secrets are the only ones supported right now.
394 (prot (plist-get spec :protocol)) 445
395 (source (plist-get entry :source))) 446:max N means to try to return at most N items (defaults to 1).
396 (cond 447When 0 the function will return just t or nil to indicate if any
397 ;; Secret Service API. 448matches were found. More than N items may be returned, depending
398 ((consp source) 449on the search and the backend.
399 (let ((coll (auth-get-source entry))) 450
400 ;; Loop over candidates with a matching host attribute. 451:host (X Y Z) means to match only hosts X, Y, or Z according to
401 (dolist (elt (secrets-search-items coll :host host)) 452the match rules above. Defaults to t.
402 (when (and (or (not user) 453
403 (string-equal 454:user (X Y Z) means to match only users X, Y, or Z according to
404 user (secrets-get-attribute coll elt :user))) 455the match rules above. Defaults to t.
405 (or (not prot) 456
406 (string-equal 457:protocol (P Q R) means to match only protocols P, Q, or R.
407 prot (secrets-get-attribute coll elt :protocol)))) 458Defaults to t.
408 (secrets-delete-item coll elt))))) 459
409 (t)))) ;; netrc not implemented yes. 460:K (V1 V2 V3) for any other key K will match values V1, V2, or
410 461V3 (note the match rules above).
411(defun auth-source-forget-user-or-password 462
412 (mode host protocol &optional username) 463The return value is a list with at most :max tokens. Each token
413 "Remove cached authentication token." 464is a plist with keys :backend :host :protocol :user, plus any other
414 (interactive "slogin/password: \nsHost: \nsProtocol: \n") ;for testing 465keys provided by the backend (notably :secret). But note the
415 (remhash 466exception for :max 0, which see above.
416 (if username 467
417 (format "%s %s:%s %s" mode host protocol username) 468The token's :secret key can hold a function. In that case you
418 (format "%s %s:%s" mode host protocol)) 469must call it to obtain the actual value."
419 auth-source-cache)) 470 (let* ((backends (mapcar 'auth-source-backend-parse auth-sources))
471 (max (or max 1))
472 (ignored-keys '(:create :delete :max))
473 (keys (loop for i below (length spec) by 2
474 unless (memq (nth i spec) ignored-keys)
475 collect (nth i spec)))
476 (found (auth-source-recall spec))
477 filtered-backends accessor-key found-here goal)
478
479 (if (and found auth-source-do-cache)
480 (auth-source-do-debug
481 "auth-source-search: found %d CACHED results matching %S"
482 (length found) spec)
483
484 (assert
485 (or (eq t create) (listp create)) t
486 "Invalid auth-source :create parameter (must be nil, t, or a list)")
487
488 (setq filtered-backends (copy-list backends))
489 (dolist (backend backends)
490 (dolist (key keys)
491 ;; ignore invalid slots
492 (condition-case signal
493 (unless (eval `(auth-source-search-collection
494 (plist-get spec key)
495 (oref backend ,key)))
496 (setq filtered-backends (delq backend filtered-backends))
497 (return))
498 (invalid-slot-name))))
499
500 (auth-source-do-debug
501 "auth-source-search: found %d backends matching %S"
502 (length filtered-backends) spec)
503
504 ;; (debug spec "filtered" filtered-backends)
505 (setq goal max)
506 (dolist (backend filtered-backends)
507 (setq found-here (apply
508 (slot-value backend 'search-function)
509 :backend backend
510 :create create
511 :delete delete
512 spec))
513
514 ;; if max is 0, as soon as we find something, return it
515 (when (and (zerop max) (> 0 (length found-here)))
516 (return t))
517
518 ;; decrement the goal by the number of new results
519 (decf goal (length found-here))
520 ;; and append the new results to the full list
521 (setq found (append found found-here))
522
523 (auth-source-do-debug
524 "auth-source-search: found %d results (max %d/%d) in %S matching %S"
525 (length found-here) max goal backend spec)
526
527 ;; return full list if the goal is 0 or negative
528 (when (zerop (max 0 goal))
529 (return found))
530
531 ;; change the :max parameter in the spec to the goal
532 (setq spec (plist-put spec :max goal)))
533
534 (when (and found auth-source-do-cache)
535 (auth-source-remember spec found)))
536
537 found))
538
539;;; (auth-source-search :max 1)
540;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
541;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
542;;; (auth-source-search :host "nonesuch" :type 'secrets)
543
544(defun* auth-source-delete (&rest spec
545 &key delete
546 &allow-other-keys)
547 "Delete entries from the authentication backends according to SPEC.
548Calls `auth-source-search' with the :delete property in SPEC set to t.
549The backend may not actually delete the entries.
550
551Returns the deleted entries."
552 (auth-source-search (plist-put spec :delete t)))
553
554(defun auth-source-search-collection (collection value)
555 "Returns t is VALUE is t or COLLECTION is t or contains VALUE."
556 (when (and (atom collection) (not (eq t collection)))
557 (setq collection (list collection)))
558
559 ;; (debug :collection collection :value value)
560 (or (eq collection t)
561 (eq value t)
562 (equal collection value)
563 (member value collection)))
420 564
421(defun auth-source-forget-all-cached () 565(defun auth-source-forget-all-cached ()
422 "Forget all cached auth-source authentication tokens." 566 "Forget all cached auth-source data."
423 (interactive) 567 (interactive)
424 (setq auth-source-cache (make-hash-table :test 'equal))) 568 (loop for sym being the symbols of password-data
569 ;; when the symbol name starts with auth-source-magic
570 when (string-match (concat "^" auth-source-magic)
571 (symbol-name sym))
572 ;; remove that key
573 do (password-cache-remove (symbol-name sym))))
574
575(defun auth-source-remember (spec found)
576 "Remember FOUND search results for SPEC."
577 (password-cache-add
578 (concat auth-source-magic (format "%S" spec)) found))
579
580(defun auth-source-recall (spec)
581 "Recall FOUND search results for SPEC."
582 (password-read-from-cache
583 (concat auth-source-magic (format "%S" spec))))
584
585(defun auth-source-forget (spec)
586 "Forget any cached data matching SPEC exactly.
587
588This is the same SPEC you passed to `auth-source-search'.
589Returns t or nil for forgotten or not found."
590 (password-cache-remove (concat auth-source-magic (format "%S" spec))))
591
592;;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym))
593
594;;; (auth-source-remember '(:host "wedd") '(4 5 6))
595;;; (auth-source-remember '(:host "xedd") '(1 2 3))
596;;; (auth-source-recall '(:host "xedd"))
597;;; (auth-source-recall '(:host t))
598;;; (auth-source-forget+ :host t)
599
600(defun* auth-source-forget+ (&rest spec &allow-other-keys)
601 "Forget any cached data matching SPEC. Returns forgotten count.
602
603This is not a full `auth-source-search' spec but works similarly.
604For instance, \(:host \"myhost\" \"yourhost\") would find all the
605cached data that was found with a search for those two hosts,
606while \(:host t) would find all host entries."
607 (let ((count 0)
608 sname)
609 (loop for sym being the symbols of password-data
610 ;; when the symbol name matches with auth-source-magic
611 when (and (setq sname (symbol-name sym))
612 (string-match (concat "^" auth-source-magic "\\(.+\\)")
613 sname)
614 ;; and the spec matches what was stored in the cache
615 (auth-source-specmatchp spec (read (match-string 1 sname))))
616 ;; remove that key
617 do (progn
618 (password-cache-remove sname)
619 (incf count)))
620 count))
621
622(defun auth-source-specmatchp (spec stored)
623 (let ((keys (loop for i below (length spec) by 2
624 collect (nth i spec))))
625 (not (eq
626 (dolist (key keys)
627 (unless (auth-source-search-collection (plist-get stored key)
628 (plist-get spec key))
629 (return 'no)))
630 'no))))
631
632;;; Backend specific parsing: netrc/authinfo backend
633
634;;; (auth-source-netrc-parse "~/.authinfo.gpg")
635(defun* auth-source-netrc-parse (&rest
636 spec
637 &key file max host user protocol delete
638 &allow-other-keys)
639 "Parse FILE and return a list of all entries in the file.
640Note that the MAX parameter is used so we can exit the parse early."
641 (if (listp file)
642 ;; We got already parsed contents; just return it.
643 file
644 (when (file-exists-p file)
645 (with-temp-buffer
646 (let ((tokens '("machine" "host" "default" "login" "user"
647 "password" "account" "macdef" "force"
648 "port" "protocol"))
649 (max (or max 5000)) ; sanity check: default to stop at 5K
650 (modified 0)
651 alist elem result pair)
652 (insert-file-contents file)
653 (goto-char (point-min))
654 ;; Go through the file, line by line.
655 (while (and (not (eobp))
656 (> max 0))
657
658 (narrow-to-region (point) (point-at-eol))
659 ;; For each line, get the tokens and values.
660 (while (not (eobp))
661 (skip-chars-forward "\t ")
662 ;; Skip lines that begin with a "#".
663 (if (eq (char-after) ?#)
664 (goto-char (point-max))
665 (unless (eobp)
666 (setq elem
667 (if (= (following-char) ?\")
668 (read (current-buffer))
669 (buffer-substring
670 (point) (progn (skip-chars-forward "^\t ")
671 (point)))))
672 (cond
673 ((equal elem "macdef")
674 ;; We skip past the macro definition.
675 (widen)
676 (while (and (zerop (forward-line 1))
677 (looking-at "$")))
678 (narrow-to-region (point) (point)))
679 ((member elem tokens)
680 ;; Tokens that don't have a following value are ignored,
681 ;; except "default".
682 (when (and pair (or (cdr pair)
683 (equal (car pair) "default")))
684 (push pair alist))
685 (setq pair (list elem)))
686 (t
687 ;; Values that haven't got a preceding token are ignored.
688 (when pair
689 (setcdr pair elem)
690 (push pair alist)
691 (setq pair nil)))))))
692
693 (when (and alist
694 (> max 0)
695 (auth-source-search-collection
696 host
697 (or
698 (aget alist "machine")
699 (aget alist "host")))
700 (auth-source-search-collection
701 user
702 (or
703 (aget alist "login")
704 (aget alist "account")
705 (aget alist "user")))
706 (auth-source-search-collection
707 protocol
708 (or
709 (aget alist "port")
710 (aget alist "protocol"))))
711 (decf max)
712 (push (nreverse alist) result)
713 ;; to delete a line, we just comment it out
714 (when delete
715 (goto-char (point-min))
716 (insert "#")
717 (incf modified)))
718 (setq alist nil
719 pair nil)
720 (widen)
721 (forward-line 1))
722
723 (when (< 0 modified)
724 (when auth-source-gpg-encrypt-to
725 ;; (see bug#7487) making `epa-file-encrypt-to' local to
726 ;; this buffer lets epa-file skip the key selection query
727 ;; (see the `local-variable-p' check in
728 ;; `epa-file-write-region').
729 (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
730 (make-local-variable 'epa-file-encrypt-to))
731 (if (listp auth-source-gpg-encrypt-to)
732 (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
733
734 ;; ask AFTER we've successfully opened the file
735 (when (y-or-n-p (format "Save file %s? (%d modifications)"
736 file modified))
737 (write-region (point-min) (point-max) file nil 'silent)
738 (auth-source-do-debug
739 "auth-source-netrc-parse: modified %d lines in %s"
740 modified file)))
741
742 (nreverse result))))))
743
744(defun auth-source-netrc-normalize (alist)
745 (mapcar (lambda (entry)
746 (let (ret item)
747 (while (setq item (pop entry))
748 (let ((k (car item))
749 (v (cdr item)))
750
751 ;; apply key aliases
752 (setq k (cond ((member k '("machine")) "host")
753 ((member k '("login" "account")) "user")
754 ((member k '("protocol")) "port")
755 ((member k '("password")) "secret")
756 (t k)))
757
758 ;; send back the secret in a function (lexical binding)
759 (when (equal k "secret")
760 (setq v (lexical-let ((v v))
761 (lambda () v))))
762
763 (setq ret (plist-put ret
764 (intern (concat ":" k))
765 v))
766 ))
767 ret))
768 alist))
769
770;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret))
771;;; (funcall secret)
772
773(defun* auth-source-netrc-search (&rest
774 spec
775 &key backend create delete
776 type max host user protocol
777 &allow-other-keys)
778"Given a property list SPEC, return search matches from the :backend.
779See `auth-source-search' for details on SPEC."
780 ;; just in case, check that the type is correct (null or same as the backend)
781 (assert (or (null type) (eq type (oref backend type)))
782 t "Invalid netrc search")
783
784 (let ((results (auth-source-netrc-normalize
785 (auth-source-netrc-parse
786 :max max
787 :delete delete
788 :file (oref backend source)
789 :host (or host t)
790 :user (or user t)
791 :protocol (or protocol t)))))
792
793 ;; if we need to create an entry AND none were found to match
794 (when (and create
795 (= 0 (length results)))
796
797 ;; create based on the spec
798 (apply (slot-value backend 'create-function) spec)
799 ;; turn off the :create key
800 (setq spec (plist-put spec :create nil))
801 ;; run the search again to get the updated data
802 ;; the result will be returned, even if the search fails
803 (setq results (apply 'auth-source-netrc-search spec)))
804
805 results))
806
807;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
808;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B)))
809
810(defun* auth-source-netrc-create (&rest spec
811 &key backend
812 secret host user protocol create
813 &allow-other-keys)
814 (let* ((base-required '(host user protocol secret))
815 ;; we know (because of an assertion in auth-source-search) that the
816 ;; :create parameter is either t or a list (which includes nil)
817 (create-extra (if (eq t create) nil create))
818 (required (append base-required create-extra))
819 (file (oref backend source))
820 (add "")
821 ;; `valist' is an alist
822 valist)
823
824 ;; only for base required elements (defined as function parameters):
825 ;; fill in the valist with whatever data we may have from the search
826 ;; we take the first value if it's a list, the whole value otherwise
827 (dolist (br base-required)
828 (when (symbol-value br)
829 (aput 'valist br (if (listp (symbol-value br))
830 (nth 0 (symbol-value br))
831 (symbol-value br)))))
832
833 ;; for extra required elements, see if the spec includes a value for them
834 (dolist (er create-extra)
835 (let ((name (concat ":" (symbol-name er)))
836 (keys (loop for i below (length spec) by 2
837 collect (nth i spec))))
838 (dolist (k keys)
839 (when (equal (symbol-name k) name)
840 (aput 'valist er (plist-get spec k))))))
841
842 ;; for each required element
843 (dolist (r required)
844 (let* ((data (aget valist r))
845 (given-default (aget auth-source-creation-defaults r))
846 ;; the defaults are simple
847 (default (cond
848 ((and (not given-default) (eq r 'user))
849 (user-login-name))
850 ;; note we need this empty string
851 ((and (not given-default) (eq r 'protocol))
852 "")
853 (t given-default)))
854 ;; the prompt's default string depends on the data so far
855 (default-string (if (and default (< 0 (length default)))
856 (format " (default %s)" default)
857 " (no default)"))
858 ;; the prompt should also show what's entered so far
859 (user-value (aget valist 'user))
860 (host-value (aget valist 'host))
861 (protocol-value (aget valist 'protocol))
862 (info-so-far (concat (if user-value
863 (format "%s@" user-value)
864 "[USER?]")
865 (if host-value
866 (format "%s" host-value)
867 "[HOST?]")
868 (if protocol-value
869 ;; this distinguishes protocol between
870 (if (zerop (length protocol-value))
871 "" ; 'entered as "no default"' vs.
872 (format ":%s" protocol-value)) ; given
873 ;; and this is when the protocol is unknown
874 "[PROTOCOL?]"))))
425 875
426;; (progn 876 ;; now prompt if the search SPEC did not include a required key;
427;; (auth-source-forget-all-cached) 877 ;; take the result and put it in `data' AND store it in `valist'
428;; (list 878 (aput 'valist r
429;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other") 879 (setq data
430;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other" "tzz") 880 (cond
431;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other" "joe"))) 881 ((and (null data) (eq r 'secret))
882 ;; special case prompt for passwords
883 (read-passwd (format "Password for %s: " info-so-far)))
884 ((null data)
885 (read-string
886 (format "Enter %s for %s%s: "
887 r info-so-far default-string)
888 nil nil default))
889 (t data))))
890
891 ;; when r is not an empty string...
892 (when (and (stringp data)
893 (< 0 (length data)))
894 ;; append the key (the symbol name of r) and the value in r
895 (setq add (concat add
896 (format "%s%s %S"
897 ;; prepend a space
898 (if (zerop (length add)) "" " ")
899 ;; remap auth-source tokens to netrc
900 (case r
901 ('user "login")
902 ('host "machine")
903 ('secret "password")
904 ('protocol "port")
905 (t (symbol-name r)))
906 ;; the value will be printed in %S format
907 data))))))
908
909 (with-temp-buffer
910 (when (file-exists-p file)
911 (insert-file-contents file))
912 (when auth-source-gpg-encrypt-to
913 ;; (see bug#7487) making `epa-file-encrypt-to' local to
914 ;; this buffer lets epa-file skip the key selection query
915 ;; (see the `local-variable-p' check in
916 ;; `epa-file-write-region').
917 (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
918 (make-local-variable 'epa-file-encrypt-to))
919 (if (listp auth-source-gpg-encrypt-to)
920 (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
921 (goto-char (point-max))
922
923 ;; ask AFTER we've successfully opened the file
924 (when (y-or-n-p (format "Add to file %s: line [%s]" file add))
925 (unless (bolp)
926 (insert "\n"))
927 (insert add "\n")
928 (write-region (point-min) (point-max) file nil 'silent)
929 (auth-source-do-debug
930 "auth-source-netrc-create: wrote 1 new line to %s"
931 file)))))
932
933;;; Backend specific parsing: Secrets API backend
934
935;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t))
936;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t))
937;;; (let ((auth-sources '(default))) (auth-source-search :max 1))
938;;; (let ((auth-sources '(default))) (auth-source-search))
939;;; (let ((auth-sources '("secrets:login"))) (auth-source-search :max 1))
940;;; (let ((auth-sources '("secrets:login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git"))
941
942(defun* auth-source-secrets-search (&rest
943 spec
944 &key backend create delete label
945 type max host user protocol
946 &allow-other-keys)
947 "Search the Secrets API; spec is like `auth-source'.
948
949The :label key specifies the item's label. It is the only key
950that can specify a substring. Any :label value besides a string
951will allow any label.
952
953All other search keys must match exactly. If you need substring
954matching, do a wider search and narrow it down yourself.
955
956You'll get back all the properties of the token as a plist.
957
958Here's an example that looks for the first item in the 'login'
959Secrets collection:
960
961 \(let ((auth-sources '(\"secrets:login\")))
962 (auth-source-search :max 1)
963
964Here's another that looks for the first item in the 'login'
965Secrets collection whose label contains 'gnus':
966
967 \(let ((auth-sources '(\"secrets:login\")))
968 (auth-source-search :max 1 :label \"gnus\")
969
970And this one looks for the first item in the 'login' Secrets
971collection that's a Google Chrome entry for the git.gnus.org site
972login:
973
974 \(let ((auth-sources '(\"secrets:login\")))
975 (auth-source-search :max 1 :signon_realm \"https://git.gnus.org/Git\"))
976"
977
978 ;; TODO
979 (assert (not create) nil
980 "The Secrets API auth-source backend doesn't support creation yet")
981 ;; TODO
982 ;; (secrets-delete-item coll elt)
983 (assert (not delete) nil
984 "The Secrets API auth-source backend doesn't support deletion yet")
985
986 (let* ((coll (oref backend source))
987 (max (or max 5000)) ; sanity check: default to stop at 5K
988 (ignored-keys '(:create :delete :max :backend :label))
989 (search-keys (loop for i below (length spec) by 2
990 unless (memq (nth i spec) ignored-keys)
991 collect (nth i spec)))
992 ;; build a search spec without the ignored keys
993 ;; if a search key is nil or t (match anything), we skip it
994 (search-spec (mapcan (lambda (k) (if (or (null (plist-get spec k))
995 (eq t (plist-get spec k)))
996 nil
997 (list k (plist-get spec k))))
998 search-keys))
999 ;; needed keys (always including host, login, protocol, and secret)
1000 (returned-keys (remove-duplicates (append
1001 '(:host :login :protocol :secret)
1002 search-keys)))
1003 (items (loop for item in (apply 'secrets-search-items coll search-spec)
1004 unless (and (stringp label)
1005 (not (string-match label item)))
1006 collect item))
1007 ;; TODO: respect max in `secrets-search-items', not after the fact
1008 (items (subseq items 0 (min (length items) max)))
1009 ;; convert the item name to a full plist
1010 (items (mapcar (lambda (item)
1011 (append
1012 ;; make an entry for the secret (password) element
1013 (list
1014 :secret
1015 (lexical-let ((v (secrets-get-secret coll item)))
1016 (lambda () v)))
1017 ;; rewrite the entry from ((k1 v1) (k2 v2)) to plist
1018 (mapcan (lambda (entry)
1019 (list (car entry) (cdr entry)))
1020 (secrets-get-attributes coll item))))
1021 items))
1022 ;; ensure each item has each key in `returned-keys'
1023 (items (mapcar (lambda (plist)
1024 (append
1025 (mapcan (lambda (req)
1026 (if (plist-get plist req)
1027 nil
1028 (list req nil)))
1029 returned-keys)
1030 plist))
1031 items)))
1032 items))
1033
1034(defun* auth-source-secrets-create (&rest
1035 spec
1036 &key backend type max host user protocol
1037 &allow-other-keys)
1038 ;; TODO
1039 ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec)
1040 (debug spec))
1041
1042;;; older API
1043
1044;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")
1045
1046;; deprecate the old interface
1047(make-obsolete 'auth-source-user-or-password
1048 'auth-source-search "Emacs 24.1")
1049(make-obsolete 'auth-source-forget-user-or-password
1050 'auth-source-forget "Emacs 24.1")
432 1051
433(defun auth-source-user-or-password 1052(defun auth-source-user-or-password
434 (mode host protocol &optional username create-missing delete-existing) 1053 (mode host protocol &optional username create-missing delete-existing)
435 "Find MODE (string or list of strings) matching HOST and PROTOCOL. 1054 "Find MODE (string or list of strings) matching HOST and PROTOCOL.
436 1055
1056DEPRECATED in favor of `auth-source-search'!
1057
437USERNAME is optional and will be used as \"login\" in a search 1058USERNAME is optional and will be used as \"login\" in a search
438across the Secret Service API (see secrets.el) if the resulting 1059across the Secret Service API (see secrets.el) if the resulting
439items don't have a username. This means that if you search for 1060items don't have a username. This means that if you search for
@@ -452,8 +1073,9 @@ stored in the password database which matches best (see
452 1073
453MODE can be \"login\" or \"password\"." 1074MODE can be \"login\" or \"password\"."
454 (auth-source-do-debug 1075 (auth-source-do-debug
455 "auth-source-user-or-password: get %s for %s (%s) + user=%s" 1076 "auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s"
456 mode host protocol username) 1077 mode host protocol username)
1078
457 (let* ((listy (listp mode)) 1079 (let* ((listy (listp mode))
458 (mode (if listy mode (list mode))) 1080 (mode (if listy mode (list mode)))
459 (cname (if username 1081 (cname (if username
@@ -461,70 +1083,44 @@ MODE can be \"login\" or \"password\"."
461 (format "%s %s:%s" mode host protocol))) 1083 (format "%s %s:%s" mode host protocol)))
462 (search (list :host host :protocol protocol)) 1084 (search (list :host host :protocol protocol))
463 (search (if username (append search (list :user username)) search)) 1085 (search (if username (append search (list :user username)) search))
464 (found (if (not delete-existing) 1086 (search (if create-missing
465 (gethash cname auth-source-cache) 1087 (append search (list :create t))
466 (remhash cname auth-source-cache) 1088 search))
467 nil))) 1089 (search (if delete-existing
1090 (append search (list :delete t))
1091 search))
1092 ;; (found (if (not delete-existing)
1093 ;; (gethash cname auth-source-cache)
1094 ;; (remhash cname auth-source-cache)
1095 ;; nil)))
1096 (found nil))
468 (if found 1097 (if found
469 (progn 1098 (progn
470 (auth-source-do-debug 1099 (auth-source-do-debug
471 "auth-source-user-or-password: cached %s=%s for %s (%s) + %s" 1100 "auth-source-user-or-password: DEPRECATED cached %s=%s for %s (%s) + %s"
472 mode 1101 mode
473 ;; don't show the password 1102 ;; don't show the password
474 (if (and (member "password" mode) auth-source-hide-passwords) 1103 (if (and (member "password" mode) t)
475 "SECRET" 1104 "SECRET"
476 found) 1105 found)
477 host protocol username) 1106 host protocol username)
478 found) ; return the found data 1107 found) ; return the found data
479 ;; else, if not found 1108 ;; else, if not found, search with a max of 1
480 (let ((choices (apply 'auth-source-pick search))) 1109 (let ((choice (nth 0 (apply 'auth-source-search
481 (dolist (choice choices) 1110 (append '(:max 1) search)))))
482 (if delete-existing 1111 (when choice
483 (apply 'auth-source-delete choice search) 1112 (dolist (m mode)
484 (setq found (apply 'auth-source-retrieve mode choice search))) 1113 (cond
485 (and found (return found))) 1114 ((equal "password" m)
486 1115 (push (if (plist-get choice :secret)
487 ;; We haven't found something, so we will create it interactively. 1116 (funcall (plist-get choice :secret))
488 (when (and (not found) create-missing) 1117 nil) found))
489 (setq found (apply 'auth-source-create 1118 ((equal "login" m)
490 mode (if choices 1119 (push (plist-get choice :user) found)))))
491 (car choices) 1120 (setq found (nreverse found))
492 (car auth-sources)) 1121 (setq found (if listy found (car-safe found)))))
493 search)))
494
495 ;; Cache the result.
496 (when found
497 (auth-source-do-debug
498 "auth-source-user-or-password: found %s=%s for %s (%s) + %s"
499 mode
500 ;; don't show the password
501 (if (and (member "password" mode) auth-source-hide-passwords)
502 "SECRET" found)
503 host protocol username)
504 (setq found (if listy found (car-safe found)))
505 (when auth-source-do-cache
506 (puthash cname found auth-source-cache)))
507
508 found))))
509
510(defun auth-source-protocol-defaults (protocol)
511 "Return a list of default ports and names for PROTOCOL."
512 (cdr-safe (assoc protocol auth-source-protocols)))
513
514(defun auth-source-user-or-password-imap (mode host)
515 (auth-source-user-or-password mode host 'imap))
516
517(defun auth-source-user-or-password-pop3 (mode host)
518 (auth-source-user-or-password mode host 'pop3))
519
520(defun auth-source-user-or-password-ssh (mode host)
521 (auth-source-user-or-password mode host 'ssh))
522
523(defun auth-source-user-or-password-sftp (mode host)
524 (auth-source-user-or-password mode host 'sftp))
525 1122
526(defun auth-source-user-or-password-smtp (mode host) 1123 found))
527 (auth-source-user-or-password mode host 'smtp))
528 1124
529(provide 'auth-source) 1125(provide 'auth-source)
530 1126
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index f98c195eada..6e6ef76c0c1 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -32,7 +32,7 @@
32(eval-when-compile 32(eval-when-compile
33 (require 'cl) 33 (require 'cl)
34 (require 'imap)) 34 (require 'imap))
35(autoload 'auth-source-user-or-password "auth-source") 35(autoload 'auth-source-search "auth-source")
36(autoload 'pop3-movemail "pop3") 36(autoload 'pop3-movemail "pop3")
37(autoload 'pop3-get-message-count "pop3") 37(autoload 'pop3-get-message-count "pop3")
38(autoload 'nnheader-cancel-timer "nnheader") 38(autoload 'nnheader-cancel-timer "nnheader")
@@ -332,6 +332,7 @@ Common keywords should be listed here.")
332 (:prescript) 332 (:prescript)
333 (:prescript-delay) 333 (:prescript-delay)
334 (:postscript) 334 (:postscript)
335 ;; note server and port need to come before user and password
335 (:server (getenv "MAILHOST")) 336 (:server (getenv "MAILHOST"))
336 (:port 110) 337 (:port 110)
337 (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER"))) 338 (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
@@ -345,6 +346,7 @@ Common keywords should be listed here.")
345 (:subdirs ("cur" "new")) 346 (:subdirs ("cur" "new"))
346 (:function)) 347 (:function))
347 (imap 348 (imap
349 ;; note server and port need to come before user and password
348 (:server (getenv "MAILHOST")) 350 (:server (getenv "MAILHOST"))
349 (:port) 351 (:port)
350 (:stream) 352 (:stream)
@@ -417,42 +419,66 @@ the `mail-source-keyword-map' variable."
417(put 'mail-source-bind 'lisp-indent-function 1) 419(put 'mail-source-bind 'lisp-indent-function 1)
418(put 'mail-source-bind 'edebug-form-spec '(sexp body)) 420(put 'mail-source-bind 'edebug-form-spec '(sexp body))
419 421
420;; TODO: use the list format for auth-source-user-or-password modes
421(defun mail-source-set-1 (source) 422(defun mail-source-set-1 (source)
422 (let* ((type (pop source)) 423 (let* ((type (pop source))
423 (defaults (cdr (assq type mail-source-keyword-map))) 424 (defaults (cdr (assq type mail-source-keyword-map)))
424 default value keyword auth-info user-auth pass-auth) 425 (search '(:max 1))
426 found default value keyword auth-info user-auth pass-auth)
427
428 ;; append to the search the useful info from the source and the defaults:
429 ;; user, host, and port
430
431 ;; the msname is the mail-source parameter
432 (dolist (msname '(:server :user :port))
433 ;; the asname is the auth-source parameter
434 (let* ((asname (case msname
435 (:server :host) ; auth-source uses :host
436 (t msname)))
437 ;; this is the mail-source default
438 (msdef1 (or (plist-get source msname)
439 (nth 1 (assoc msname defaults))))
440 ;; ...evaluated
441 (msdef (mail-source-value msdef1)))
442 (setq search (append (list asname
443 (if msdef msdef t))
444 search))))
445 ;; if the port is unknown yet, get it from the mail-source type
446 (unless (plist-get search :port)
447 (setq search (append (list :port (symbol-name type)))))
448
425 (while (setq default (pop defaults)) 449 (while (setq default (pop defaults))
426 ;; for each default :SYMBOL, set SYMBOL to the plist value for :SYMBOL 450 ;; for each default :SYMBOL, set SYMBOL to the plist value for :SYMBOL
427 ;; using `mail-source-value' to evaluate the plist value 451 ;; using `mail-source-value' to evaluate the plist value
428 (set (mail-source-strip-keyword (setq keyword (car default))) 452 (set (mail-source-strip-keyword (setq keyword (car default)))
429 ;; note the following reasons for this structure: 453 ;; note the following reasons for this structure:
430 ;; 1) the auth-sources user and password override everything 454 ;; 1) the auth-sources user and password override everything
431 ;; 2) it avoids macros, so it's cleaner 455 ;; 2) it avoids macros, so it's cleaner
432 ;; 3) it falls through to the mail-sources and then default values 456 ;; 3) it falls through to the mail-sources and then default values
433 (cond 457 (cond
434 ((and 458 ((and
435 (eq keyword :user) 459 (eq keyword :user)
436 (setq user-auth 460 (setq user-auth (plist-get
437 (nth 0 (auth-source-user-or-password 461 ;; cache the search result in `found'
438 '("login" "password") 462 (or found
439 ;; this is "host" in auth-sources 463 (setq found (nth 0 (apply 'auth-source-search
440 (if (boundp 'server) (symbol-value 'server) "") 464 search))))
441 type)))) 465 :user)))
442 user-auth) 466 user-auth)
443 ((and 467 ((and
444 (eq keyword :password) 468 (eq keyword :password)
445 (setq pass-auth 469 (setq pass-auth (plist-get
446 (nth 1 470 ;; cache the search result in `found'
447 (auth-source-user-or-password 471 (or found
448 '("login" "password") 472 (setq found (nth 0 (apply 'auth-source-search
449 ;; this is "host" in auth-sources 473 search))))
450 (if (boundp 'server) (symbol-value 'server) "") 474 :secret)))
451 type)))) 475 ;; maybe set the password to the return of the :secret function
452 pass-auth) 476 (if (functionp pass-auth)
453 (t (if (setq value (plist-get source keyword)) 477 (setq pass-auth (funcall pass-auth))
454 (mail-source-value value) 478 pass-auth))
455 (mail-source-value (cadr default))))))))) 479 (t (if (setq value (plist-get source keyword))
480 (mail-source-value value)
481 (mail-source-value (cadr default)))))))))
456 482
457(eval-and-compile 483(eval-and-compile
458 (defun mail-source-bind-common-1 () 484 (defun mail-source-bind-common-1 ()
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index a6fe6b1489b..94c8f82f507 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -47,8 +47,8 @@
47(require 'nnmail) 47(require 'nnmail)
48(require 'proto-stream) 48(require 'proto-stream)
49 49
50(autoload 'auth-source-forget-user-or-password "auth-source") 50(autoload 'auth-source-forget+ "auth-source")
51(autoload 'auth-source-user-or-password "auth-source") 51(autoload 'auth-source-search "auth-source")
52 52
53(nnoo-declare nnimap) 53(nnoo-declare nnimap)
54 54
@@ -275,18 +275,18 @@ textual parts.")
275 (current-buffer))) 275 (current-buffer)))
276 276
277(defun nnimap-credentials (address ports &optional inhibit-create) 277(defun nnimap-credentials (address ports &optional inhibit-create)
278 (let (port credentials) 278 (let* ((found (nth 0 (auth-source-search :max 1
279 ;; Request the credentials from all ports, but only query on the 279 :host address
280 ;; last port if all the previous ones have failed. 280 :port ports
281 (while (and (null credentials) 281 :create (if inhibit-create
282 (setq port (pop ports))) 282 nil
283 (setq credentials 283 (null ports)))))
284 (auth-source-user-or-password 284 (user (plist-get found :user))
285 '("login" "password") address port nil 285 (secret (plist-get found :secret))
286 (if inhibit-create 286 (secret (if (functionp secret) (funcall secret) secret)))
287 nil 287 (if found
288 (null ports))))) 288 (list user secret)
289 credentials)) 289 nil)))
290 290
291(defun nnimap-keepalive () 291(defun nnimap-keepalive ()
292 (let ((now (current-time))) 292 (let ((now (current-time)))
@@ -381,14 +381,13 @@ textual parts.")
381 (if (eq nnimap-authenticator 'anonymous) 381 (if (eq nnimap-authenticator 'anonymous)
382 (list "anonymous" 382 (list "anonymous"
383 (message-make-address)) 383 (message-make-address))
384 (or 384 ;; Look for the credentials based on
385 ;; First look for the credentials based 385 ;; the virtual server name and the address
386 ;; on the virtual server name. 386 (nnimap-credentials
387 (nnimap-credentials 387 (list
388 (nnoo-current-server 'nnimap) ports t) 388 (nnoo-current-server 'nnimap)
389 ;; Then look them up based on the 389 nnimap-address)
390 ;; physical address. 390 ports t))))
391 (nnimap-credentials nnimap-address ports)))))
392 (setq nnimap-object nil) 391 (setq nnimap-object nil)
393 (setq login-result 392 (setq login-result
394 (nnimap-login (car credentials) (cadr credentials))) 393 (nnimap-login (car credentials) (cadr credentials)))
@@ -398,9 +397,7 @@ textual parts.")
398 (dolist (host (list (nnoo-current-server 'nnimap) 397 (dolist (host (list (nnoo-current-server 'nnimap)
399 nnimap-address)) 398 nnimap-address))
400 (dolist (port ports) 399 (dolist (port ports)
401 (dolist (element '("login" "password")) 400 (auth-source-forget+ :host host :protocol port)))
402 (auth-source-forget-user-or-password
403 element host port))))
404 (delete-process (nnimap-process nnimap-object)) 401 (delete-process (nnimap-process nnimap-object))
405 (setq nnimap-object nil)))) 402 (setq nnimap-object nil))))
406 (when nnimap-object 403 (when nnimap-object
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index eb2dd004638..4b42637978e 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -40,7 +40,7 @@
40 40
41(eval-when-compile (require 'cl)) 41(eval-when-compile (require 'cl))
42 42
43(autoload 'auth-source-user-or-password "auth-source") 43(autoload 'auth-source-search "auth-source")
44 44
45(defgroup nntp nil 45(defgroup nntp nil
46 "NNTP access for Gnus." 46 "NNTP access for Gnus."
@@ -1231,10 +1231,16 @@ If SEND-IF-FORCE, only send authinfo to the server if the
1231 (let* ((list (netrc-parse nntp-authinfo-file)) 1231 (let* ((list (netrc-parse nntp-authinfo-file))
1232 (alist (netrc-machine list nntp-address "nntp")) 1232 (alist (netrc-machine list nntp-address "nntp"))
1233 (force (or (netrc-get alist "force") nntp-authinfo-force)) 1233 (force (or (netrc-get alist "force") nntp-authinfo-force))
1234 (auth-info 1234 (auth-info
1235 (auth-source-user-or-password '("login" "password") nntp-address "nntp")) 1235 (nth 0 (auth-source-search :max 1
1236 (auth-user (nth 0 auth-info)) 1236 ;; TODO: allow the virtual server name too
1237 (auth-passwd (nth 1 auth-info)) 1237 :host nntp-address
1238 :port '("119" "nntp"))))
1239 (auth-user (plist-get auth-info :user))
1240 (auth-passwd (plist-get auth-info :secret))
1241 (auth-passwd (if (functionp auth-passwd)
1242 (funcall auth-passwd)
1243 auth-passwd))
1238 (user (or 1244 (user (or
1239 ;; this is preferred to netrc-* 1245 ;; this is preferred to netrc-*
1240 auth-user 1246 auth-user
diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el
index d115f40528b..c9a0df20590 100644
--- a/lisp/gnus/sieve-manage.el
+++ b/lisp/gnus/sieve-manage.el
@@ -83,7 +83,7 @@
83 (require 'starttls)) 83 (require 'starttls))
84(autoload 'sasl-find-mechanism "sasl") 84(autoload 'sasl-find-mechanism "sasl")
85(autoload 'starttls-open-stream "starttls") 85(autoload 'starttls-open-stream "starttls")
86(autoload 'auth-source-user-or-password "auth-source") 86(autoload 'auth-source-search "auth-source")
87 87
88;; User customizable variables: 88;; User customizable variables:
89 89
@@ -273,16 +273,20 @@ Valid states are `closed', `initial', `nonauth', and `auth'.")
273 "Login to server using the SASL MECH method." 273 "Login to server using the SASL MECH method."
274 (message "sieve: Authenticating using %s..." mech) 274 (message "sieve: Authenticating using %s..." mech)
275 (with-current-buffer buffer 275 (with-current-buffer buffer
276 (let* ((user-password (auth-source-user-or-password 276 (let* ((auth-info (auth-source-search :host sieve-manage-server
277 '("login" "password") 277 :port "sieve"
278 sieve-manage-server 278 :max 1))
279 "sieve" nil t)) 279 (user-name (plist-get (nth 0 auth-info) :user))
280 (user-password (plist-get (nth 0 auth-info) :secret))
281 (user-password (if (functionp user-password)
282 (funcall user-password)
283 user-password))
280 (client (sasl-make-client (sasl-find-mechanism (list mech)) 284 (client (sasl-make-client (sasl-find-mechanism (list mech))
281 (car user-password) "sieve" sieve-manage-server)) 285 user-name "sieve" sieve-manage-server))
282 (sasl-read-passphrase 286 (sasl-read-passphrase
283 ;; We *need* to copy the password, because sasl will modify it 287 ;; We *need* to copy the password, because sasl will modify it
284 ;; somehow. 288 ;; somehow.
285 `(lambda (prompt) ,(copy-sequence (cadr user-password)))) 289 `(lambda (prompt) ,(copy-sequence user-password)))
286 (step (sasl-next-step client nil)) 290 (step (sasl-next-step client nil))
287 (tag (sieve-manage-send 291 (tag (sieve-manage-send
288 (concat 292 (concat
diff --git a/lisp/password-cache.el b/lisp/password-cache.el
index fcae55ad597..8738aa65a9f 100644
--- a/lisp/password-cache.el
+++ b/lisp/password-cache.el
@@ -111,9 +111,10 @@ that a password is invalid, so that `password-read' query the
111user again." 111user again."
112 (let ((password (symbol-value (intern-soft key password-data)))) 112 (let ((password (symbol-value (intern-soft key password-data))))
113 (when password 113 (when password
114 (if (fboundp 'clear-string) 114 (when (stringp password)
115 (clear-string password) 115 (if (fboundp 'clear-string)
116 (fillarray password ?_)) 116 (clear-string password)
117 (fillarray password ?_)))
117 (unintern key password-data)))) 118 (unintern key password-data))))
118 119
119(defun password-cache-add (key password) 120(defun password-cache-add (key password)