;;; auth-source.el --- authentication sources for Gnus and Emacs
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news
(defcustom auth-sources '("~/.authinfo" "~/.authinfo.gpg" "~/.netrc")
"List of authentication sources.
-
-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\" and the famous
-\"~/.netrc\" file.
-
-See the auth.info manual for details.
-
Each entry is the authentication type with optional properties.
+Entries are tried in the order in which they appear.
+See Info node `(auth)Help for users' for details.
-It's best to customize this with `M-x customize-variable' because the choices
+If an entry names a file with the \".gpg\" extension and you have
+EPA/EPG set up, the file will be encrypted and decrypted
+automatically. See Info node `(epa)Encrypting/decrypting gpg files'
+for details.
+
+It's best to customize this with `\\[customize-variable]' because the choices
can get pretty complex."
:group 'auth-source
:version "24.1" ;; No Gnus
:type `(repeat :tag "Authentication Sources"
(choice
(string :tag "Just a file")
- (const :tag "Default Secrets API Collection" 'default)
+ (const :tag "Default Secrets API Collection" default)
(const :tag "Login Secrets API Collection" "secrets:Login")
(const :tag "Temp Secrets API Collection" "secrets:session")
(const :format "" :value :secrets)
(choice :tag "Collection to use"
(string :tag "Collection name")
- (const :tag "Default" 'default)
+ (const :tag "Default" default)
(const :tag "Login" "Login")
(const
:tag "Temporary" "session")))
:value :macos-keychain-internet)
(choice :tag "Collection to use"
(string :tag "internet Keychain path")
- (const :tag "default" 'default)))
+ (const :tag "default" default)))
(list
:tag "Mac OS generic Keychain"
(const :format ""
:value :macos-keychain-generic)
(choice :tag "Collection to use"
(string :tag "generic Keychain path")
- (const :tag "default" 'default))))
+ (const :tag "default" default))))
(repeat :tag "Extra Parameters" :inline t
(choice :tag "Extra parameter"
(list
;; (let ((auth-source-debug nil)) (auth-source-do-debug "hello"))
(defun auth-source-do-debug (&rest msg)
(when auth-source-debug
- (apply 'auth-source-do-warn msg)))
+ (apply #'auth-source-do-warn msg)))
(defun auth-source-do-trivia (&rest msg)
(when (or (eq auth-source-debug 'trivia)
(functionp auth-source-debug))
- (apply 'auth-source-do-warn msg)))
+ (apply #'auth-source-do-warn msg)))
(defun auth-source-do-warn (&rest msg)
(apply
"Read one of CHOICES by `read-char-choice', or `read-char'.
`dropdown-list' support is disabled because it doesn't work reliably.
Only one of CHOICES will be returned. The PROMPT is augmented
-with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
+with \"[a/b/c] \" if CHOICES is \(?a ?b ?c)."
(when choices
(let* ((prompt-choices
- (apply 'concat (loop for c in choices
+ (apply #'concat (loop for c in choices
collect (format "%c/" c))))
(prompt-choices (concat "[" (substring prompt-choices 0 -1) "] "))
(full-prompt (concat prompt prompt-choices))
Typically the :secret property, if present, contains a password.
Common search keys are :max, :host, :port, and :user. In
-addition, :create specifies how tokens will be or created.
+addition, :create specifies if and how tokens will be created.
Finally, :type can specify which backend types you want to check.
A string value is always matched literally. A symbol is matched
Here's an example:
-\(let ((auth-source-creation-defaults '((user . \"defaultUser\")
+\(let ((auth-source-creation-defaults \\='((user . \"defaultUser\")
(A . \"default A\"))))
- (auth-source-search :host \"mine\" :type 'netrc :max 1
+ (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.
+\"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 port. The host will be
- 'mine'. We prompt for the user with default 'defaultUser' and
+ `mine'. We prompt for the user with default `defaultUser' and
for the port without a default. We will not prompt for A, Q,
or P. The resulting token will only have keys user, host, and
port.\"
-:create '(A B C) also means to create a token if possible.
+: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
the alist `auth-source-creation-defaults' will be checked for the
default value. If the user, host, or port are missing, the alist
`auth-source-creation-prompts' will be used to look up the
-prompts IN THAT ORDER (so the 'user prompt will be queried first,
-then 'host, then 'port, and finally 'secret). Each prompt string
+prompts IN THAT ORDER (so the `user' prompt will be queried first,
+then `host', then `port', and finally `secret'). Each prompt string
can use %u, %h, and %p to show the user, host, and port.
Here's an example:
-\(let ((auth-source-creation-defaults '((user . \"defaultUser\")
+\(let ((auth-source-creation-defaults \\='((user . \"defaultUser\")
(A . \"default A\")))
(auth-source-creation-prompts
- '((password . \"Enter IMAP password for %h:%p: \"))))
- (auth-source-search :host '(\"nonesuch\" \"twosuch\") :type 'netrc :max 1
+ \\='((password . \"Enter IMAP password for %h:%p: \"))))
+ (auth-source-search :host \\='(\"nonesuch\" \"twosuch\") :type \\='netrc :max 1
:P \"pppp\" :Q \"qqqq\"
- :create '(A B Q)))
+ :create \\='(A B Q)))
which says:
-\"Search for any entry matching host 'nonesuch'
- or 'twosuch' in backends of type 'netrc', maximum one result.
+\"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 port. The host will be
- 'nonesuch' and Q will be 'qqqq'. We prompt for the password
+ `nonesuch' and Q will be `qqqq'. We prompt for the password
with the shown prompt. We will not prompt for Q. The resulting
token will have keys user, host, port, 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'.\"
+ find only entries that have P set to `pppp'.\"
When multiple values are specified in the search parameter, the
user is prompted for which one. So :host (X Y Z) would ask the
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.
+: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.
+More than N items may be returned, depending on the search and
+the backend.
+
+When :max is 0 the function will return just t or nil to indicate
+if any matches were found.
:host (X Y Z) means to match only hosts X, Y, or Z according to
the match rules above. Defaults to t.
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))
+ (let* ((backends (mapcar #'auth-source-backend-parse auth-sources))
(max (or max 1))
(ignored-keys '(:require :create :delete :max))
(keys (loop for i below (length spec) by 2
(when auth-source-do-cache
(auth-source-remember spec found)))
- found))
+ (if (zerop max)
+ (not (null found))
+ found)))
(defun auth-source-search-backends (backends spec max create delete require)
- (let (matches)
+ (let ((max (if (zerop max) 1 max)) ; stop with 1 match if we're asked for zero
+ matches)
(dolist (backend backends)
- (when (> max (length matches)) ; when we need more matches...
+ (when (> max (length matches)) ; if we need more matches...
(let* ((bmatches (apply
(slot-value backend 'search-function)
:backend backend
:type (slot-value backend :type)
;; note we're overriding whatever the spec
- ;; has for :require, :create, and :delete
+ ;; has for :max, :require, :create, and :delete
+ :max max
:require require
:create create
:delete delete
(setq matches (append matches bmatches))))))
matches))
+;; (auth-source-search :max 0)
;; (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-pick-first-password :port "imap")
(defun auth-source-pick-first-password (&rest spec)
"Pick the first secret found from applying SPEC to `auth-source-search'."
- (let* ((result (nth 0 (apply 'auth-source-search (plist-put spec :max 1))))
+ (let* ((result (nth 0 (apply #'auth-source-search (plist-put spec :max 1))))
(secret (plist-get result :secret)))
(if (functionp secret)
(auth-source--aput
auth-source-netrc-cache file
(list :mtime (nth 5 (file-attributes file))
- :secret (lexical-let ((v (mapcar '1+ (buffer-string))))
- (lambda () (apply 'string (mapcar '1- v)))))))
+ :secret (lexical-let ((v (mapcar #'1+ (buffer-string))))
+ (lambda () (apply #'string (mapcar #'1- v)))))))
(goto-char (point-min))
(let ((entries (auth-source-netrc-parse-entries check max))
alist)
"Read one thing from the current buffer."
(auth-source-netrc-parse-next-interesting)
- (when (or (looking-at "'\\([^']+\\)'")
- (looking-at "\"\\([^\"]+\\)\"")
+ (when (or (looking-at "'\\([^']*\\)'")
+ (looking-at "\"\\([^\"]*\\)\"")
(looking-at "\\([^ \t\n]+\\)"))
(forward-char (length (match-string 0)))
(auth-source-netrc-parse-next-interesting)
(when (and alist
(or default
(equal item "machine")))
- (auth-source-do-trivia
- "auth-source-netrc-parse-entries: got entry %S" alist)
+ ;; (auth-source-do-trivia
+ ;; "auth-source-netrc-parse-entries: got entry %S" alist)
(setq all (funcall adder check alist all)
alist nil))
;; In default entries, we don't have a next token.
(if (equal item2 "machine")
(progn
(gnus-error 1
- "%s: Unexpected 'machine' token at line %d"
+ "%s: Unexpected `machine' token at line %d"
"auth-source-netrc-parse-entries"
(auth-source-current-line))
(forward-line 1))
;; Clean up: if there's an entry left over, use it.
(when alist
(setq all (funcall adder check alist all))
- (auth-source-do-trivia
- "auth-source-netrc-parse-entries: got2 entry %S" alist))
+ ;; (auth-source-do-trivia
+ ;; "auth-source-netrc-parse-entries: got2 entry %S" alist)
+ )
(nreverse all)))
(defvar auth-source-passphrase-alist nil)
;; to get the updated data.
;; the result will be returned, even if the search fails
- (apply 'auth-source-netrc-search
+ (apply #'auth-source-netrc-search
(plist-put spec :create nil)))))
results))
;; (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-listify-pattern (pattern)
+ "Convert a pattern with lists to a list of string patterns.
+
+auth-source patterns can have values of the form :foo (\"bar\"
+\"qux\"), which means to match any secret with :foo equal to
+\"bar\" or :foo equal to \"qux\". The secrets backend supports
+only string values for patterns, so this routine returns a list
+of patterns that is equivalent to the single original pattern
+when interpreted such that if a secret matches any pattern in the
+list, it matches the original pattern."
+ (if (null pattern)
+ '(nil)
+ (let* ((key (pop pattern))
+ (value (pop pattern))
+ (tails (auth-source-secrets-listify-pattern pattern))
+ (heads (if (stringp value)
+ (list (list key value))
+ (mapcar (lambda (v) (list key v)) value))))
+ (loop
+ for h in heads
+ nconc
+ (loop
+ for tl in tails
+ collect (append h tl))))))
+
(defun* auth-source-secrets-search (&rest
spec
&key backend create delete label
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'
+Here's an example that looks for the first item in the `Login'
Secrets collection:
- \(let ((auth-sources '(\"secrets:Login\")))
+ (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':
+Here's another that looks for the first item in the `Login'
+Secrets collection whose label contains `gnus':
- \(let ((auth-sources '(\"secrets:Login\")))
+ (let ((auth-sources \\='(\"secrets:Login\")))
(auth-source-search :max 1 :label \"gnus\")
-And this one looks for the first item in the 'Login' Secrets
+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
authentication tokens:
- \(let ((auth-sources '(\"secrets:Login\")))
+ (let ((auth-sources \\='(\"secrets:Login\")))
(auth-source-search :max 1 :signon_realm \"https://git.gnus.org/Git\"))
"
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 (apply 'append (mapcar
+ (search-specs (auth-source-secrets-listify-pattern
+ (apply #'append (mapcar
(lambda (k)
(if (or (null (plist-get spec k))
(eq t (plist-get spec k)))
nil
(list k (plist-get spec k))))
- search-keys)))
+ search-keys))))
;; needed keys (always including host, login, port, and secret)
(returned-keys (mm-delete-duplicates (append
'(:host :login :port :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))
+ (items
+ (loop for search-spec in search-specs
+ nconc
+ (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 (butlast items (- (length items) max)))
;; convert the item name to a full plist
(lexical-let ((v (secrets-get-secret coll item)))
(lambda () v)))
;; rewrite the entry from ((k1 v1) (k2 v2)) to plist
- (apply 'append
+ (apply #'append
(mapcar (lambda (entry)
(list (car entry) (cdr entry)))
(secrets-get-attributes coll item)))))
;; ensure each item has each key in `returned-keys'
(items (mapcar (lambda (plist)
(append
- (apply 'append
+ (apply #'append
(mapcar (lambda (req)
(if (plist-get plist req)
nil
;; (let ((auth-sources '("macos-keychain-internet:/Users/tzz/Library/Keychains/login.keychain"))) (auth-source-search :max 1))
;; (let ((auth-sources '("macos-keychain-generic:Login"))) (auth-source-search :max 1 :host "git.gnus.org"))
+;; (let ((auth-sources '("macos-keychain-generic:Login"))) (auth-source-search :max 1))
(defun* auth-source-macos-keychain-search (&rest
spec
You'll get back all the properties of the token as a plist.
-The :type key is either 'macos-keychain-internet or
-'macos-keychain-generic.
+The :type key is either `macos-keychain-internet' or
+`macos-keychain-generic'.
For the internet keychain type, the :label key searches the
item's labels (\"-l LABEL\" passed to \"/usr/bin/security\").
Here's an example that looks for the first item in the default
generic MacOS Keychain:
- \(let ((auth-sources '(macos-keychain-generic)))
+ (let ((auth-sources \\='(macos-keychain-generic)))
(auth-source-search :max 1)
Here's another that looks for the first item in the internet
-MacOS Keychain collection whose label is 'gnus':
+MacOS Keychain collection whose label is `gnus':
- \(let ((auth-sources '(macos-keychain-internet)))
+ (let ((auth-sources \\='(macos-keychain-internet)))
(auth-source-search :max 1 :label \"gnus\")
And this one looks for the first item in the internet keychain
entries for git.gnus.org:
- \(let ((auth-sources '(macos-keychain-internet\")))
+ (let ((auth-sources \\='(macos-keychain-internet\")))
(auth-source-search :max 1 :host \"git.gnus.org\"))
"
;; TODO
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 (apply 'append (mapcar
+ (search-spec (apply #'append (mapcar
(lambda (k)
(if (or (null (plist-get spec k))
(eq t (plist-get spec k)))
(returned-keys (mm-delete-duplicates (append
'(:host :login :port :secret)
search-keys)))
- (items (apply 'auth-source-macos-keychain-search-items
+ (items (apply #'auth-source-macos-keychain-search-items
coll
type
max
;; ensure each item has each key in `returned-keys'
(items (mapcar (lambda (plist)
(append
- (apply 'append
+ (apply #'append
(mapcar (lambda (req)
(if (plist-get plist req)
nil
(setq args (append args (list coll))))
(with-temp-buffer
- (apply 'call-process "/usr/bin/security" nil t nil args)
+ (apply #'call-process "/usr/bin/security" nil t nil args)
(goto-char (point-min))
(while (not (eobp))
(cond
((looking-at "^password: \"\\(.+\\)\"$")
- (auth-source-macos-keychain-result-append
- ret
- keychain-generic
- "secret"
- (lexical-let ((v (match-string 1)))
- (lambda () v))))
+ (setq ret (auth-source-macos-keychain-result-append
+ ret
+ keychain-generic
+ "secret"
+ (lexical-let ((v (match-string 1)))
+ (lambda () v)))))
;; TODO: check if this is really the label
;; match 0x00000007 <blob>="AppleID"
((looking-at "^[ ]+0x00000007 <blob>=\"\\(.+\\)\"")
- (auth-source-macos-keychain-result-append
- ret
- keychain-generic
- "label"
- (match-string 1)))
+ (setq ret (auth-source-macos-keychain-result-append
+ ret
+ keychain-generic
+ "label"
+ (match-string 1))))
;; match "crtr"<uint32>="aapl"
;; match "svce"<blob>="AppleID"
((looking-at "^[ ]+\"\\([a-z]+\\)\"[^=]+=\"\\(.+\\)\"")
- (auth-source-macos-keychain-result-append
- ret
- keychain-generic
- (match-string 1)
- (match-string 2))))
- (forward-line)))
+ (setq ret (auth-source-macos-keychain-result-append
+ ret
+ keychain-generic
+ (match-string 1)
+ (match-string 2)))))
+ (forward-line)))
;; return `ret' iff it has the :secret key
(and (plist-get ret :secret) (list ret))))
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 (apply 'append (mapcar
+ (search-spec (apply #'append (mapcar
(lambda (k)
(let ((v (plist-get spec k)))
(if (or (null v)
;; ensure each item has each key in `returned-keys'
(items (mapcar (lambda (plist)
(append
- (apply 'append
+ (apply #'append
(mapcar (lambda (req)
(if (plist-get plist req)
nil
;; to get the updated data.
;; the result will be returned, even if the search fails
- (apply 'auth-source-plstore-search
+ (apply #'auth-source-plstore-search
(plist-put spec :create nil)))))
((and delete
item-names)
host port username)
found) ; return the found data
;; else, if not found, search with a max of 1
- (let ((choice (nth 0 (apply 'auth-source-search
+ (let ((choice (nth 0 (apply #'auth-source-search
(append '(:max 1) search)))))
(when choice
(dolist (m mode)
projects / gnus / blobdiff