;;; auth-source.el --- authentication sources for Gnus and Emacs
-;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news
(autoload 'epg-make-context "epg")
(autoload 'epg-context-set-passphrase-callback "epg")
(autoload 'epg-decrypt-string "epg")
-(autoload 'epg-context-set-armor "epg")
(autoload 'epg-encrypt-string "epg")
+(autoload 'epg-context-set-armor "epg")
(autoload 'help-mode "help-mode" nil t)
auth-source-protocols))
(defvar auth-source-creation-defaults nil
+ ;; FIXME: AFAICT this is not set (or let-bound) anywhere!
"Defaults for creating token values. Usually let-bound.")
(defvar auth-source-creation-prompts nil
(const :tag "Never save" nil)
(const :tag "Ask" ask)))
-;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") never) (t gpg)))
+;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car epa-file-auto-mode-alist-entry) "\\.gpg\\'") never) (t gpg)))
;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
(defcustom auth-source-netrc-use-gpg-tokens 'never
(const :tag "Match anything" t)
(const :tag "The EPA encrypted file extensions"
,(if (boundp 'epa-file-auto-mode-alist-entry)
- (car (symbol-value
- 'epa-file-auto-mode-alist-entry))
+ (car epa-file-auto-mode-alist-entry)
"\\.gpg\\'"))
(regexp :tag "Regular expression"))
(choice :tag "What to do"
automatically. See Info node `(epa)Encrypting/decrypting gpg files'
for details.
-It's best to customize this with `M-x customize-variable' because the choices
+It's best to customize this with `\\[customize-variable]' because the choices
can get pretty complex."
:group 'auth-source
:version "24.1" ;; No Gnus
;; (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))
(plist-get entry :source)
:source (plist-get entry :source)
:type 'plstore
- :search-function 'auth-source-plstore-search
- :create-function 'auth-source-plstore-create
+ :search-function #'auth-source-plstore-search
+ :create-function #'auth-source-plstore-create
:data (plstore-open (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)))
+ :search-function #'auth-source-netrc-search
+ :create-function #'auth-source-netrc-create)))
;; the MacOS Keychain
((and
(format "Mac OS Keychain (%s)" source)
:source source
:type keychain-type
- :search-function 'auth-source-macos-keychain-search
- :create-function 'auth-source-macos-keychain-create)))
+ :search-function #'auth-source-macos-keychain-search
+ :create-function #'auth-source-macos-keychain-create)))
;; the Secrets API. We require the package, in order to have a
;; defined value for `secrets-enabled'.
(format "Secrets API (%s)" source)
:source source
:type 'secrets
- :search-function 'auth-source-secrets-search
- :create-function 'auth-source-secrets-create)
+ :search-function #'auth-source-secrets-search
+ :create-function #'auth-source-secrets-create)
(auth-source-do-warn
"auth-source-backend-parse: no Secrets API, ignoring spec: %S" entry)
(auth-source-backend
(t
(auth-source-do-warn
"auth-source-backend-parse: invalid backend spec: %S" entry)
- (auth-source-backend
- "Empty"
+ (make-instance 'auth-source-backend
:source ""
:type 'ignore)))))
;; (mapcar 'auth-source-backend-parse auth-sources)
(defun* auth-source-search (&rest spec
- &key type max host user port secret
+ &key max
require create delete
&allow-other-keys)
"Search or modify authentication backends according to SPEC.
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
;; note that we may have cached results but found is still nil
;; (there were no results from the search)
(found (auth-source-recall spec))
- filtered-backends accessor-key backend)
+ filtered-backends)
(if (and cached auth-source-do-cache)
(auth-source-do-debug
(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)))
+ (condition-case nil
+ (unless (auth-source-search-collection
+ (plist-get spec key)
+ (slot-value backend key))
(setq filtered-backends (delq backend filtered-backends))
(return))
- (invalid-slot-name))))
+ (invalid-slot-name nil))))
(auth-source-do-trivia
"auth-source-search: found %d backends matching %S"
(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)
+ :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
(auth-source-do-trivia
"auth-source-search-backend: got %d (max %d) in %s:%s matching %S"
(length bmatches) max
- (slot-value backend :type)
- (slot-value backend :source)
+ (slot-value backend 'type)
+ (slot-value backend 'source)
spec)
(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-search :host "nonesuch" :type 'secrets)
-(defun* auth-source-delete (&rest spec
- &key delete
- &allow-other-keys)
+(defun auth-source-delete (&rest spec)
"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.
;; (auth-source-recall '(:host t))
;; (auth-source-forget+ :host t)
-(defun* auth-source-forget+ (&rest spec &allow-other-keys)
+(defun auth-source-forget+ (&rest spec)
"Forget any cached data matching SPEC. Returns forgotten count.
This is not a full `auth-source-search' spec but works similarly.
;; (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)
prompt)
(defun auth-source-ensure-strings (values)
- (unless (listp values)
- (setq values (list values)))
- (mapcar (lambda (value)
- (if (numberp value)
- (format "%s" value)
- value))
- values))
+ (if (eq values t)
+ values
+ (unless (listp values)
+ (setq values (list values)))
+ (mapcar (lambda (value)
+ (if (numberp value)
+ (format "%s" value)
+ value))
+ values)))
;;; Backend specific parsing: netrc/authinfo backend
(cdr (assoc key alist)))
;; (auth-source-netrc-parse :file "~/.authinfo.gpg")
-(defun* auth-source-netrc-parse (&rest
- spec
- &key file max host user port delete require
+(defun* auth-source-netrc-parse (&key file max host user port require
&allow-other-keys)
"Parse FILE and return a list of all entries in the file.
Note that the MAX parameter is used so we can exit the parse early."
(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)
(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))
(defvar auth-source-passphrase-alist nil)
-(defun auth-source-token-passphrase-callback-function (context key-id file)
+(defun auth-source-token-passphrase-callback-function (_context _key-id file)
(let* ((file (file-truename file))
(entry (assoc file auth-source-passphrase-alist))
passphrase)
FILE is the file from which we obtained this token."
(when (string-match "^gpg:\\(.+\\)" secret)
(setq secret (base64-decode-string (match-string 1 secret))))
- (let ((context (epg-make-context 'OpenPGP))
- plain)
+ (let ((context (epg-make-context 'OpenPGP)))
(epg-context-set-passphrase-callback
context
(cons #'auth-source-token-passphrase-callback-function
file))
(epg-decrypt-string context secret)))
+(defvar pp-escape-newlines)
+
;; (insert (auth-source-epa-make-gpg-token "mysecret" "~/.netrc"))
(defun auth-source-epa-make-gpg-token (secret file)
(let ((context (epg-make-context 'OpenPGP))
(point-min)
(point-max))))))
+(defun auto-source--symbol-keyword (symbol)
+ (intern (format ":%s" symbol)))
+
(defun auth-source-netrc-normalize (alist filename)
(mapcar (lambda (entry)
(let (ret item)
(setq lexv (funcall token-decoder lexv)))
lexv))))
(setq ret (plist-put ret
- (intern (concat ":" k))
+ (auto-source--symbol-keyword k)
v))))
ret))
alist))
(defun* auth-source-netrc-search (&rest
spec
- &key backend require create delete
+ &key backend require create
type max host user port
&allow-other-keys)
"Given a property list SPEC, return search matches from the :backend.
(auth-source-netrc-parse
:max max
:require require
- :delete delete
:file (oref backend source)
:host (or host t)
:user (or user t)
;; 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))
(defun* auth-source-netrc-create (&rest spec
&key backend
- secret host user port create
+ host port create
&allow-other-keys)
(let* ((base-required '(host user port secret))
;; we know (because of an assertion in auth-source-search) that the
;; fill in the valist with whatever data we may have from the search
;; we complete the first value if it's a list and use the value otherwise
(dolist (br base-required)
- (when (symbol-value br)
- (let ((br-choice (cond
- ;; all-accepting choice (predicate is t)
- ((eq t (symbol-value br)) nil)
- ;; just the value otherwise
- (t (symbol-value br)))))
- (when br-choice
- (auth-source--aput valist br br-choice)))))
+ (let ((val (plist-get spec (auto-source--symbol-keyword br))))
+ (when val
+ (let ((br-choice (cond
+ ;; all-accepting choice (predicate is t)
+ ((eq t val) nil)
+ ;; just the value otherwise
+ (t val))))
+ (when br-choice
+ (auth-source--aput valist br br-choice))))))
;; for extra required elements, see if the spec includes a value for them
(dolist (er create-extra)
- (let ((name (concat ":" (symbol-name er)))
+ (let ((k (auto-source--symbol-keyword er))
(keys (loop for i below (length spec) by 2
collect (nth i spec))))
- (dolist (k keys)
- (when (equal (symbol-name k) name)
- (auth-source--aput valist er (plist-get spec k))))))
+ (when (memq k keys)
+ (auth-source--aput valist er (plist-get spec k)))))
;; for each required element
(dolist (r required)
;; take the first element if the data is a list
(data (or (auth-source-netrc-element-or-first data)
(plist-get current-data
- (intern (format ":%s" r) obarray))))
+ (auto-source--symbol-keyword r))))
;; this is the default to be offered
(given-default (auth-source--aget
auth-source-creation-defaults r))
(setq data (or data
(if (eq r 'secret)
;; Special case prompt for passwords.
- ;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") nil) (t gpg)))
+ ;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car epa-file-auto-mode-alist-entry) "\\.gpg\\'") nil) (t gpg)))
;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
(let* ((ep (format "Use GPG password tokens in %s?" file))
(gpg-encrypt
(when (or (eq (car item) t)
(string-match (car item) file))
(setq ret (cdr item))
- (setq check nil)))))
+ (setq check nil)))
+ ;; FIXME: `ret' unused.
+ ;; Should we return it here?
+ ))
(t 'never)))
(plain (or (eval default) (read-passwd prompt))))
;; ask if we don't know what to do (in which case
(when data
(setq artificial (plist-put artificial
- (intern (concat ":" (symbol-name r)))
+ (auto-source--symbol-keyword r)
(if (eq r 'secret)
(lexical-let ((data data))
(lambda () data))
(defun* auth-source-secrets-search (&rest
spec
- &key backend create delete label
- type max host user port
+ &key backend create delete label max
&allow-other-keys)
"Search the Secrets API; spec is like `auth-source'.
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\"))
"
;; build a search spec without the ignored keys
;; if a search key is nil or t (match anything), we skip it
(search-specs (auth-source-secrets-listify-pattern
- (apply 'append (mapcar
+ (apply #'append (mapcar
(lambda (k)
(if (or (null (plist-get spec k))
(eq t (plist-get spec k)))
(items
(loop for search-spec in search-specs
nconc
- (loop for item in (apply 'secrets-search-items coll search-spec)
+ (loop for item in (apply #'secrets-search-items coll search-spec)
unless (and (stringp label)
(not (string-match label item)))
collect item)))
(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
items)))
items))
-(defun* auth-source-secrets-create (&rest
- spec
- &key backend type max host user port
- &allow-other-keys)
+(defun auth-source-secrets-create (&rest spec)
;; TODO
;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec)
(debug spec))
;; (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
- &key backend create delete label
- type max host user port
+ &key backend create delete
+ type max
&allow-other-keys)
"Search the MacOS Keychain; spec is like `auth-source'.
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\").
Similarly, :host maps to \"-s HOST\", :user maps to \"-a USER\",
and :port maps to \"-P PORT\" or \"-r PROT\"
-(note PROT has to be a 4-character string).
+\(note PROT has to be a 4-character string).
For the generic 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
items)))
items))
-(defun* auth-source-macos-keychain-search-items (coll type max
- &rest spec
+(defun* auth-source-macos-keychain-search-items (coll _type _max
&key label type
host user port
&allow-other-keys)
(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))))
(defun auth-source-macos-keychain-result-append (result generic k v)
(push v result)
- (setq k (cond
- ((equal k "acct") "user")
- ;; for generic keychains, creator is host, service is port
- ((and generic (equal k "crtr")) "host")
- ((and generic (equal k "svce")) "port")
- ;; for internet keychains, protocol is port, server is host
- ((and (not generic) (equal k "ptcl")) "port")
- ((and (not generic) (equal k "srvr")) "host")
- (t k)))
-
- (push (intern (format ":%s" k)) result))
-
-(defun* auth-source-macos-keychain-create (&rest
- spec
- &key backend type max host user port
- &allow-other-keys)
+ (push (auto-source--symbol-keyword
+ (cond
+ ((equal k "acct") "user")
+ ;; for generic keychains, creator is host, service is port
+ ((and generic (equal k "crtr")) "host")
+ ((and generic (equal k "svce")) "port")
+ ;; for internet keychains, protocol is port, server is host
+ ((and (not generic) (equal k "ptcl")) "port")
+ ((and (not generic) (equal k "srvr")) "host")
+ (t k)))
+ result))
+
+(defun auth-source-macos-keychain-create (&rest spec)
;; TODO
(debug spec))
(defun* auth-source-plstore-search (&rest
spec
- &key backend create delete label
- type max host user port
+ &key backend create delete
+ max
&allow-other-keys)
"Search the PLSTORE; spec is like `auth-source'."
(let* ((store (oref backend data))
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)
(defun* auth-source-plstore-create (&rest spec
&key backend
- secret host user port create
+ host port create
&allow-other-keys)
(let* ((base-required '(host user port secret))
(base-secret '(secret))
:host host
:port port)))
(required (append base-required create-extra))
- (file (oref backend source))
- (add "")
;; `valist' is an alist
valist
;; `artificial' will be returned if no creation is needed
;; fill in the valist with whatever data we may have from the search
;; we complete the first value if it's a list and use the value otherwise
(dolist (br base-required)
- (when (symbol-value br)
- (let ((br-choice (cond
- ;; all-accepting choice (predicate is t)
- ((eq t (symbol-value br)) nil)
- ;; just the value otherwise
- (t (symbol-value br)))))
- (when br-choice
- (auth-source--aput valist br br-choice)))))
+ (let ((val (plist-get spec (auto-source--symbol-keyword br))))
+ (when val
+ (let ((br-choice (cond
+ ;; all-accepting choice (predicate is t)
+ ((eq t val) nil)
+ ;; just the value otherwise
+ (t val))))
+ (when br-choice
+ (auth-source--aput valist br br-choice))))))
;; for extra required elements, see if the spec includes a value for them
(dolist (er create-extra)
- (let ((name (concat ":" (symbol-name er)))
+ (let ((k (auto-source--symbol-keyword er))
(keys (loop for i below (length spec) by 2
collect (nth i spec))))
- (dolist (k keys)
- (when (equal (symbol-name k) name)
- (auth-source--aput valist er (plist-get spec k))))))
+ (when (memq k keys)
+ (auth-source--aput valist er (plist-get spec k)))))
;; for each required element
(dolist (r required)
;; take the first element if the data is a list
(data (or (auth-source-netrc-element-or-first data)
(plist-get current-data
- (intern (format ":%s" r) obarray))))
+ (auto-source--symbol-keyword r))))
;; this is the default to be offered
(given-default (auth-source--aget
auth-source-creation-defaults r))
(if (member r base-secret)
(setq secret-artificial
(plist-put secret-artificial
- (intern (concat ":" (symbol-name r)))
+ (auto-source--symbol-keyword r)
data))
(setq artificial (plist-put artificial
- (intern (concat ":" (symbol-name r)))
+ (auto-source--symbol-keyword r)
data))))))
(plstore-put (oref backend data)
(sha1 (format "%s@%s:%s"
(let* ((listy (listp mode))
(mode (if listy mode (list mode)))
- (cname (if username
- (format "%s %s:%s %s" mode host port username)
- (format "%s %s:%s" mode host port)))
+ ;; (cname (if username
+ ;; (format "%s %s:%s %s" mode host port username)
+ ;; (format "%s %s:%s" mode host port)))
(search (list :host host :port port))
(search (if username (append search (list :user username)) search))
(search (if create-missing
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