;;; auth-source.el --- authentication sources for Gnus and Emacs
-;; Copyright (C) 2008-2015 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"
;; (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
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
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"
(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 :max, :require, :create, and :delete
:max max
(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 :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)
(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'.
;; 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))
(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'.
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\").
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
(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