diff options
| author | Gnus developers | 2011-02-13 00:25:29 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2011-02-13 00:25:29 +0000 |
| commit | b8e0f0cd20799c025cf4d353c6b1ee74b3c44aad (patch) | |
| tree | 6c2440a24a4e1d4c7bee75c076b3de3baee560f5 | |
| parent | e730aabed55f3b65020672f1d58afc55fda4eef2 (diff) | |
| download | emacs-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/ChangeLog | 5 | ||||
| -rw-r--r-- | doc/misc/auth.texi | 147 | ||||
| -rw-r--r-- | lisp/ChangeLog | 5 | ||||
| -rw-r--r-- | lisp/gnus/ChangeLog | 101 | ||||
| -rw-r--r-- | lisp/gnus/auth-source.el | 1232 | ||||
| -rw-r--r-- | lisp/gnus/mail-source.el | 88 | ||||
| -rw-r--r-- | lisp/gnus/nnimap.el | 47 | ||||
| -rw-r--r-- | lisp/gnus/nntp.el | 16 | ||||
| -rw-r--r-- | lisp/gnus/sieve-manage.el | 18 | ||||
| -rw-r--r-- | lisp/password-cache.el | 7 |
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 | ||
| 9 | 2011-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 | |||
| 9 | 2011-02-09 Paul Eggert <eggert@cs.ucla.edu> | 14 | 2011-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 |
| 11 | This file describes the Emacs auth-source library. | 11 | This 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 | ||
| 80 | The auth-source library is simply a way for Emacs and Gnus, among | 80 | The auth-source library is simply a way for Emacs and Gnus, among |
| 81 | others, to answer the old burning question ``I have a server name and | 81 | others, to answer the old burning question ``What are my user name and |
| 82 | a port, what are my user name and password?'' | 82 | password?'' |
| 83 | 83 | ||
| 84 | The 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 | 85 | fire extinguisher, please?''.) |
| 86 | today in Emacs or Gnus. Similarly, the auth-source library supports | 86 | |
| 87 | multiple storage formats, currently either the classic ``netrc'' | 87 | The auth-source library supports more than just the user name or the |
| 88 | format, examples of which you can see later in this document, or the | 88 | password (known as the secret). |
| 89 | Secret Service API. | 89 | |
| 90 | Similarly, the auth-source library supports multiple storage backend, | ||
| 91 | currently either the classic ``netrc'' backend, examples of which you | ||
| 92 | can see later in this document, or the Secret Service API. This is | ||
| 93 | done 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. | |||
| 96 | machine @var{mymachine} login @var{myloginname} password @var{mypassword} port @var{myport} | 100 | machine @var{mymachine} login @var{myloginname} password @var{mypassword} port @var{myport} |
| 97 | @end example | 101 | @end example |
| 98 | 102 | ||
| 99 | The machine is the server (either a DNS name or an IP address). | 103 | The @code{machine} is the server (either a DNS name or an IP address). |
| 104 | It's known as @var{:host} in @code{auth-source-search} queries. You | ||
| 105 | can also use @code{host}. | ||
| 106 | |||
| 107 | The @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 | |||
| 111 | The @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 | |||
| 115 | Spaces are always OK as far as auth-source is concerned (but other | ||
| 116 | programs may not like them). Just put the data in quotes, escaping | ||
| 117 | quotes as you'd expect with @code{\}. | ||
| 118 | |||
| 119 | All these are optional. You could just say (but we don't recommend | ||
| 120 | it, we're just showing that it's possible) | ||
| 100 | 121 | ||
| 101 | The port is optional. If it's missing, auth-source will assume any | 122 | @example |
| 102 | port is OK. Actually the port is a protocol name or a port number so | 123 | password @var{mypassword} |
| 103 | you 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 | ||
| 105 | you don't need it. | ||
| 106 | 125 | ||
| 107 | The login and password are simply your login credentials to the server. | 126 | to use the same password everywhere. Again, @emph{DO NOT DO THIS} or |
| 127 | you 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}; |
| 110 | nowadays @code{.authinfo} seems to be more popular and the auth-source | 130 | nowadays @code{.authinfo} seems to be more popular and the auth-source |
| 111 | library encourages this confusion by making it the default, as you'll | 131 | library encourages this confusion by making it the default, as you'll |
| 112 | see later. | 132 | see later. |
| 113 | 133 | ||
| 114 | If you have problems with the port, set @code{auth-source-debug} to | 134 | If 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 | 136 | the @code{*Messages*} buffer. Ditto for any other problems, your |
| 117 | step is always to see what's being checked. The second step, of | 137 | first step is always to see what's being checked. The second step, of |
| 118 | course, is to write a blog entry about it and wait for the answer in | 138 | course, is to write a blog entry about it and wait for the answer in |
| 119 | the comments. | 139 | the 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 | ||
| 144 | This says ``for any host and any protocol, use just that one file.'' | ||
| 145 | Sweet simplicity. In fact, the latter is already the default, so | ||
| 146 | unless you want to move your netrc file, it will just work if you have | ||
| 147 | that file. Make sure it exists. | ||
| 148 | |||
| 149 | By adding multiple entries to @code{auth-sources} with a particular | 168 | By adding multiple entries to @code{auth-sources} with a particular |
| 150 | host or protocol, you can have specific netrc files for that host or | 169 | host or protocol, you can have specific netrc files for that host or |
| 151 | protocol. Usually this is unnecessary but may make sense if you have | 170 | protocol. Usually this is unnecessary but may make sense if you have |
| 152 | shared netrc files or some other unusual setup (90% of Emacs users | 171 | shared netrc files or some other unusual setup (90% of Emacs users |
| 153 | have unusual setups and the remaining 10% are @emph{really} unusual). | 172 | have unusual setups and the remaining 10% are @emph{really} unusual). |
| 154 | 173 | ||
| 155 | Here's an example that uses the Secret Service API for all lookups, | 174 | Here's a mixed example using two sources: |
| 156 | using the default collection: | ||
| 157 | |||
| 158 | @lisp | ||
| 159 | (setq auth-sources '((:source (:secrets default)))) | ||
| 160 | @end lisp | ||
| 161 | |||
| 162 | And 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 | ||
| 169 | The best match is determined by order (starts from the bottom) only | ||
| 170 | for the first pass, where things are checked exactly. In the example | ||
| 171 | above, the first pass would find a single match for host | ||
| 172 | @code{myserver}. The netrc choice would fail because it matches any | ||
| 173 | host and protocol implicitly (as a @emph{fallback}). A specified | ||
| 174 | value of @code{:host t} in @code{auth-sources} is considered a match | ||
| 175 | on the first pass, unlike a missing @code{:host}. | ||
| 176 | |||
| 177 | Now if you look for host @code{missing}, it won't match either source | ||
| 178 | explicitly. The second pass (the @emph{fallback} pass) will look at | ||
| 179 | all the implicit matches and collect them. They will be scored and | ||
| 180 | returned sorted by score. The score is based on the number of | ||
| 181 | explicit parameters that matched. See the @code{auth-pick} function | ||
| 182 | for details. | ||
| 183 | |||
| 184 | @end defvar | 181 | @end defvar |
| 185 | 182 | ||
| 186 | If you don't customize @code{auth-sources}, you'll have to live with | 183 | If you don't customize @code{auth-sources}, you'll have to live with |
| 187 | the defaults: any host and any port are looked up in the netrc | 184 | the defaults: any host and any port are looked up in the netrc |
| 188 | file @code{~/.authinfo.gpg}, which is a GnuPG encrypted file | 185 | file @code{~/.authinfo.gpg}, which is a GnuPG encrypted file |
| 189 | (@pxref{GnuPG and EasyPG Assistant Configuration}). | 186 | (@pxref{GnuPG and EasyPG Assistant Configuration}). |
| 187 | |||
| 188 | If that fails, the unencrypted netrc file @code{~/.authinfo} will | ||
| 189 | be used. | ||
| 190 | 190 | ||
| 191 | The simplest working netrc line example is one without a port. | 191 | The typical netrc line example is without a port. |
| 192 | 192 | ||
| 193 | @example | 193 | @example |
| 194 | machine YOURMACHINE login YOU password YOURPASSWORD | 194 | machine 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 | ||
| 236 | The auth-source library only has one function for external use. | 236 | The 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 | ||
| 240 | Retrieve appropriate authentication tokens, determined by @var{mode}, | 240 | TODO: how to include docstring? |
| 241 | for host @var{host} and @var{port}. If @var{username} is provided it | ||
| 242 | will also be checked. If @code{auth-source-debug} is t, debugging | ||
| 243 | messages will be printed. Set @code{auth-source-debug} to a function | ||
| 244 | to use that function for logging. The parameters passed will be the | ||
| 245 | same that the @code{message} function takes, that is, a string | ||
| 246 | formatting spec and optional parameters. | ||
| 247 | 241 | ||
| 248 | If @var{mode} is a list of strings, the function will return a list of | 242 | @end defun |
| 249 | strings or @code{nil} objects (thus you can avoid parsing the netrc | ||
| 250 | file or checking the Secret Service API more than once). If it's a | ||
| 251 | string, the function will return a string or a @code{nil} object. | ||
| 252 | Currently only the modes ``login'' and ``password'' are recognized but | ||
| 253 | more 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 | 246 | TODO: how to include docstring? |
| 258 | a port number. It must be a string, corresponding to the port in the | ||
| 259 | users' 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 | 252 | TODO: 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 | 258 | TODO: 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 | ||
| 194 | 2011-02-09 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 195 | |||
| 196 | * password-cache.el (password-cache-remove): Accept secrets that are | ||
| 197 | not strings. | ||
| 198 | |||
| 194 | 2011-02-09 Stefan Monnier <monnier@iro.umontreal.ca> | 199 | 2011-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 | ||
| 10 | 2011-02-10 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 11 | |||
| 12 | * sieve-manage.el: Autoload `auth-source-search'. | ||
| 13 | (sieve-sasl-auth): Use it. | ||
| 14 | |||
| 15 | 2011-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 | |||
| 10 | 2011-02-09 Lars Ingebrigtsen <larsi@gnus.org> | 34 | 2011-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 | ||
| 44 | 2011-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 | |||
| 20 | 2011-02-08 Julien Danjou <julien@danjou.info> | 60 | 2011-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 | ||
| 67 | 2011-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 | |||
| 27 | 2011-02-07 Lars Ingebrigtsen <larsi@gnus.org> | 74 | 2011-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 | ||
| 85 | 2011-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 | |||
| 38 | 2011-02-06 Lars Ingebrigtsen <larsi@gnus.org> | 92 | 2011-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 | ||
| 99 | 2011-02-06 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 100 | |||
| 101 | * auth-source.el (auth-source-secrets-search): Add examples. | ||
| 102 | |||
| 45 | 2011-02-06 Julien Danjou <julien@danjou.info> | 103 | 2011-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 | ||
| 108 | 2011-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 | |||
| 128 | 2011-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 | |||
| 50 | 2011-02-04 Lars Ingebrigtsen <larsi@gnus.org> | 151 | 2011-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. | ||
| 113 | Only 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 | ||
| 122 | The default will get login and password information from a .gpg | 159 | The default will get login and password information from |
| 123 | file, which you should set up with the EPA/EPG packages to be | 160 | \"~/.authinfo.gpg\", which you should set up with the EPA/EPG |
| 124 | encrypted. See the auth.info manual for details. | 161 | packages to be encrypted. If that file doesn't exist, it will |
| 162 | try the unencrypted version \"~/.authinfo\". | ||
| 163 | |||
| 164 | See the auth.info manual for details. | ||
| 125 | 165 | ||
| 126 | Each entry is the authentication type with optional properties. | 166 | Each entry is the authentication type with optional properties. |
| 127 | 167 | ||
| 128 | It's best to customize this with `M-x customize-variable' because the choices | 168 | It's best to customize this with `M-x customize-variable' because the choices |
| 129 | can get pretty complex." | 169 | can 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. |
| 164 | If the value is not a list, symmetric encryption will be used." | 215 | If 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) |
| 216 | If it is a Secret Service API, return the collection name, otherwise | 267 | ;; (auth-source-backend-parse "secrets:login") |
| 217 | the 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)) | |
| 230 | Common keys are :host, :protocol, and :user. A value of t in | 281 | (auth-source-backend-parse `(:source (:secrets ,(match-string 1 entry))))) |
| 231 | SPEC 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 |
| 232 | matched 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) | 333 | Using the plist ENTRY, get the :host, :protocol, and :user search |
| 283 | (string-equal | 334 | parameters. Accepts :port as an alias to :protocol. Sets all |
| 284 | prot (secrets-get-attribute coll elt :protocol)))) | 335 | the 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)))) | 354 | This function parses `auth-sources' for matches of the SPEC |
| 304 | (setq result | 355 | plist. It can optionally create or update an authentication |
| 305 | (mapcar (lambda (m) | 356 | token if requested. A token is just a standard Emacs property |
| 306 | (if (string-equal "password" m) | 357 | list with a :secret property that can be a function; all the |
| 307 | (or (apply | 358 | other properties will always hold scalar values. |
| 308 | 'netrc-machine-user-or-password m search) | 359 | |
| 309 | ;; When we do not find a password, we | 360 | Typically the :secret property, if present, contains a password. |
| 310 | ;; return nil anyway. | 361 | |
| 311 | (throw 'no-password nil)) | 362 | Common search keys are :max, :host, :protocol, and :user. In |
| 312 | (or (apply | 363 | addition, :create specifies how tokens will be or created. |
| 313 | 'netrc-machine-user-or-password m search) | 364 | Finally, :type can specify which backend types you want to check. |
| 314 | user))) | 365 | |
| 315 | (if (consp mode) mode (list mode))))) | 366 | A string value is always matched literally. A symbol is matched |
| 316 | (if (consp mode) result (car result))))))) | 367 | as its string value, literally. All the SPEC values can be |
| 317 | 368 | single values (symbol or string) or lists thereof (in which case | |
| 318 | (defun auth-source-create (mode entry &rest spec) | 369 | any of the search terms matches). |
| 319 | "Create interactively credentials according to SPEC in ENTRY. | 370 | |
| 320 | Return 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)) | 373 | A new token will be created if no matching tokens were found. |
| 323 | (prot (plist-get spec :protocol)) | 374 | The new token will have only the keys the backend requires. For |
| 324 | (source (plist-get entry :source)) | 375 | the netrc backend, for instance, that's the user, host, and |
| 325 | (name (concat (if user (format "%s@" user)) | 376 | protocol keys. |
| 326 | host | 377 | |
| 327 | (if prot (format ":%s" prot)))) | 378 | Here'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) | 386 | which 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 | 400 | The behavior is like :create t but if the list contains any |
| 350 | (user-login-name)) | 401 | parameter, that parameter will be required in the resulting |
| 351 | nil nil (user-login-name)))) | 402 | token. The value for that parameter will be obtained from the |
| 352 | (t | 403 | search parameters or from user input. If any queries are needed, |
| 353 | "unknownuser")))) | 404 | the alist `auth-source-creation-defaults' will be checked for the |
| 354 | (if (consp mode) mode (list mode)))) | 405 | default prompt. |
| 355 | ;; Allow the source to save the data. | 406 | |
| 356 | (cond | 407 | Here'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 | 415 | which 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) | 429 | When multiple values are specified in the search parameter, the |
| 379 | (insert "\n")) | 430 | first 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" | 431 | token for host X, for instance. |
| 381 | host | 432 | |
| 382 | (or user (cdr (assoc "login" result))) | 433 | This creation can fail if the search was not specific enough to |
| 383 | (cdr (assoc "password" result)) | 434 | create a new token (it's up to the backend to decide that). You |
| 384 | prot)) | 435 | should `catch' the backend-specific error as usual. Some |
| 385 | (write-region (point-min) (point-max) source nil 'silent))))) | 436 | backends (netrc, at least) will prompt the user rather than throw |
| 386 | (if (consp mode) | 437 | an error. |
| 387 | (mapcar #'cdr result) | 438 | |
| 388 | (cdar result)))) | 439 | :delete t means to delete any found entries. nil by default. |
| 389 | 440 | Use `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 | 447 | When 0 the function will return just t or nil to indicate if any |
| 397 | ;; Secret Service API. | 448 | matches were found. More than N items may be returned, depending |
| 398 | ((consp source) | 449 | on 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)) | 452 | the 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))) | 455 | the 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)))) | 458 | Defaults 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 | 461 | V3 (note the match rules above). | |
| 411 | (defun auth-source-forget-user-or-password | 462 | |
| 412 | (mode host protocol &optional username) | 463 | The return value is a list with at most :max tokens. Each token |
| 413 | "Remove cached authentication token." | 464 | is a plist with keys :backend :host :protocol :user, plus any other |
| 414 | (interactive "slogin/password: \nsHost: \nsProtocol: \n") ;for testing | 465 | keys provided by the backend (notably :secret). But note the |
| 415 | (remhash | 466 | exception for :max 0, which see above. |
| 416 | (if username | 467 | |
| 417 | (format "%s %s:%s %s" mode host protocol username) | 468 | The token's :secret key can hold a function. In that case you |
| 418 | (format "%s %s:%s" mode host protocol)) | 469 | must 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. | ||
| 548 | Calls `auth-source-search' with the :delete property in SPEC set to t. | ||
| 549 | The backend may not actually delete the entries. | ||
| 550 | |||
| 551 | Returns 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 | |||
| 588 | This is the same SPEC you passed to `auth-source-search'. | ||
| 589 | Returns 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 | |||
| 603 | This is not a full `auth-source-search' spec but works similarly. | ||
| 604 | For instance, \(:host \"myhost\" \"yourhost\") would find all the | ||
| 605 | cached data that was found with a search for those two hosts, | ||
| 606 | while \(: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. | ||
| 640 | Note 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. | ||
| 779 | See `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 | |||
| 949 | The :label key specifies the item's label. It is the only key | ||
| 950 | that can specify a substring. Any :label value besides a string | ||
| 951 | will allow any label. | ||
| 952 | |||
| 953 | All other search keys must match exactly. If you need substring | ||
| 954 | matching, do a wider search and narrow it down yourself. | ||
| 955 | |||
| 956 | You'll get back all the properties of the token as a plist. | ||
| 957 | |||
| 958 | Here's an example that looks for the first item in the 'login' | ||
| 959 | Secrets collection: | ||
| 960 | |||
| 961 | \(let ((auth-sources '(\"secrets:login\"))) | ||
| 962 | (auth-source-search :max 1) | ||
| 963 | |||
| 964 | Here's another that looks for the first item in the 'login' | ||
| 965 | Secrets collection whose label contains 'gnus': | ||
| 966 | |||
| 967 | \(let ((auth-sources '(\"secrets:login\"))) | ||
| 968 | (auth-source-search :max 1 :label \"gnus\") | ||
| 969 | |||
| 970 | And this one looks for the first item in the 'login' Secrets | ||
| 971 | collection that's a Google Chrome entry for the git.gnus.org site | ||
| 972 | login: | ||
| 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 | ||
| 1056 | DEPRECATED in favor of `auth-source-search'! | ||
| 1057 | |||
| 437 | USERNAME is optional and will be used as \"login\" in a search | 1058 | USERNAME is optional and will be used as \"login\" in a search |
| 438 | across the Secret Service API (see secrets.el) if the resulting | 1059 | across the Secret Service API (see secrets.el) if the resulting |
| 439 | items don't have a username. This means that if you search for | 1060 | items 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 | ||
| 453 | MODE can be \"login\" or \"password\"." | 1074 | MODE 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 | |||
| 111 | user again." | 111 | user 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) |