[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r103246: Merge changes made in Gnus t
|
From: |
Katsumi Yamaoka |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r103246: Merge changes made in Gnus trunk. |
|
Date: |
Sun, 13 Feb 2011 00:25:29 +0000 |
|
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 103246
author: Gnus developers <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Sun 2011-02-13 00:25:29 +0000
message:
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.
modified:
doc/misc/ChangeLog
doc/misc/auth.texi
lisp/ChangeLog
lisp/gnus/ChangeLog
lisp/gnus/auth-source.el
lisp/gnus/mail-source.el
lisp/gnus/nnimap.el
lisp/gnus/nntp.el
lisp/gnus/sieve-manage.el
lisp/password-cache.el
=== modified file 'doc/misc/ChangeLog'
--- a/doc/misc/ChangeLog 2011-02-12 23:40:43 +0000
+++ b/doc/misc/ChangeLog 2011-02-13 00:25:29 +0000
@@ -6,6 +6,11 @@
* url.texi: Remove duplicate @dircategory (Bug#7942).
+2011-02-11 Teodor Zlatanov <address@hidden>
+
+ * auth.texi (Overview, Help for users, Help for developers): Update
docs.
+ (Help for users): Talk about spaces.
+
2011-02-09 Paul Eggert <address@hidden>
* texinfo.tex: Update to version 2011-02-07.16.
=== modified file 'doc/misc/auth.texi'
--- a/doc/misc/auth.texi 2011-02-06 00:25:41 +0000
+++ b/doc/misc/auth.texi 2011-02-13 00:25:29 +0000
@@ -5,7 +5,7 @@
@setfilename ../../info/auth
@settitle Emacs auth-source Library @value{VERSION}
address@hidden VERSION 0.2
address@hidden VERSION 0.3
@copying
This file describes the Emacs auth-source library.
@@ -78,15 +78,19 @@
@chapter Overview
The auth-source library is simply a way for Emacs and Gnus, among
-others, to answer the old burning question ``I have a server name and
-a port, what are my user name and password?''
-
-The auth-source library actually supports more than just the user name
-(known as the login) or the password, but only those two are in use
-today in Emacs or Gnus. Similarly, the auth-source library supports
-multiple storage formats, currently either the classic ``netrc''
-format, examples of which you can see later in this document, or the
-Secret Service API.
+others, to answer the old burning question ``What are my user name and
+password?''
+
+(This is different from the old question about burning ``Where is the
+fire extinguisher, please?''.)
+
+The auth-source library supports more than just the user name or the
+password (known as the secret).
+
+Similarly, the auth-source library supports multiple storage backend,
+currently either the classic ``netrc'' backend, examples of which you
+can see later in this document, or the Secret Service API. This is
+done with EIEIO-based backends and you can write your own if you want.
@node Help for users
@chapter Help for users
@@ -96,25 +100,41 @@
machine @var{mymachine} login @var{myloginname} password @var{mypassword} port
@var{myport}
@end example
-The machine is the server (either a DNS name or an IP address).
-
-The port is optional. If it's missing, auth-source will assume any
-port is OK. Actually the port is a protocol name or a port number so
-you can have separate entries for port @var{143} and for protocol
address@hidden if you fancy that. Anyway, you can just omit the port if
-you don't need it.
-
-The login and password are simply your login credentials to the server.
+The @code{machine} is the server (either a DNS name or an IP address).
+It's known as @var{:host} in @code{auth-source-search} queries. You
+can also use @code{host}.
+
+The @code{port} is the connection port or protocol. It's known as
address@hidden:port} in @code{auth-source-search} queries. You can also use
address@hidden
+
+The @code{user} is the user name. It's known as @var{:user} in
address@hidden queries. You can also use @code{login} and
address@hidden
+
+Spaces are always OK as far as auth-source is concerned (but other
+programs may not like them). Just put the data in quotes, escaping
+quotes as you'd expect with @code{\}.
+
+All these are optional. You could just say (but we don't recommend
+it, we're just showing that it's possible)
+
address@hidden
+password @var{mypassword}
address@hidden example
+
+to use the same password everywhere. Again, @emph{DO NOT DO THIS} or
+you will be pwned as the kids say.
``Netrc'' files are usually called @code{.authinfo} or @code{.netrc};
nowadays @code{.authinfo} seems to be more popular and the auth-source
library encourages this confusion by making it the default, as you'll
see later.
-If you have problems with the port, set @code{auth-source-debug} to
address@hidden and see what port the library is checking in the
address@hidden buffer. Ditto for any other problems, your first
-step is always to see what's being checked. The second step, of
+If you have problems with the search, set @code{auth-source-debug} to
address@hidden and see what host, port, and user the library is checking in
+the @code{*Messages*} buffer. Ditto for any other problems, your
+first step is always to see what's being checked. The second step, of
course, is to write a blog entry about it and wait for the answer in
the comments.
@@ -139,56 +159,36 @@
(setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t)))
;;; mostly equivalent (see below about fallbacks) but shorter:
(setq auth-sources '((:source "~/.authinfo.gpg")))
+;;; even shorter and the @emph{default}:
+(setq auth-sources '("~/.authinfo.gpg" "~/.authinfo"))
+;;; use the Secrets API @var{login} collection (@pxref{Secret Service API})
+(setq auth-sources '("secrets:login"))
@end lisp
-This says ``for any host and any protocol, use just that one file.''
-Sweet simplicity. In fact, the latter is already the default, so
-unless you want to move your netrc file, it will just work if you have
-that file. Make sure it exists.
-
By adding multiple entries to @code{auth-sources} with a particular
host or protocol, you can have specific netrc files for that host or
protocol. Usually this is unnecessary but may make sense if you have
shared netrc files or some other unusual setup (90% of Emacs users
have unusual setups and the remaining 10% are @emph{really} unusual).
-Here's an example that uses the Secret Service API for all lookups,
-using the default collection:
-
address@hidden
-(setq auth-sources '((:source (:secrets default))))
address@hidden lisp
-
-And here's a mixed example, using two sources:
+Here's a mixed example using two sources:
@lisp
(setq auth-sources '((:source (:secrets default) :host "myserver" :user "joe")
- (:source "~/.authinfo.gpg")))
+ "~/.authinfo.gpg"))
@end lisp
-The best match is determined by order (starts from the bottom) only
-for the first pass, where things are checked exactly. In the example
-above, the first pass would find a single match for host
address@hidden The netrc choice would fail because it matches any
-host and protocol implicitly (as a @emph{fallback}). A specified
-value of @code{:host t} in @code{auth-sources} is considered a match
-on the first pass, unlike a missing @code{:host}.
-
-Now if you look for host @code{missing}, it won't match either source
-explicitly. The second pass (the @emph{fallback} pass) will look at
-all the implicit matches and collect them. They will be scored and
-returned sorted by score. The score is based on the number of
-explicit parameters that matched. See the @code{auth-pick} function
-for details.
-
@end defvar
If you don't customize @code{auth-sources}, you'll have to live with
the defaults: any host and any port are looked up in the netrc
file @code{~/.authinfo.gpg}, which is a GnuPG encrypted file
-(@pxref{GnuPG and EasyPG Assistant Configuration}).
-
-The simplest working netrc line example is one without a port.
+(@pxref{GnuPG and EasyPG Assistant Configuration}).
+
+If that fails, the unencrypted netrc file @code{~/.authinfo} will
+be used.
+
+The typical netrc line example is without a port.
@example
machine YOURMACHINE login YOU password YOURPASSWORD
@@ -233,42 +233,29 @@
@node Help for developers
@chapter Help for developers
-The auth-source library only has one function for external use.
-
address@hidden auth-source-user-or-password mode host port &optional username
-
-Retrieve appropriate authentication tokens, determined by @var{mode},
-for host @var{host} and @var{port}. If @var{username} is provided it
-will also be checked. If @code{auth-source-debug} is t, debugging
-messages will be printed. Set @code{auth-source-debug} to a function
-to use that function for logging. The parameters passed will be the
-same that the @code{message} function takes, that is, a string
-formatting spec and optional parameters.
-
-If @var{mode} is a list of strings, the function will return a list of
-strings or @code{nil} objects (thus you can avoid parsing the netrc
-file or checking the Secret Service API more than once). If it's a
-string, the function will return a string or a @code{nil} object.
-Currently only the modes ``login'' and ``password'' are recognized but
-more may be added in the future.
-
address@hidden is a string containing the host name.
-
address@hidden contains the protocol name (e.g. ``imap'') or
-a port number. It must be a string, corresponding to the port in the
-users' netrc files.
-
address@hidden contains the user name (e.g. ``joe'') as a string.
-
address@hidden
-;; IMAP example
-(setq auth (auth-source-user-or-password
- '("login" "password")
- "anyhostnamehere"
- "imap"))
-(nth 0 auth) ; the login name
-(nth 1 auth) ; the password
address@hidden example
+The auth-source library only has a few functions for external use.
+
address@hidden auth-source-search SPEC
+
+TODO: how to include docstring?
+
address@hidden defun
+
address@hidden auth-source-delete SPEC
+
+TODO: how to include docstring?
+
address@hidden defun
+
address@hidden auth-source-forget SPEC
+
+TODO: how to include docstring?
+
address@hidden defun
+
address@hidden auth-source-forget+ SPEC
+
+TODO: how to include docstring?
@end defun
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2011-02-12 23:40:43 +0000
+++ b/lisp/ChangeLog 2011-02-13 00:25:29 +0000
@@ -191,6 +191,11 @@
(allout-after-copy-or-kill-hook): No arguments - hook implementers
should concentrate on the kill ring.
+2011-02-09 Teodor Zlatanov <address@hidden>
+
+ * password-cache.el (password-cache-remove): Accept secrets that are
+ not strings.
+
2011-02-09 Stefan Monnier <address@hidden>
* progmodes/sh-script.el (sh-font-lock-open-heredoc): Fix case
=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog 2011-02-10 22:43:21 +0000
+++ b/lisp/gnus/ChangeLog 2011-02-13 00:25:29 +0000
@@ -7,6 +7,30 @@
* gnus-sum.el (gnus-summary-save-parts): Use read-directory-name.
+2011-02-10 Teodor Zlatanov <address@hidden>
+
+ * sieve-manage.el: Autoload `auth-source-search'.
+ (sieve-sasl-auth): Use it.
+
+2011-02-09 Teodor Zlatanov <address@hidden>
+
+ * 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.
+
2011-02-09 Lars Ingebrigtsen <address@hidden>
* nntp.el (nntp-retrieve-group-data-early-disabled): Disable the async
@@ -17,6 +41,22 @@
* message.el (message-options): Make message-options really buffer
local.
+2011-02-08 Teodor Zlatanov <address@hidden>
+
+ * 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.
+
2011-02-08 Julien Danjou <address@hidden>
* shr.el (shr-tag-body): Add support for text attribute in body
@@ -24,6 +64,13 @@
* message.el (message-options): Make message-options a local variable.
+2011-02-07 Teodor Zlatanov <address@hidden>
+
+ * 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.
+
2011-02-07 Lars Ingebrigtsen <address@hidden>
* nnimap.el (nnimap-update-info): Refactor slightly.
@@ -35,6 +82,13 @@
(nnimap-update-info): Fix macrology bug-out.
(nnimap-update-info): Simplify split history test.
+2011-02-06 Michael Albinus <address@hidden>
+
+ * 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.
+
2011-02-06 Lars Ingebrigtsen <address@hidden>
* nntp.el (nntp-finish-retrieve-group-infos): Protect against the first
@@ -42,11 +96,58 @@
* proto-stream.el (open-protocol-stream): Document the return value.
+2011-02-06 Teodor Zlatanov <address@hidden>
+
+ * auth-source.el (auth-source-secrets-search): Add examples.
+
2011-02-06 Julien Danjou <address@hidden>
* message.el (message-setup-1): Handle message-generate-headers-first
set to t.
+2011-02-06 Teodor Zlatanov <address@hidden>
+
+ * 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.
+
+2011-02-04 Teodor Zlatanov <address@hidden>
+
+ * 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.
+
2011-02-04 Lars Ingebrigtsen <address@hidden>
* message.el (message-setup-1): Remove the read-only stuff, since it
=== modified file 'lisp/gnus/auth-source.el'
--- a/lisp/gnus/auth-source.el 2011-01-25 04:08:28 +0000
+++ b/lisp/gnus/auth-source.el 2011-02-13 00:25:29 +0000
@@ -39,23 +39,64 @@
;;; Code:
+(require 'password-cache)
(require 'gnus-util)
(require 'netrc)
-
+(require 'assoc)
(eval-when-compile (require 'cl))
+(require 'eieio)
+
(autoload 'secrets-create-item "secrets")
(autoload 'secrets-delete-item "secrets")
(autoload 'secrets-get-alias "secrets")
-(autoload 'secrets-get-attribute "secrets")
+(autoload 'secrets-get-attributes "secrets")
(autoload 'secrets-get-secret "secrets")
(autoload 'secrets-list-collections "secrets")
(autoload 'secrets-search-items "secrets")
+(defvar secrets-enabled)
+
(defgroup auth-source nil
"Authentication sources."
:version "23.1" ;; No Gnus
:group 'gnus)
+(defclass auth-source-backend ()
+ ((type :initarg :type
+ :initform 'netrc
+ :type symbol
+ :custom symbol
+ :documentation "The backend type.")
+ (source :initarg :source
+ :type string
+ :custom string
+ :documentation "The backend source.")
+ (host :initarg :host
+ :initform t
+ :type t
+ :custom string
+ :documentation "The backend host.")
+ (user :initarg :user
+ :initform t
+ :type t
+ :custom string
+ :documentation "The backend user.")
+ (protocol :initarg :protocol
+ :initform t
+ :type t
+ :custom string
+ :documentation "The backend protocol.")
+ (create-function :initarg :create-function
+ :initform ignore
+ :type function
+ :custom function
+ :documentation "The create function.")
+ (search-function :initarg :search-function
+ :initform ignore
+ :type function
+ :custom function
+ :documentation "The search function.")))
+
(defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993")
(pop3 "pop3" "pop" "pop3s" "110" "995")
(ssh "ssh" "22")
@@ -81,11 +122,15 @@
p)))
auth-source-protocols))
-(defvar auth-source-cache (make-hash-table :test 'equal)
- "Cache for auth-source data")
+(defvar auth-source-creation-defaults nil
+ "Defaults for creating token values. Usually let-bound.")
+
+(make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1")
+
+(defvar auth-source-magic "auth-source-magic ")
(defcustom auth-source-do-cache t
- "Whether auth-source should cache information."
+ "Whether auth-source should cache information with `password-cache'."
:group 'auth-source
:version "23.2" ;; No Gnus
:type `boolean)
@@ -108,65 +153,71 @@
(function :tag "Function that takes arguments like `message'")
(const :tag "Don't log anything" nil)))
-(defcustom auth-source-hide-passwords t
- "Whether auth-source should hide passwords in log messages.
-Only relevant if `auth-source-debug' is not nil."
- :group 'auth-source
- :version "23.2" ;; No Gnus
- :type `boolean)
-
-(defcustom auth-sources '((:source "~/.authinfo.gpg")
- (:source "~/.authinfo"))
+(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo")
"List of authentication sources.
-The default will get login and password information from a .gpg
-file, which you should set up with the EPA/EPG packages to be
-encrypted. See the auth.info manual for details.
+The default will get login and password information from
+\"~/.authinfo.gpg\", which you should set up with the EPA/EPG
+packages to be encrypted. If that file doesn't exist, it will
+try the unencrypted version \"~/.authinfo\".
+
+See the auth.info manual for details.
Each entry is the authentication type with optional properties.
It's best to customize this with `M-x customize-variable' because the choices
can get pretty complex."
:group 'auth-source
- :version "23.2" ;; No Gnus
+ :version "24.1" ;; No Gnus
:type `(repeat :tag "Authentication Sources"
- (list :tag "Source definition"
- (const :format "" :value :source)
- (choice :tag "Authentication backend choice"
- (string :tag "Authentication Source (file)")
- (list :tag "secrets.el (Secret Service
API/KWallet/GNOME Keyring)"
- (const :format "" :value :secrets)
- (choice :tag "Collection to use"
- (string :tag "Collection name")
- (const :tag "Default" 'default)
- (const :tag "Login" "login")
- (const :tag "Temporary"
"session"))))
- (repeat :tag "Extra Parameters" :inline t
- (choice :tag "Extra parameter"
- (list :tag "Host (omit to match as a
fallback)"
- (const :format "" :value :host)
- (choice :tag "Host (machine)
choice"
- (const :tag "Any" t)
- (regexp :tag "Host
(machine) regular expression")))
- (list :tag "Protocol (omit to match as
a fallback)"
- (const :format "" :value
:protocol)
- (choice :tag "Protocol"
- (const :tag "Any" t)
-
,@auth-source-protocols-customize))
- (list :tag "User (omit to match as a
fallback)" :inline t
- (const :format "" :value :user)
- (choice :tag "Personality or
username"
- (const :tag "Any" t)
- (string :tag "Specific
user name"))))))))
+ (choice
+ (string :tag "Just a file")
+ (const :tag "Default Secrets API Collection" 'default)
+ (const :tag "Login Secrets API Collection" "secrets:login")
+ (const :tag "Temp Secrets API Collection" "secrets:session")
+ (list :tag "Source definition"
+ (const :format "" :value :source)
+ (choice :tag "Authentication backend choice"
+ (string :tag "Authentication Source (file)")
+ (list
+ :tag "Secret Service API/KWallet/GNOME
Keyring"
+ (const :format "" :value :secrets)
+ (choice :tag "Collection to use"
+ (string :tag "Collection name")
+ (const :tag "Default" 'default)
+ (const :tag "Login" "login")
+ (const
+ :tag "Temporary" "session"))))
+ (repeat :tag "Extra Parameters" :inline t
+ (choice :tag "Extra parameter"
+ (list
+ :tag "Host"
+ (const :format "" :value :host)
+ (choice :tag "Host (machine) choice"
+ (const :tag "Any" t)
+ (regexp
+ :tag "Regular expression")))
+ (list
+ :tag "Protocol"
+ (const :format "" :value :protocol)
+ (choice
+ :tag "Protocol"
+ (const :tag "Any" t)
+ ,@auth-source-protocols-customize))
+ (list :tag "User" :inline t
+ (const :format "" :value :user)
+ (choice :tag
"Personality/Username"
+ (const :tag "Any" t)
+ (string :tag
"Name")))))))))
(defcustom auth-source-gpg-encrypt-to t
"List of recipient keys that `authinfo.gpg' encrypted to.
If the value is not a list, symmetric encryption will be used."
:group 'auth-source
- :version "23.2" ;; No Gnus
+ :version "24.1" ;; No Gnus
:type '(choice (const :tag "Symmetric encryption" t)
- (repeat :tag "Recipient public keys"
- (string :tag "Recipient public key"))))
+ (repeat :tag "Recipient public keys"
+ (string :tag "Recipient public key"))))
;; temp for debugging
;; (unintern 'auth-source-protocols)
@@ -211,229 +262,799 @@
;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t)))
-(defun auth-get-source (entry)
- "Return the source string of ENTRY, which is one entry in `auth-sources'.
-If it is a Secret Service API, return the collection name, otherwise
-the file name."
- (let ((source (plist-get entry :source)))
- (if (stringp source)
- source
- ;; Secret Service API.
- (setq source (plist-get source :secrets))
- (when (eq source 'default)
- (setq source (or (secrets-get-alias "default") "login")))
- (or source "session"))))
-
-(defun auth-source-pick (&rest spec)
- "Parse `auth-sources' for matches of the SPEC plist.
-
-Common keys are :host, :protocol, and :user. A value of t in
-SPEC means to always succeed in the match. A string value is
-matched as a regex."
- (let ((keys (loop for i below (length spec) by 2 collect (nth i spec)))
- choices)
- (dolist (choice (copy-tree auth-sources) choices)
- (let ((source (plist-get choice :source))
- (match t))
- (when
- (and
- ;; Check existence of source.
- (if (consp source)
- ;; Secret Service API.
- (member (auth-get-source choice) (secrets-list-collections))
- ;; authinfo file.
- (file-exists-p source))
-
- ;; Check keywords.
- (dolist (k keys match)
- (let* ((v (plist-get spec k))
- (choicev (if (plist-member choice k)
- (plist-get choice k) t)))
- (setq match
- (and match
- (or
- ;; source always matches spec key
- (eq t choicev)
- ;; source key gives regex to match against spec
- (and (stringp choicev) (string-match choicev v))
- ;; source key gives symbol to match against spec
- (and (symbolp choicev) (eq choicev v))))))))
-
- (add-to-list 'choices choice 'append))))))
-
-(defun auth-source-retrieve (mode entry &rest spec)
- "Retrieve MODE credentials according to SPEC from ENTRY."
- (catch 'no-password
- (let ((host (plist-get spec :host))
- (user (plist-get spec :user))
- (prot (plist-get spec :protocol))
- (source (plist-get entry :source))
- result)
- (cond
- ;; Secret Service API.
- ((consp source)
- (let ((coll (auth-get-source entry))
- item)
- ;; Loop over candidates with a matching host attribute.
- (dolist (elt (secrets-search-items coll :host host) item)
- (when (and (or (not user)
- (string-equal
- user (secrets-get-attribute coll elt :user)))
- (or (not prot)
- (string-equal
- prot (secrets-get-attribute coll elt :protocol))))
- (setq item elt)
- (return elt)))
- ;; Compose result.
- (when item
- (setq result
- (mapcar (lambda (m)
- (if (string-equal "password" m)
- (or (secrets-get-secret coll item)
- ;; When we do not find a password,
- ;; we return nil anyway.
- (throw 'no-password nil))
- (or (secrets-get-attribute coll item :user)
- user)))
- (if (consp mode) mode (list mode)))))
- (if (consp mode) result (car result))))
- ;; Anything else is netrc.
- (t
- (let ((search (list source (list host) (list (format "%s" prot))
- (auth-source-protocol-defaults prot))))
- (setq result
- (mapcar (lambda (m)
- (if (string-equal "password" m)
- (or (apply
- 'netrc-machine-user-or-password m search)
- ;; When we do not find a password, we
- ;; return nil anyway.
- (throw 'no-password nil))
- (or (apply
- 'netrc-machine-user-or-password m search)
- user)))
- (if (consp mode) mode (list mode)))))
- (if (consp mode) result (car result)))))))
-
-(defun auth-source-create (mode entry &rest spec)
- "Create interactively credentials according to SPEC in ENTRY.
-Return structure as specified by MODE."
- (let* ((host (plist-get spec :host))
- (user (plist-get spec :user))
- (prot (plist-get spec :protocol))
- (source (plist-get entry :source))
- (name (concat (if user (format "%s@" user))
- host
- (if prot (format ":%s" prot))))
- result)
- (setq result
- (mapcar
- (lambda (m)
- (cons
- m
- (cond
- ((equal "password" m)
- (let ((passwd (read-passwd
- (format "Password for %s on %s: " prot host))))
- (cond
- ;; Secret Service API.
- ((consp source)
- (apply
- 'secrets-create-item
- (auth-get-source entry) name passwd spec))
- (t)) ;; netrc not implemented yes.
- passwd))
- ((equal "login" m)
- (or user
- (read-string
- (format "User name for %s on %s (default %s): " prot host
- (user-login-name))
- nil nil (user-login-name))))
- (t
- "unknownuser"))))
- (if (consp mode) mode (list mode))))
- ;; Allow the source to save the data.
- (cond
- ((consp source)
- ;; Secret Service API -- not implemented.
- )
- (t
- ;; netrc interface.
- (when (y-or-n-p (format "Do you want to save this password in %s? "
- source))
- ;; the code below is almost same as `netrc-store-data' except
- ;; the `epa-file-encrypt-to' hack (see bug#7487).
- (with-temp-buffer
- (when (file-exists-p source)
- (insert-file-contents source))
- (when auth-source-gpg-encrypt-to
- ;; making `epa-file-encrypt-to' local to this buffer lets
- ;; epa-file skip the key selection query (see the
- ;; `local-variable-p' check in `epa-file-write-region').
- (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
- (make-local-variable 'epa-file-encrypt-to))
- (if (listp auth-source-gpg-encrypt-to)
- (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (insert (format "machine %s login %s password %s port %s\n"
- host
- (or user (cdr (assoc "login" result)))
- (cdr (assoc "password" result))
- prot))
- (write-region (point-min) (point-max) source nil 'silent)))))
- (if (consp mode)
- (mapcar #'cdr result)
- (cdar result))))
-
-(defun auth-source-delete (entry &rest spec)
- "Delete credentials according to SPEC in ENTRY."
- (let ((host (plist-get spec :host))
- (user (plist-get spec :user))
- (prot (plist-get spec :protocol))
- (source (plist-get entry :source)))
- (cond
- ;; Secret Service API.
- ((consp source)
- (let ((coll (auth-get-source entry)))
- ;; Loop over candidates with a matching host attribute.
- (dolist (elt (secrets-search-items coll :host host))
- (when (and (or (not user)
- (string-equal
- user (secrets-get-attribute coll elt :user)))
- (or (not prot)
- (string-equal
- prot (secrets-get-attribute coll elt :protocol))))
- (secrets-delete-item coll elt)))))
- (t)))) ;; netrc not implemented yes.
-
-(defun auth-source-forget-user-or-password
- (mode host protocol &optional username)
- "Remove cached authentication token."
- (interactive "slogin/password: \nsHost: \nsProtocol: \n") ;for testing
- (remhash
- (if username
- (format "%s %s:%s %s" mode host protocol username)
- (format "%s %s:%s" mode host protocol))
- auth-source-cache))
+;; (auth-source-backend-parse "myfile.gpg")
+;; (auth-source-backend-parse 'default)
+;; (auth-source-backend-parse "secrets:login")
+
+(defun auth-source-backend-parse (entry)
+ "Creates an auth-source-backend from an ENTRY in `auth-sources'."
+ (auth-source-backend-parse-parameters
+ entry
+ (cond
+ ;; take 'default and recurse to get it as a Secrets API default collection
+ ;; matching any user, host, and protocol
+ ((eq entry 'default)
+ (auth-source-backend-parse '(:source (:secrets default))))
+ ;; take secrets:XYZ and recurse to get it as Secrets API collection "XYZ"
+ ;; matching any user, host, and protocol
+ ((and (stringp entry) (string-match "^secrets:\\(.+\\)" entry))
+ (auth-source-backend-parse `(:source (:secrets ,(match-string 1 entry)))))
+ ;; take just a file name and recurse to get it as a netrc file
+ ;; matching any user, host, and protocol
+ ((stringp entry)
+ (auth-source-backend-parse `(:source ,entry)))
+
+ ;; a file name with parameters
+ ((stringp (plist-get entry :source))
+ (auth-source-backend
+ (plist-get entry :source)
+ :source (plist-get entry :source)
+ :type 'netrc
+ :search-function 'auth-source-netrc-search
+ :create-function 'auth-source-netrc-create))
+
+ ;; the Secrets API. We require the package, in order to have a
+ ;; defined value for `secrets-enabled'.
+ ((and
+ (not (null (plist-get entry :source))) ; the source must not be nil
+ (listp (plist-get entry :source)) ; and it must be a list
+ (require 'secrets nil t) ; and we must load the Secrets API
+ secrets-enabled) ; and that API must be enabled
+
+ ;; the source is either the :secrets key in ENTRY or
+ ;; if that's missing or nil, it's "session"
+ (let ((source (or (plist-get (plist-get entry :source) :secrets)
+ "session")))
+
+ ;; if the source is a symbol, we look for the alias named so,
+ ;; and if that alias is missing, we use "login"
+ (when (symbolp source)
+ (setq source (or (secrets-get-alias (symbol-name source))
+ "login")))
+
+ (auth-source-backend
+ (format "Secrets API (%s)" source)
+ :source source
+ :type 'secrets
+ :search-function 'auth-source-secrets-search
+ :create-function 'auth-source-secrets-create)))
+
+ ;; none of them
+ (t
+ (auth-source-do-debug
+ "auth-source-backend-parse: invalid backend spec: %S" entry)
+ (auth-source-backend
+ "Empty"
+ :source ""
+ :type 'ignore)))))
+
+(defun auth-source-backend-parse-parameters (entry backend)
+ "Fills in the extra auth-source-backend parameters of ENTRY.
+Using the plist ENTRY, get the :host, :protocol, and :user search
+parameters. Accepts :port as an alias to :protocol. Sets all
+the parameters to t if they are missing."
+ (let (val)
+ (when (setq val (plist-get entry :host))
+ (oset backend host val))
+ (when (setq val (plist-get entry :user))
+ (oset backend user val))
+ ;; accept :port as an alias for :protocol
+ (when (setq val (or (plist-get entry :protocol) (plist-get entry :port)))
+ (oset backend protocol val)))
+ backend)
+
+;; (mapcar 'auth-source-backend-parse auth-sources)
+
+(defun* auth-source-search (&rest spec
+ &key type max host user protocol secret
+ create delete
+ &allow-other-keys)
+ "Search or modify authentication backends according to SPEC.
+
+This function parses `auth-sources' for matches of the SPEC
+plist. It can optionally create or update an authentication
+token if requested. A token is just a standard Emacs property
+list with a :secret property that can be a function; all the
+other properties will always hold scalar values.
+
+Typically the :secret property, if present, contains a password.
+
+Common search keys are :max, :host, :protocol, and :user. In
+addition, :create specifies how tokens will be or created.
+Finally, :type can specify which backend types you want to check.
+
+A string value is always matched literally. A symbol is matched
+as its string value, literally. All the SPEC values can be
+single values (symbol or string) or lists thereof (in which case
+any of the search terms matches).
+
+:create t means to create a token if possible.
+
+A new token will be created if no matching tokens were found.
+The new token will have only the keys the backend requires. For
+the netrc backend, for instance, that's the user, host, and
+protocol keys.
+
+Here's an example:
+
+\(let ((auth-source-creation-defaults '((user . \"defaultUser\")
+ (A . \"default A\"))))
+ (auth-source-search :host \"mine\" :type 'netrc :max 1
+ :P \"pppp\" :Q \"qqqq\"
+ :create t))
+
+which says:
+
+\"Search for any entry matching host 'mine' in backends of type
+ 'netrc', maximum one result.
+
+ Create a new entry if you found none. The netrc backend will
+ automatically require host, user, and protocol. The host will be
+ 'mine'. We prompt for the user with default 'defaultUser' and
+ for the protocol without a default. We will not prompt for A, Q,
+ or P. The resulting token will only have keys user, host, and
+ protocol.\"
+
+:create '(A B C) also means to create a token if possible.
+
+The behavior is like :create t but if the list contains any
+parameter, that parameter will be required in the resulting
+token. The value for that parameter will be obtained from the
+search parameters or from user input. If any queries are needed,
+the alist `auth-source-creation-defaults' will be checked for the
+default prompt.
+
+Here's an example:
+
+\(let ((auth-source-creation-defaults '((user . \"defaultUser\")
+ (A . \"default A\"))))
+ (auth-source-search :host '(\"nonesuch\" \"twosuch\") :type 'netrc :max 1
+ :P \"pppp\" :Q \"qqqq\"
+ :create '(A B Q)))
+
+which says:
+
+\"Search for any entry matching host 'nonesuch'
+ or 'twosuch' in backends of type 'netrc', maximum one result.
+
+ Create a new entry if you found none. The netrc backend will
+ automatically require host, user, and protocol. The host will be
+ 'nonesuch' and Q will be 'qqqq'. We prompt for A with default
+ 'default A', for B and protocol with default nil, and for the
+ user with default 'defaultUser'. We will not prompt for Q. The
+ resulting token will have keys user, host, protocol, A, B, and Q.
+ It will not have P with any value, even though P is used in the
+ search to find only entries that have P set to 'pppp'.\"
+
+When multiple values are specified in the search parameter, the
+first one is used for creation. So :host (X Y Z) would create a
+token for host X, for instance.
+
+This creation can fail if the search was not specific enough to
+create a new token (it's up to the backend to decide that). You
+should `catch' the backend-specific error as usual. Some
+backends (netrc, at least) will prompt the user rather than throw
+an error.
+
+:delete t means to delete any found entries. nil by default.
+Use `auth-source-delete' in ELisp code instead of calling
+`auth-source-search' directly with this parameter.
+
+:type (X Y Z) will check only those backend types. 'netrc and
+'secrets are the only ones supported right now.
+
+:max N means to try to return at most N items (defaults to 1).
+When 0 the function will return just t or nil to indicate if any
+matches were found. More than N items may be returned, depending
+on the search and the backend.
+
+:host (X Y Z) means to match only hosts X, Y, or Z according to
+the match rules above. Defaults to t.
+
+:user (X Y Z) means to match only users X, Y, or Z according to
+the match rules above. Defaults to t.
+
+:protocol (P Q R) means to match only protocols P, Q, or R.
+Defaults to t.
+
+:K (V1 V2 V3) for any other key K will match values V1, V2, or
+V3 (note the match rules above).
+
+The return value is a list with at most :max tokens. Each token
+is a plist with keys :backend :host :protocol :user, plus any other
+keys provided by the backend (notably :secret). But note the
+exception for :max 0, which see above.
+
+The token's :secret key can hold a function. In that case you
+must call it to obtain the actual value."
+ (let* ((backends (mapcar 'auth-source-backend-parse auth-sources))
+ (max (or max 1))
+ (ignored-keys '(:create :delete :max))
+ (keys (loop for i below (length spec) by 2
+ unless (memq (nth i spec) ignored-keys)
+ collect (nth i spec)))
+ (found (auth-source-recall spec))
+ filtered-backends accessor-key found-here goal)
+
+ (if (and found auth-source-do-cache)
+ (auth-source-do-debug
+ "auth-source-search: found %d CACHED results matching %S"
+ (length found) spec)
+
+ (assert
+ (or (eq t create) (listp create)) t
+ "Invalid auth-source :create parameter (must be nil, t, or a list)")
+
+ (setq filtered-backends (copy-list backends))
+ (dolist (backend backends)
+ (dolist (key keys)
+ ;; ignore invalid slots
+ (condition-case signal
+ (unless (eval `(auth-source-search-collection
+ (plist-get spec key)
+ (oref backend ,key)))
+ (setq filtered-backends (delq backend filtered-backends))
+ (return))
+ (invalid-slot-name))))
+
+ (auth-source-do-debug
+ "auth-source-search: found %d backends matching %S"
+ (length filtered-backends) spec)
+
+ ;; (debug spec "filtered" filtered-backends)
+ (setq goal max)
+ (dolist (backend filtered-backends)
+ (setq found-here (apply
+ (slot-value backend 'search-function)
+ :backend backend
+ :create create
+ :delete delete
+ spec))
+
+ ;; if max is 0, as soon as we find something, return it
+ (when (and (zerop max) (> 0 (length found-here)))
+ (return t))
+
+ ;; decrement the goal by the number of new results
+ (decf goal (length found-here))
+ ;; and append the new results to the full list
+ (setq found (append found found-here))
+
+ (auth-source-do-debug
+ "auth-source-search: found %d results (max %d/%d) in %S matching %S"
+ (length found-here) max goal backend spec)
+
+ ;; return full list if the goal is 0 or negative
+ (when (zerop (max 0 goal))
+ (return found))
+
+ ;; change the :max parameter in the spec to the goal
+ (setq spec (plist-put spec :max goal)))
+
+ (when (and found auth-source-do-cache)
+ (auth-source-remember spec found)))
+
+ found))
+
+;;; (auth-source-search :max 1)
+;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
+;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
+;;; (auth-source-search :host "nonesuch" :type 'secrets)
+
+(defun* auth-source-delete (&rest spec
+ &key delete
+ &allow-other-keys)
+ "Delete entries from the authentication backends according to SPEC.
+Calls `auth-source-search' with the :delete property in SPEC set to t.
+The backend may not actually delete the entries.
+
+Returns the deleted entries."
+ (auth-source-search (plist-put spec :delete t)))
+
+(defun auth-source-search-collection (collection value)
+ "Returns t is VALUE is t or COLLECTION is t or contains VALUE."
+ (when (and (atom collection) (not (eq t collection)))
+ (setq collection (list collection)))
+
+ ;; (debug :collection collection :value value)
+ (or (eq collection t)
+ (eq value t)
+ (equal collection value)
+ (member value collection)))
(defun auth-source-forget-all-cached ()
- "Forget all cached auth-source authentication tokens."
+ "Forget all cached auth-source data."
(interactive)
- (setq auth-source-cache (make-hash-table :test 'equal)))
-
-;; (progn
-;; (auth-source-forget-all-cached)
-;; (list
-;; (auth-source-user-or-password '("login" "password") "imap.myhost.com"
"other")
-;; (auth-source-user-or-password '("login" "password") "imap.myhost.com"
"other" "tzz")
-;; (auth-source-user-or-password '("login" "password") "imap.myhost.com"
"other" "joe")))
+ (loop for sym being the symbols of password-data
+ ;; when the symbol name starts with auth-source-magic
+ when (string-match (concat "^" auth-source-magic)
+ (symbol-name sym))
+ ;; remove that key
+ do (password-cache-remove (symbol-name sym))))
+
+(defun auth-source-remember (spec found)
+ "Remember FOUND search results for SPEC."
+ (password-cache-add
+ (concat auth-source-magic (format "%S" spec)) found))
+
+(defun auth-source-recall (spec)
+ "Recall FOUND search results for SPEC."
+ (password-read-from-cache
+ (concat auth-source-magic (format "%S" spec))))
+
+(defun auth-source-forget (spec)
+ "Forget any cached data matching SPEC exactly.
+
+This is the same SPEC you passed to `auth-source-search'.
+Returns t or nil for forgotten or not found."
+ (password-cache-remove (concat auth-source-magic (format "%S" spec))))
+
+;;; (loop for sym being the symbols of password-data when (string-match
(concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym))
+
+;;; (auth-source-remember '(:host "wedd") '(4 5 6))
+;;; (auth-source-remember '(:host "xedd") '(1 2 3))
+;;; (auth-source-recall '(:host "xedd"))
+;;; (auth-source-recall '(:host t))
+;;; (auth-source-forget+ :host t)
+
+(defun* auth-source-forget+ (&rest spec &allow-other-keys)
+ "Forget any cached data matching SPEC. Returns forgotten count.
+
+This is not a full `auth-source-search' spec but works similarly.
+For instance, \(:host \"myhost\" \"yourhost\") would find all the
+cached data that was found with a search for those two hosts,
+while \(:host t) would find all host entries."
+ (let ((count 0)
+ sname)
+ (loop for sym being the symbols of password-data
+ ;; when the symbol name matches with auth-source-magic
+ when (and (setq sname (symbol-name sym))
+ (string-match (concat "^" auth-source-magic "\\(.+\\)")
+ sname)
+ ;; and the spec matches what was stored in the cache
+ (auth-source-specmatchp spec (read (match-string 1
sname))))
+ ;; remove that key
+ do (progn
+ (password-cache-remove sname)
+ (incf count)))
+ count))
+
+(defun auth-source-specmatchp (spec stored)
+ (let ((keys (loop for i below (length spec) by 2
+ collect (nth i spec))))
+ (not (eq
+ (dolist (key keys)
+ (unless (auth-source-search-collection (plist-get stored key)
+ (plist-get spec key))
+ (return 'no)))
+ 'no))))
+
+;;; Backend specific parsing: netrc/authinfo backend
+
+;;; (auth-source-netrc-parse "~/.authinfo.gpg")
+(defun* auth-source-netrc-parse (&rest
+ spec
+ &key file max host user protocol delete
+ &allow-other-keys)
+ "Parse FILE and return a list of all entries in the file.
+Note that the MAX parameter is used so we can exit the parse early."
+ (if (listp file)
+ ;; We got already parsed contents; just return it.
+ file
+ (when (file-exists-p file)
+ (with-temp-buffer
+ (let ((tokens '("machine" "host" "default" "login" "user"
+ "password" "account" "macdef" "force"
+ "port" "protocol"))
+ (max (or max 5000)) ; sanity check: default to stop at 5K
+ (modified 0)
+ alist elem result pair)
+ (insert-file-contents file)
+ (goto-char (point-min))
+ ;; Go through the file, line by line.
+ (while (and (not (eobp))
+ (> max 0))
+
+ (narrow-to-region (point) (point-at-eol))
+ ;; For each line, get the tokens and values.
+ (while (not (eobp))
+ (skip-chars-forward "\t ")
+ ;; Skip lines that begin with a "#".
+ (if (eq (char-after) ?#)
+ (goto-char (point-max))
+ (unless (eobp)
+ (setq elem
+ (if (= (following-char) ?\")
+ (read (current-buffer))
+ (buffer-substring
+ (point) (progn (skip-chars-forward "^\t ")
+ (point)))))
+ (cond
+ ((equal elem "macdef")
+ ;; We skip past the macro definition.
+ (widen)
+ (while (and (zerop (forward-line 1))
+ (looking-at "$")))
+ (narrow-to-region (point) (point)))
+ ((member elem tokens)
+ ;; Tokens that don't have a following value are ignored,
+ ;; except "default".
+ (when (and pair (or (cdr pair)
+ (equal (car pair) "default")))
+ (push pair alist))
+ (setq pair (list elem)))
+ (t
+ ;; Values that haven't got a preceding token are ignored.
+ (when pair
+ (setcdr pair elem)
+ (push pair alist)
+ (setq pair nil)))))))
+
+ (when (and alist
+ (> max 0)
+ (auth-source-search-collection
+ host
+ (or
+ (aget alist "machine")
+ (aget alist "host")))
+ (auth-source-search-collection
+ user
+ (or
+ (aget alist "login")
+ (aget alist "account")
+ (aget alist "user")))
+ (auth-source-search-collection
+ protocol
+ (or
+ (aget alist "port")
+ (aget alist "protocol"))))
+ (decf max)
+ (push (nreverse alist) result)
+ ;; to delete a line, we just comment it out
+ (when delete
+ (goto-char (point-min))
+ (insert "#")
+ (incf modified)))
+ (setq alist nil
+ pair nil)
+ (widen)
+ (forward-line 1))
+
+ (when (< 0 modified)
+ (when auth-source-gpg-encrypt-to
+ ;; (see bug#7487) making `epa-file-encrypt-to' local to
+ ;; this buffer lets epa-file skip the key selection query
+ ;; (see the `local-variable-p' check in
+ ;; `epa-file-write-region').
+ (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
+ (make-local-variable 'epa-file-encrypt-to))
+ (if (listp auth-source-gpg-encrypt-to)
+ (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
+
+ ;; ask AFTER we've successfully opened the file
+ (when (y-or-n-p (format "Save file %s? (%d modifications)"
+ file modified))
+ (write-region (point-min) (point-max) file nil 'silent)
+ (auth-source-do-debug
+ "auth-source-netrc-parse: modified %d lines in %s"
+ modified file)))
+
+ (nreverse result))))))
+
+(defun auth-source-netrc-normalize (alist)
+ (mapcar (lambda (entry)
+ (let (ret item)
+ (while (setq item (pop entry))
+ (let ((k (car item))
+ (v (cdr item)))
+
+ ;; apply key aliases
+ (setq k (cond ((member k '("machine")) "host")
+ ((member k '("login" "account")) "user")
+ ((member k '("protocol")) "port")
+ ((member k '("password")) "secret")
+ (t k)))
+
+ ;; send back the secret in a function (lexical binding)
+ (when (equal k "secret")
+ (setq v (lexical-let ((v v))
+ (lambda () v))))
+
+ (setq ret (plist-put ret
+ (intern (concat ":" k))
+ v))
+ ))
+ ret))
+ alist))
+
+;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K
1 :max 1)) :secret))
+;;; (funcall secret)
+
+(defun* auth-source-netrc-search (&rest
+ spec
+ &key backend create delete
+ type max host user protocol
+ &allow-other-keys)
+"Given a property list SPEC, return search matches from the :backend.
+See `auth-source-search' for details on SPEC."
+ ;; just in case, check that the type is correct (null or same as the backend)
+ (assert (or (null type) (eq type (oref backend type)))
+ t "Invalid netrc search")
+
+ (let ((results (auth-source-netrc-normalize
+ (auth-source-netrc-parse
+ :max max
+ :delete delete
+ :file (oref backend source)
+ :host (or host t)
+ :user (or user t)
+ :protocol (or protocol t)))))
+
+ ;; if we need to create an entry AND none were found to match
+ (when (and create
+ (= 0 (length results)))
+
+ ;; create based on the spec
+ (apply (slot-value backend 'create-function) spec)
+ ;; turn off the :create key
+ (setq spec (plist-put spec :create nil))
+ ;; run the search again to get the updated data
+ ;; the result will be returned, even if the search fails
+ (setq results (apply 'auth-source-netrc-search spec)))
+
+ results))
+
+;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
+;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t
:create-extra-keys '((A "default A") (B)))
+
+(defun* auth-source-netrc-create (&rest spec
+ &key backend
+ secret host user protocol create
+ &allow-other-keys)
+ (let* ((base-required '(host user protocol secret))
+ ;; we know (because of an assertion in auth-source-search) that the
+ ;; :create parameter is either t or a list (which includes nil)
+ (create-extra (if (eq t create) nil create))
+ (required (append base-required create-extra))
+ (file (oref backend source))
+ (add "")
+ ;; `valist' is an alist
+ valist)
+
+ ;; only for base required elements (defined as function parameters):
+ ;; fill in the valist with whatever data we may have from the search
+ ;; we take the first value if it's a list, the whole value otherwise
+ (dolist (br base-required)
+ (when (symbol-value br)
+ (aput 'valist br (if (listp (symbol-value br))
+ (nth 0 (symbol-value br))
+ (symbol-value br)))))
+
+ ;; for extra required elements, see if the spec includes a value for them
+ (dolist (er create-extra)
+ (let ((name (concat ":" (symbol-name er)))
+ (keys (loop for i below (length spec) by 2
+ collect (nth i spec))))
+ (dolist (k keys)
+ (when (equal (symbol-name k) name)
+ (aput 'valist er (plist-get spec k))))))
+
+ ;; for each required element
+ (dolist (r required)
+ (let* ((data (aget valist r))
+ (given-default (aget auth-source-creation-defaults r))
+ ;; the defaults are simple
+ (default (cond
+ ((and (not given-default) (eq r 'user))
+ (user-login-name))
+ ;; note we need this empty string
+ ((and (not given-default) (eq r 'protocol))
+ "")
+ (t given-default)))
+ ;; the prompt's default string depends on the data so far
+ (default-string (if (and default (< 0 (length default)))
+ (format " (default %s)" default)
+ " (no default)"))
+ ;; the prompt should also show what's entered so far
+ (user-value (aget valist 'user))
+ (host-value (aget valist 'host))
+ (protocol-value (aget valist 'protocol))
+ (info-so-far (concat (if user-value
+ (format "%s@" user-value)
+ "[USER?]")
+ (if host-value
+ (format "%s" host-value)
+ "[HOST?]")
+ (if protocol-value
+ ;; this distinguishes protocol between
+ (if (zerop (length protocol-value))
+ "" ; 'entered as "no default"' vs.
+ (format ":%s" protocol-value)) ; given
+ ;; and this is when the protocol is unknown
+ "[PROTOCOL?]"))))
+
+ ;; now prompt if the search SPEC did not include a required key;
+ ;; take the result and put it in `data' AND store it in `valist'
+ (aput 'valist r
+ (setq data
+ (cond
+ ((and (null data) (eq r 'secret))
+ ;; special case prompt for passwords
+ (read-passwd (format "Password for %s: " info-so-far)))
+ ((null data)
+ (read-string
+ (format "Enter %s for %s%s: "
+ r info-so-far default-string)
+ nil nil default))
+ (t data))))
+
+ ;; when r is not an empty string...
+ (when (and (stringp data)
+ (< 0 (length data)))
+ ;; append the key (the symbol name of r) and the value in r
+ (setq add (concat add
+ (format "%s%s %S"
+ ;; prepend a space
+ (if (zerop (length add)) "" " ")
+ ;; remap auth-source tokens to netrc
+ (case r
+ ('user "login")
+ ('host "machine")
+ ('secret "password")
+ ('protocol "port")
+ (t (symbol-name r)))
+ ;; the value will be printed in %S format
+ data))))))
+
+ (with-temp-buffer
+ (when (file-exists-p file)
+ (insert-file-contents file))
+ (when auth-source-gpg-encrypt-to
+ ;; (see bug#7487) making `epa-file-encrypt-to' local to
+ ;; this buffer lets epa-file skip the key selection query
+ ;; (see the `local-variable-p' check in
+ ;; `epa-file-write-region').
+ (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
+ (make-local-variable 'epa-file-encrypt-to))
+ (if (listp auth-source-gpg-encrypt-to)
+ (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
+ (goto-char (point-max))
+
+ ;; ask AFTER we've successfully opened the file
+ (when (y-or-n-p (format "Add to file %s: line [%s]" file add))
+ (unless (bolp)
+ (insert "\n"))
+ (insert add "\n")
+ (write-region (point-min) (point-max) file nil 'silent)
+ (auth-source-do-debug
+ "auth-source-netrc-create: wrote 1 new line to %s"
+ file)))))
+
+;;; Backend specific parsing: Secrets API backend
+
+;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t))
+;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t))
+;;; (let ((auth-sources '(default))) (auth-source-search :max 1))
+;;; (let ((auth-sources '(default))) (auth-source-search))
+;;; (let ((auth-sources '("secrets:login"))) (auth-source-search :max 1))
+;;; (let ((auth-sources '("secrets:login"))) (auth-source-search :max 1
:signon_realm "https://git.gnus.org/Git";))
+
+(defun* auth-source-secrets-search (&rest
+ spec
+ &key backend create delete label
+ type max host user protocol
+ &allow-other-keys)
+ "Search the Secrets API; spec is like `auth-source'.
+
+The :label key specifies the item's label. It is the only key
+that can specify a substring. Any :label value besides a string
+will allow any label.
+
+All other search keys must match exactly. If you need substring
+matching, do a wider search and narrow it down yourself.
+
+You'll get back all the properties of the token as a plist.
+
+Here's an example that looks for the first item in the 'login'
+Secrets collection:
+
+ \(let ((auth-sources '(\"secrets:login\")))
+ (auth-source-search :max 1)
+
+Here's another that looks for the first item in the 'login'
+Secrets collection whose label contains 'gnus':
+
+ \(let ((auth-sources '(\"secrets:login\")))
+ (auth-source-search :max 1 :label \"gnus\")
+
+And this one looks for the first item in the 'login' Secrets
+collection that's a Google Chrome entry for the git.gnus.org site
+login:
+
+ \(let ((auth-sources '(\"secrets:login\")))
+ (auth-source-search :max 1 :signon_realm \"https://git.gnus.org/Git\";))
+"
+
+ ;; TODO
+ (assert (not create) nil
+ "The Secrets API auth-source backend doesn't support creation yet")
+ ;; TODO
+ ;; (secrets-delete-item coll elt)
+ (assert (not delete) nil
+ "The Secrets API auth-source backend doesn't support deletion yet")
+
+ (let* ((coll (oref backend source))
+ (max (or max 5000)) ; sanity check: default to stop at 5K
+ (ignored-keys '(:create :delete :max :backend :label))
+ (search-keys (loop for i below (length spec) by 2
+ unless (memq (nth i spec) ignored-keys)
+ collect (nth i spec)))
+ ;; build a search spec without the ignored keys
+ ;; if a search key is nil or t (match anything), we skip it
+ (search-spec (mapcan (lambda (k) (if (or (null (plist-get spec k))
+ (eq t (plist-get spec k)))
+ nil
+ (list k (plist-get spec k))))
+ search-keys))
+ ;; needed keys (always including host, login, protocol, and secret)
+ (returned-keys (remove-duplicates (append
+ '(:host :login :protocol :secret)
+ search-keys)))
+ (items (loop for item in (apply 'secrets-search-items coll
search-spec)
+ unless (and (stringp label)
+ (not (string-match label item)))
+ collect item))
+ ;; TODO: respect max in `secrets-search-items', not after the fact
+ (items (subseq items 0 (min (length items) max)))
+ ;; convert the item name to a full plist
+ (items (mapcar (lambda (item)
+ (append
+ ;; make an entry for the secret (password) element
+ (list
+ :secret
+ (lexical-let ((v (secrets-get-secret coll item)))
+ (lambda () v)))
+ ;; rewrite the entry from ((k1 v1) (k2 v2)) to plist
+ (mapcan (lambda (entry)
+ (list (car entry) (cdr entry)))
+ (secrets-get-attributes coll item))))
+ items))
+ ;; ensure each item has each key in `returned-keys'
+ (items (mapcar (lambda (plist)
+ (append
+ (mapcan (lambda (req)
+ (if (plist-get plist req)
+ nil
+ (list req nil)))
+ returned-keys)
+ plist))
+ items)))
+ items))
+
+(defun* auth-source-secrets-create (&rest
+ spec
+ &key backend type max host user protocol
+ &allow-other-keys)
+ ;; TODO
+ ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec)
+ (debug spec))
+
+;;; older API
+
+;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t
"tzz")
+
+;; deprecate the old interface
+(make-obsolete 'auth-source-user-or-password
+ 'auth-source-search "Emacs 24.1")
+(make-obsolete 'auth-source-forget-user-or-password
+ 'auth-source-forget "Emacs 24.1")
(defun auth-source-user-or-password
(mode host protocol &optional username create-missing delete-existing)
"Find MODE (string or list of strings) matching HOST and PROTOCOL.
+DEPRECATED in favor of `auth-source-search'!
+
USERNAME is optional and will be used as \"login\" in a search
across the Secret Service API (see secrets.el) if the resulting
items don't have a username. This means that if you search for
@@ -452,8 +1073,9 @@
MODE can be \"login\" or \"password\"."
(auth-source-do-debug
- "auth-source-user-or-password: get %s for %s (%s) + user=%s"
+ "auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s"
mode host protocol username)
+
(let* ((listy (listp mode))
(mode (if listy mode (list mode)))
(cname (if username
@@ -461,70 +1083,44 @@
(format "%s %s:%s" mode host protocol)))
(search (list :host host :protocol protocol))
(search (if username (append search (list :user username)) search))
- (found (if (not delete-existing)
- (gethash cname auth-source-cache)
- (remhash cname auth-source-cache)
- nil)))
+ (search (if create-missing
+ (append search (list :create t))
+ search))
+ (search (if delete-existing
+ (append search (list :delete t))
+ search))
+ ;; (found (if (not delete-existing)
+ ;; (gethash cname auth-source-cache)
+ ;; (remhash cname auth-source-cache)
+ ;; nil)))
+ (found nil))
(if found
(progn
(auth-source-do-debug
- "auth-source-user-or-password: cached %s=%s for %s (%s) + %s"
+ "auth-source-user-or-password: DEPRECATED cached %s=%s for %s (%s)
+ %s"
mode
;; don't show the password
- (if (and (member "password" mode) auth-source-hide-passwords)
+ (if (and (member "password" mode) t)
"SECRET"
found)
host protocol username)
found) ; return the found data
- ;; else, if not found
- (let ((choices (apply 'auth-source-pick search)))
- (dolist (choice choices)
- (if delete-existing
- (apply 'auth-source-delete choice search)
- (setq found (apply 'auth-source-retrieve mode choice search)))
- (and found (return found)))
-
- ;; We haven't found something, so we will create it interactively.
- (when (and (not found) create-missing)
- (setq found (apply 'auth-source-create
- mode (if choices
- (car choices)
- (car auth-sources))
- search)))
-
- ;; Cache the result.
- (when found
- (auth-source-do-debug
- "auth-source-user-or-password: found %s=%s for %s (%s) + %s"
- mode
- ;; don't show the password
- (if (and (member "password" mode) auth-source-hide-passwords)
- "SECRET" found)
- host protocol username)
- (setq found (if listy found (car-safe found)))
- (when auth-source-do-cache
- (puthash cname found auth-source-cache)))
-
- found))))
-
-(defun auth-source-protocol-defaults (protocol)
- "Return a list of default ports and names for PROTOCOL."
- (cdr-safe (assoc protocol auth-source-protocols)))
-
-(defun auth-source-user-or-password-imap (mode host)
- (auth-source-user-or-password mode host 'imap))
-
-(defun auth-source-user-or-password-pop3 (mode host)
- (auth-source-user-or-password mode host 'pop3))
-
-(defun auth-source-user-or-password-ssh (mode host)
- (auth-source-user-or-password mode host 'ssh))
-
-(defun auth-source-user-or-password-sftp (mode host)
- (auth-source-user-or-password mode host 'sftp))
-
-(defun auth-source-user-or-password-smtp (mode host)
- (auth-source-user-or-password mode host 'smtp))
+ ;; else, if not found, search with a max of 1
+ (let ((choice (nth 0 (apply 'auth-source-search
+ (append '(:max 1) search)))))
+ (when choice
+ (dolist (m mode)
+ (cond
+ ((equal "password" m)
+ (push (if (plist-get choice :secret)
+ (funcall (plist-get choice :secret))
+ nil) found))
+ ((equal "login" m)
+ (push (plist-get choice :user) found)))))
+ (setq found (nreverse found))
+ (setq found (if listy found (car-safe found)))))
+
+ found))
(provide 'auth-source)
=== modified file 'lisp/gnus/mail-source.el'
--- a/lisp/gnus/mail-source.el 2011-01-25 04:08:28 +0000
+++ b/lisp/gnus/mail-source.el 2011-02-13 00:25:29 +0000
@@ -32,7 +32,7 @@
(eval-when-compile
(require 'cl)
(require 'imap))
-(autoload 'auth-source-user-or-password "auth-source")
+(autoload 'auth-source-search "auth-source")
(autoload 'pop3-movemail "pop3")
(autoload 'pop3-get-message-count "pop3")
(autoload 'nnheader-cancel-timer "nnheader")
@@ -332,6 +332,7 @@
(:prescript)
(:prescript-delay)
(:postscript)
+ ;; note server and port need to come before user and password
(:server (getenv "MAILHOST"))
(:port 110)
(:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
@@ -345,6 +346,7 @@
(:subdirs ("cur" "new"))
(:function))
(imap
+ ;; note server and port need to come before user and password
(:server (getenv "MAILHOST"))
(:port)
(:stream)
@@ -417,42 +419,66 @@
(put 'mail-source-bind 'lisp-indent-function 1)
(put 'mail-source-bind 'edebug-form-spec '(sexp body))
-;; TODO: use the list format for auth-source-user-or-password modes
(defun mail-source-set-1 (source)
(let* ((type (pop source))
- (defaults (cdr (assq type mail-source-keyword-map)))
- default value keyword auth-info user-auth pass-auth)
+ (defaults (cdr (assq type mail-source-keyword-map)))
+ (search '(:max 1))
+ found default value keyword auth-info user-auth pass-auth)
+
+ ;; append to the search the useful info from the source and the defaults:
+ ;; user, host, and port
+
+ ;; the msname is the mail-source parameter
+ (dolist (msname '(:server :user :port))
+ ;; the asname is the auth-source parameter
+ (let* ((asname (case msname
+ (:server :host) ; auth-source uses :host
+ (t msname)))
+ ;; this is the mail-source default
+ (msdef1 (or (plist-get source msname)
+ (nth 1 (assoc msname defaults))))
+ ;; ...evaluated
+ (msdef (mail-source-value msdef1)))
+ (setq search (append (list asname
+ (if msdef msdef t))
+ search))))
+ ;; if the port is unknown yet, get it from the mail-source type
+ (unless (plist-get search :port)
+ (setq search (append (list :port (symbol-name type)))))
+
(while (setq default (pop defaults))
;; for each default :SYMBOL, set SYMBOL to the plist value for :SYMBOL
;; using `mail-source-value' to evaluate the plist value
(set (mail-source-strip-keyword (setq keyword (car default)))
- ;; note the following reasons for this structure:
- ;; 1) the auth-sources user and password override everything
- ;; 2) it avoids macros, so it's cleaner
- ;; 3) it falls through to the mail-sources and then default values
- (cond
- ((and
- (eq keyword :user)
- (setq user-auth
- (nth 0 (auth-source-user-or-password
- '("login" "password")
- ;; this is "host" in auth-sources
- (if (boundp 'server) (symbol-value 'server) "")
- type))))
- user-auth)
- ((and
- (eq keyword :password)
- (setq pass-auth
- (nth 1
- (auth-source-user-or-password
- '("login" "password")
- ;; this is "host" in auth-sources
- (if (boundp 'server) (symbol-value 'server) "")
- type))))
- pass-auth)
- (t (if (setq value (plist-get source keyword))
- (mail-source-value value)
- (mail-source-value (cadr default)))))))))
+ ;; note the following reasons for this structure:
+ ;; 1) the auth-sources user and password override everything
+ ;; 2) it avoids macros, so it's cleaner
+ ;; 3) it falls through to the mail-sources and then default values
+ (cond
+ ((and
+ (eq keyword :user)
+ (setq user-auth (plist-get
+ ;; cache the search result in `found'
+ (or found
+ (setq found (nth 0 (apply 'auth-source-search
+ search))))
+ :user)))
+ user-auth)
+ ((and
+ (eq keyword :password)
+ (setq pass-auth (plist-get
+ ;; cache the search result in `found'
+ (or found
+ (setq found (nth 0 (apply
'auth-source-search
+ search))))
+ :secret)))
+ ;; maybe set the password to the return of the :secret function
+ (if (functionp pass-auth)
+ (setq pass-auth (funcall pass-auth))
+ pass-auth))
+ (t (if (setq value (plist-get source keyword))
+ (mail-source-value value)
+ (mail-source-value (cadr default)))))))))
(eval-and-compile
(defun mail-source-bind-common-1 ()
=== modified file 'lisp/gnus/nnimap.el'
--- a/lisp/gnus/nnimap.el 2011-02-07 22:49:38 +0000
+++ b/lisp/gnus/nnimap.el 2011-02-13 00:25:29 +0000
@@ -47,8 +47,8 @@
(require 'nnmail)
(require 'proto-stream)
-(autoload 'auth-source-forget-user-or-password "auth-source")
-(autoload 'auth-source-user-or-password "auth-source")
+(autoload 'auth-source-forget+ "auth-source")
+(autoload 'auth-source-search "auth-source")
(nnoo-declare nnimap)
@@ -275,18 +275,18 @@
(current-buffer)))
(defun nnimap-credentials (address ports &optional inhibit-create)
- (let (port credentials)
- ;; Request the credentials from all ports, but only query on the
- ;; last port if all the previous ones have failed.
- (while (and (null credentials)
- (setq port (pop ports)))
- (setq credentials
- (auth-source-user-or-password
- '("login" "password") address port nil
- (if inhibit-create
- nil
- (null ports)))))
- credentials))
+ (let* ((found (nth 0 (auth-source-search :max 1
+ :host address
+ :port ports
+ :create (if inhibit-create
+ nil
+ (null ports)))))
+ (user (plist-get found :user))
+ (secret (plist-get found :secret))
+ (secret (if (functionp secret) (funcall secret) secret)))
+ (if found
+ (list user secret)
+ nil)))
(defun nnimap-keepalive ()
(let ((now (current-time)))
@@ -381,14 +381,13 @@
(if (eq nnimap-authenticator 'anonymous)
(list "anonymous"
(message-make-address))
- (or
- ;; First look for the credentials based
- ;; on the virtual server name.
- (nnimap-credentials
- (nnoo-current-server 'nnimap) ports t)
- ;; Then look them up based on the
- ;; physical address.
- (nnimap-credentials nnimap-address ports)))))
+ ;; Look for the credentials based on
+ ;; the virtual server name and the address
+ (nnimap-credentials
+ (list
+ (nnoo-current-server 'nnimap)
+ nnimap-address)
+ ports t))))
(setq nnimap-object nil)
(setq login-result
(nnimap-login (car credentials) (cadr credentials)))
@@ -398,9 +397,7 @@
(dolist (host (list (nnoo-current-server 'nnimap)
nnimap-address))
(dolist (port ports)
- (dolist (element '("login" "password"))
- (auth-source-forget-user-or-password
- element host port))))
+ (auth-source-forget+ :host host :protocol port)))
(delete-process (nnimap-process nnimap-object))
(setq nnimap-object nil))))
(when nnimap-object
=== modified file 'lisp/gnus/nntp.el'
--- a/lisp/gnus/nntp.el 2011-02-09 22:16:29 +0000
+++ b/lisp/gnus/nntp.el 2011-02-13 00:25:29 +0000
@@ -40,7 +40,7 @@
(eval-when-compile (require 'cl))
-(autoload 'auth-source-user-or-password "auth-source")
+(autoload 'auth-source-search "auth-source")
(defgroup nntp nil
"NNTP access for Gnus."
@@ -1231,10 +1231,16 @@
(let* ((list (netrc-parse nntp-authinfo-file))
(alist (netrc-machine list nntp-address "nntp"))
(force (or (netrc-get alist "force") nntp-authinfo-force))
- (auth-info
- (auth-source-user-or-password '("login" "password") nntp-address
"nntp"))
- (auth-user (nth 0 auth-info))
- (auth-passwd (nth 1 auth-info))
+ (auth-info
+ (nth 0 (auth-source-search :max 1
+ ;; TODO: allow the virtual server name too
+ :host nntp-address
+ :port '("119" "nntp"))))
+ (auth-user (plist-get auth-info :user))
+ (auth-passwd (plist-get auth-info :secret))
+ (auth-passwd (if (functionp auth-passwd)
+ (funcall auth-passwd)
+ auth-passwd))
(user (or
;; this is preferred to netrc-*
auth-user
=== modified file 'lisp/gnus/sieve-manage.el'
--- a/lisp/gnus/sieve-manage.el 2011-01-25 04:08:28 +0000
+++ b/lisp/gnus/sieve-manage.el 2011-02-13 00:25:29 +0000
@@ -83,7 +83,7 @@
(require 'starttls))
(autoload 'sasl-find-mechanism "sasl")
(autoload 'starttls-open-stream "starttls")
-(autoload 'auth-source-user-or-password "auth-source")
+(autoload 'auth-source-search "auth-source")
;; User customizable variables:
@@ -273,16 +273,20 @@
"Login to server using the SASL MECH method."
(message "sieve: Authenticating using %s..." mech)
(with-current-buffer buffer
- (let* ((user-password (auth-source-user-or-password
- '("login" "password")
- sieve-manage-server
- "sieve" nil t))
+ (let* ((auth-info (auth-source-search :host sieve-manage-server
+ :port "sieve"
+ :max 1))
+ (user-name (plist-get (nth 0 auth-info) :user))
+ (user-password (plist-get (nth 0 auth-info) :secret))
+ (user-password (if (functionp user-password)
+ (funcall user-password)
+ user-password))
(client (sasl-make-client (sasl-find-mechanism (list mech))
- (car user-password) "sieve"
sieve-manage-server))
+ user-name "sieve" sieve-manage-server))
(sasl-read-passphrase
;; We *need* to copy the password, because sasl will modify it
;; somehow.
- `(lambda (prompt) ,(copy-sequence (cadr user-password))))
+ `(lambda (prompt) ,(copy-sequence user-password)))
(step (sasl-next-step client nil))
(tag (sieve-manage-send
(concat
=== modified file 'lisp/password-cache.el'
--- a/lisp/password-cache.el 2011-01-25 04:08:28 +0000
+++ b/lisp/password-cache.el 2011-02-13 00:25:29 +0000
@@ -111,9 +111,10 @@
user again."
(let ((password (symbol-value (intern-soft key password-data))))
(when password
- (if (fboundp 'clear-string)
- (clear-string password)
- (fillarray password ?_))
+ (when (stringp password)
+ (if (fboundp 'clear-string)
+ (clear-string password)
+ (fillarray password ?_)))
(unintern key password-data))))
(defun password-cache-add (key password)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r103246: Merge changes made in Gnus trunk.,
Katsumi Yamaoka <=