1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 14:30:50 -08:00

Add fallback backend in auth-sources

* etc/NEWS: Describe effect of auth-sources being nil.

* lisp/auth-source.el (auth-sources): Add const nil.
(auth-source-ignored-keys): New defconst.
(auth-source-backends, auth-source-keys)
(auth-source-search-keys, auth-source-returned-keys)
(auth-source-search-spec): New macros.
(auth-source-file-name-p, auth-source-search)
(auth-source-specmatchp, auth-source-netrc-create)
(auth-source-secrets-search, auth-source-secrets-create)
(auth-source-macos-keychain-search)
(auth-source-plstore-search, auth-source-plstore-create): Use them
(auth-source-read-passwd-search, auth-source-read-passwd-create):
New defuns.

* test/lisp/auth-source-tests.el
(auth-source-backend-parse-plstore-string)
(auth-source-backend-parse-json-string)
(auth-source-backend-parse-fallback)
(auth-source-test-read-passwd-create-secret): New tests.
This commit is contained in:
Michael Albinus 2025-10-05 17:14:59 +02:00
parent 5c459c6084
commit a142cc262e
3 changed files with 283 additions and 113 deletions

View file

@ -216,14 +216,14 @@ different values for completion-affecting variables like
applies for the styles configuration in 'completion-category-overrides' applies for the styles configuration in 'completion-category-overrides'
and 'completion-category-defaults'. and 'completion-category-defaults'.
+++++ +++
*** Navigating "*Completions*" now accommodates 'completions-format'. *** Navigating "*Completions*" now accommodates 'completions-format'.
When 'completions-format' is set to 'vertical', typing 'n', '<TAB>' or When 'completions-format' is set to 'vertical', typing 'n', 'TAB' or
'M-<down>' in the "*Completions*" buffer (the latter also in the 'M-<down>' in the "*Completions*" buffer (the latter also in the
minibuffer) now moves point to the completion candidate in the next line minibuffer) now moves point to the completion candidate in the next line
in the current column, and wraps to the next column when typed on the in the current column, and wraps to the next column when typed on the
last completion candidate of the current column. Likewise, typing 'p', last completion candidate of the current column. Likewise, typing 'p',
'S-<TAB>' or 'M-<up>' moves point to the completion candidate in the 'S-TAB' or 'M-<up>' moves point to the completion candidate in the
previous line or wraps to the previous column. Previously, these keys previous line or wraps to the previous column. Previously, these keys
ignored the vertical format, i.e., moved point only to the item in the ignored the vertical format, i.e., moved point only to the item in the
same line of the next or previous column, in accordance with the default same line of the next or previous column, in accordance with the default
@ -272,7 +272,7 @@ but as a plain Lisp variable, not a user option.)
--- ---
*** New mode 'minibuffer-nonselected-mode'. *** New mode 'minibuffer-nonselected-mode'.
This mode enabled by default directs the attention to the active This mode, enabled by default, directs the attention to the active
minibuffer window using the 'minibuffer-nonselected' face in case minibuffer window using the 'minibuffer-nonselected' face in case
when the minibuffer window is no longer selected, but the minibuffer when the minibuffer window is no longer selected, but the minibuffer
is still waiting for input. is still waiting for input.
@ -280,7 +280,7 @@ is still waiting for input.
** Mouse ** Mouse
*** New mode 'mouse-shift-adjust-mode' extends selection with 'S-<mouse-1>'. *** New mode 'mouse-shift-adjust-mode' extends selection with 'S-<mouse-1>'.
When enabled, you can use the left mouse button with the <Shift> modifier When enabled, you can use the left mouse button with the '<Shift>' modifier
to extend the boundaries of the active region by dragging the mouse pointer. to extend the boundaries of the active region by dragging the mouse pointer.
--- ---
@ -750,7 +750,7 @@ pair: '("/*" " */" t)'.
--- ---
** New user option 'electric-indent-actions'. ** New user option 'electric-indent-actions'.
This user options specifies a list of actions to reindent. The possible This user option specifies a list of actions to reindent. The possible
elements for this list are: 'yank', reindent the yanked text; elements for this list are: 'yank', reindent the yanked text;
'before-save', indent the whole buffer before saving it. 'before-save', indent the whole buffer before saving it.
@ -810,6 +810,9 @@ in such a file; the first usable entry of auth-sources is selected as
target. If you want also not existing files to be selected, set the target. If you want also not existing files to be selected, set the
user option auth-source-ignore-non-existing-file to nil. user option auth-source-ignore-non-existing-file to nil.
---
*** 'auth-sources' set to nil means using the password cache only.
** Autoinsert ** Autoinsert
+++ +++
@ -823,7 +826,7 @@ with finer grained control.
+++ +++
*** New functions 'buffer-to-register' and 'file-to-register'. *** New functions 'buffer-to-register' and 'file-to-register'.
These allow users to interactively store file and buffers in registers. These allow users to interactively store files and buffers in registers.
Killed buffers stored in a register using 'buffer-to-register' are Killed buffers stored in a register using 'buffer-to-register' are
automatically converted to a file-query value if the buffer was visiting automatically converted to a file-query value if the buffer was visiting
a file. a file.
@ -1010,28 +1013,27 @@ next to the ellipsis. By default this is disabled.
+++ +++
*** New user option 'hs-show-indicators'. *** New user option 'hs-show-indicators'.
This user option determines if hideshow should display indicators to This user option determines if Hideshow should display indicators to
show and toggle the block hiding. If non-nil, the indicators are enabled. show and toggle the block hiding. If non-nil, the indicators are enabled.
By default this is disabled. By default this is disabled.
*** New user option 'hs-indicator-maximum-buffer-size'. *** New user option 'hs-indicator-maximum-buffer-size'.
This user option limits the display of hideshow indicators to buffers This user option limits the display of Hideshow indicators to buffers
that are not too large. By default, buffers larger than 2MB have the that are not too large. By default, buffers larger than 2MB have the
indicators disabled; the value of nil will activate the indicators indicators disabled; the value of nil will activate the indicators
regardless of the buffer size. regardless of the buffer size.
+++ +++
*** New user option 'hs-indicator-type'. *** New user option 'hs-indicator-type'.
This user option determine which indicator type should be used for the This user option determines which indicator type should be used for the
block indicators. block indicators.
The possible values can be: 'fringe', display the indicators in the The possible values can be: 'fringe', display the indicators in the
fringe (the default); 'margin', display the indicators in the margin; fringe (the default); 'margin', display the indicators in the margin;
nil, display the indicators at end-of-line. nil, display the indicators at end-of-line.
The new icons 'hs-indicator-show' and 'hs-indicator-hide', can be used The new icons 'hs-indicator-show' and 'hs-indicator-hide' can be used
for customize the indicators appearance, only if 'hs-indicator-type' is to customize the indicators appearance only if 'hs-indicator-type' is
set to 'margin' or nil. set to 'margin' or nil.
** C-ts mode ** C-ts mode
@ -1043,9 +1045,9 @@ are highlighted like other comments. When non-nil, Doxygen comment
blocks are syntax-highlighted if the Doxygen grammar library is blocks are syntax-highlighted if the Doxygen grammar library is
available. available.
** Csharp-ts-mode ** Csharp-ts mode
*** Renamed feature in 'treesit-font-lock-feature-list' *** Renamed feature in 'treesit-font-lock-feature-list'.
The feature 'property' has been renamed to 'attribute', since this is The feature 'property' has been renamed to 'attribute', since this is
what it is called in the general C# community. what it is called in the general C# community.
@ -1491,8 +1493,8 @@ It removes all the buttons in the specified region.
You can now bookmark local and remote shell buffers using the bookmark You can now bookmark local and remote shell buffers using the bookmark
menu 'bookmark-bmenu-list', or by using the command 'bookmark-set'. menu 'bookmark-bmenu-list', or by using the command 'bookmark-set'.
Shell bookmarks can be loaded via the menu and by using the command Shell bookmarks can be loaded via the menu and by using the command
'bookmark-jump', which open a bookmarked shell, restore its buffer name, 'bookmark-jump', which opens a bookmarked shell, restores its buffer name,
its current directory, and create a remote connection, if necessary. its current directory, and creates a remote connection, if necessary.
You can customize 'shell-bookmark-name-function'. You can customize 'shell-bookmark-name-function'.
*** New command to complete the shell history. *** New command to complete the shell history.
@ -3019,8 +3021,8 @@ commands '{next,previous}-column-completion', depending on the value of
'completions-format'. The latter two commands improve and extend the 'completions-format'. The latter two commands improve and extend the
previous implementations of '{next,previous}-completion', which better previous implementations of '{next,previous}-completion', which better
reflect that they only take the (default) horizontal completions format reflect that they only take the (default) horizontal completions format
into account. Any external code using '{next,previous}-completion' that into account. Any external code using '{next,previous}-completion', that
assumes the previous implementation must be adjusted accordingly; see assumes the previous implementation, must be adjusted accordingly; see
'minibuffer-next-completion' for an example of such an adjustment in 'minibuffer-next-completion' for an example of such an adjustment in
Emacs core. Emacs core.

View file

@ -234,10 +234,14 @@ EPA/EPG set up, the file will be encrypted and decrypted
automatically. See Info node `(epa)Encrypting/decrypting gpg files' automatically. See Info node `(epa)Encrypting/decrypting gpg files'
for details. for details.
If this option is nil, no authentication source is used but the local
password cache.
It's best to customize this with \\[customize-variable] because It's best to customize this with \\[customize-variable] because
the choices can get pretty complex." the choices can get pretty complex."
:version "26.1" ; neither new nor changed default :version "26.1" ; neither new nor changed default
:type `(repeat :tag "Authentication Sources" :type `(choice (const :tag "Password cache" nil)
(repeat :tag "Authentication Sources"
(choice (choice
(string :tag "Just a file") (string :tag "Just a file")
(const :tag "Default Secrets API Collection" default) (const :tag "Default Secrets API Collection" default)
@ -301,7 +305,7 @@ the choices can get pretty complex."
(const :tag "Any" t) (const :tag "Any" t)
(string (string
:tag "Name")))))) :tag "Name"))))))
(sexp :tag "A data structure (external provider)"))) (sexp :tag "A data structure (external provider)"))))
:link '(custom-manual "(auth) Help for users")) :link '(custom-manual "(auth) Help for users"))
(defcustom auth-source-gpg-encrypt-to t (defcustom auth-source-gpg-encrypt-to t
@ -370,6 +374,44 @@ soon as a function returns non-nil.")
:type 'ignore))) :type 'ignore)))
(auth-source-backend-parse-parameters entry backend))) (auth-source-backend-parse-parameters entry backend)))
(defmacro auth-source-backends ()
"List of usable backends from `auth-sources'.
A fallback backend is added to ensure, that at least `read-passwd' is called."
`(or (mapcar #'auth-source-backend-parse auth-sources)
;; Fallback.
(list (auth-source-backend
:source ""
:type 'read-passwd
:search-function #'auth-source-read-passwd-search
:create-function #'auth-source-read-passwd-create))))
(defmacro auth-source-keys (spec)
"Return keys from SPEC."
`(cl-loop for i below (length ,spec) by 2
collect (nth i ,spec)))
(defconst auth-source-ignored-keys
'(:create :delete :max :backend :label :require :type)
"List of meta keys to be ignored in data stores.")
(defmacro auth-source-search-keys (spec)
"Filter out ignored keys from SPEC."
`(seq-difference (auth-source-keys ,spec) auth-source-ignored-keys))
(defmacro auth-source-returned-keys (spec)
"Needed keys (always including host, login, port, and secret)."
`(seq-union '(:host :login :port :secret) (auth-source-search-keys ,spec)))
(defmacro auth-source-search-spec (spec)
"Build a search spec without the ignored keys.
If a search key is nil or t (match anything), skip it."
`(seq-keep
(lambda (k)
(and-let* ((v (plist-get ,spec k))
((not (eq t v)))
((cons k (auth-source-ensure-strings v))))))
(auth-source-search-keys spec)))
(defcustom auth-source-ignore-non-existing-file t (defcustom auth-source-ignore-non-existing-file t
"If set non-nil, file-based backends are ignored if the file does not exist. "If set non-nil, file-based backends are ignored if the file does not exist.
Consequently, no newly created entry is saved in such a backend when Consequently, no newly created entry is saved in such a backend when
@ -424,7 +466,8 @@ Supported backend types are `netrc', `plstore' and `json'."
:create-function #'auth-source-netrc-create))))) :create-function #'auth-source-netrc-create)))))
;; Note this function should be last in the parser functions, so we add it first ;; Note this function should be last in the parser functions, so we add it first
(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-file) (add-hook 'auth-source-backend-parser-functions
#'auth-source-backends-parser-file)
(defun auth-source-backends-parser-macos-keychain (entry) (defun auth-source-backends-parser-macos-keychain (entry)
;; take macos-keychain-{internet,generic}:XYZ and use it as macOS ;; take macos-keychain-{internet,generic}:XYZ and use it as macOS
@ -470,7 +513,8 @@ Supported backend types are `netrc', `plstore' and `json'."
:search-function #'auth-source-macos-keychain-search :search-function #'auth-source-macos-keychain-search
:create-function #'auth-source-macos-keychain-create))))) :create-function #'auth-source-macos-keychain-create)))))
(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-macos-keychain) (add-hook 'auth-source-backend-parser-functions
#'auth-source-backends-parser-macos-keychain)
(defun auth-source-backends-parser-secrets (entry) (defun auth-source-backends-parser-secrets (entry)
;; take secrets:XYZ and use it as Secrets API collection "XYZ" ;; take secrets:XYZ and use it as Secrets API collection "XYZ"
@ -515,7 +559,8 @@ Supported backend types are `netrc', `plstore' and `json'."
:source "" :source ""
:type 'ignore)))))) :type 'ignore))))))
(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-secrets) (add-hook 'auth-source-backend-parser-functions
#'auth-source-backends-parser-secrets)
(defun auth-source-backend-parse-parameters (entry backend) (defun auth-source-backend-parse-parameters (entry backend)
"Fill in the extra `auth-source-backend' parameters of ENTRY. "Fill in the extra `auth-source-backend' parameters of ENTRY.
@ -537,7 +582,7 @@ parameters."
(defun auth-source-file-name-p (file) (defun auth-source-file-name-p (file)
"Say whether FILE is used by `auth-sources'." "Say whether FILE is used by `auth-sources'."
(let* ((backends (mapcar #'auth-source-backend-parse auth-sources)) (let* ((backends (auth-source-backends))
(files (files
(mapcar (lambda (x) (mapcar (lambda (x)
(when (member (slot-value x 'type) '(json netrc plstore)) (when (member (slot-value x 'type) '(json netrc plstore))
@ -695,12 +740,8 @@ actually useful. So the caller must arrange to call this function.
The token's :secret key can hold a function. In that case you The token's :secret key can hold a function. In that case you
must call it to obtain the actual value." must call it to obtain the actual value."
(let* ((backends (mapcar #'auth-source-backend-parse auth-sources)) (let* ((backends (auth-source-backends))
(max (or max 1)) (max (or max 1))
(ignored-keys '(:require :create :delete :max))
(keys (cl-loop for i below (length spec) by 2
unless (memq (nth i spec) ignored-keys)
collect (nth i spec)))
(cached (auth-source-remembered-p spec)) (cached (auth-source-remembered-p spec))
;; note that we may have cached results but found is still nil ;; note that we may have cached results but found is still nil
;; (there were no results from the search) ;; (there were no results from the search)
@ -722,7 +763,7 @@ must call it to obtain the actual value."
(setq filtered-backends (copy-sequence backends)) (setq filtered-backends (copy-sequence backends))
(dolist (backend backends) (dolist (backend backends)
(cl-dolist (key keys) (cl-dolist (key (auth-source-search-keys spec))
;; ignore invalid slots ;; ignore invalid slots
(condition-case nil (condition-case nil
(unless (auth-source-search-collection (unless (auth-source-search-collection
@ -837,6 +878,7 @@ Returns the deleted entries."
(defun auth-source-format-cache-entry (spec) (defun auth-source-format-cache-entry (spec)
"Format SPEC entry to put it in the password cache." "Format SPEC entry to put it in the password cache."
`(auth-source . ,spec)) `(auth-source . ,spec))
;; `(auth-source . ,(auth-source-search-spec spec)))
(defun auth-source-remember (spec found) (defun auth-source-remember (spec found)
"Remember FOUND search results for SPEC." "Remember FOUND search results for SPEC."
@ -880,8 +922,7 @@ while \(:host t) would find all host entries."
count)) count))
(defun auth-source-specmatchp (spec stored) (defun auth-source-specmatchp (spec stored)
(let ((keys (cl-loop for i below (length spec) by 2 (let ((keys (auth-source-keys spec)))
collect (nth i spec))))
(not (eq (not (eq
(cl-dolist (key keys) (cl-dolist (key keys)
(unless (auth-source-search-collection (plist-get stored key) (unless (auth-source-search-collection (plist-get stored key)
@ -898,7 +939,8 @@ while \(:host t) would find all host entries."
(defun auth-source-pick-first-password (&rest spec) (defun auth-source-pick-first-password (&rest spec)
"Pick the first secret found by applying `auth-source-search' to SPEC." "Pick the first secret found by applying `auth-source-search' to SPEC."
(auth-info-password (car (apply #'auth-source-search (plist-put spec :max 1))))) (auth-info-password
(car (apply #'auth-source-search (plist-put spec :max 1)))))
(defun auth-source-format-prompt (prompt alist) (defun auth-source-format-prompt (prompt alist)
"Format PROMPT using %x (for any character x) specifiers in ALIST. "Format PROMPT using %x (for any character x) specifiers in ALIST.
@ -923,8 +965,6 @@ Remove trailing \": \"."
value)) value))
values))) values)))
;;; Backend specific parsing: netrc/authinfo backend
(defun auth-source--aput-1 (alist key val) (defun auth-source--aput-1 (alist key val)
(let ((seen ()) (let ((seen ())
(rest alist)) (rest alist))
@ -940,6 +980,123 @@ Remove trailing \": \"."
(defun auth-source--aget (alist key) (defun auth-source--aget (alist key)
(cdr (assoc key alist))) (cdr (assoc key alist)))
;;; Backend specific parsing: just read the password
(cl-defun auth-source-read-passwd-search (&rest spec
&key backend create delete
&allow-other-keys)
"Search in password cache; spec is like `auth-source'."
;; TODO
(cl-assert
(not delete) nil
"The `read-passwd' auth-source backend doesn't support deletion yet")
(let ((found (auth-source-recall (auth-source-search-spec spec))))
(cond
(found (list found))
(create (apply (slot-value backend 'create-function) spec)))))
(cl-defun auth-source-read-passwd-create (&rest spec
&key host port user
&allow-other-keys)
(let* ((base-required '(host user port secret))
;; we know (because of an assertion in auth-source-search) that the
;; :create parameter is either t or a list (which includes nil)
(current-data (car (auth-source-search :max 1
:host host
:user user
:port port)))
;; `valist' is an alist
valist
;; `artificial' will be returned if no creation is needed
artificial)
;; only for base required elements (defined as function parameters):
;; 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)
(let ((val (plist-get spec (auth-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 each required element
(dolist (r base-required)
(let* ((data (auth-source--aget valist r))
;; take the first element if the data is a list
(data (or (auth-source-netrc-element-or-first data)
(plist-get current-data
(auth-source--symbol-keyword r))))
;; this is the default to be offered
(given-default (auth-source--aget
auth-source-creation-defaults r))
;; the default supplementals are simple:
;; for the user, try `given-default' and then (user-login-name);
;; otherwise take `given-default'
(default (cond
((and (not given-default) (eq r 'user))
(user-login-name))
(t given-default)))
(printable-defaults (list
(cons 'user
(or
(auth-source-netrc-element-or-first
(auth-source--aget valist 'user))
(plist-get artificial :user)
"[any user]"))
(cons 'host
(or
(auth-source-netrc-element-or-first
(auth-source--aget valist 'host))
(plist-get artificial :host)
"[any host]"))
(cons 'port
(or
(auth-source-netrc-element-or-first
(auth-source--aget valist 'port))
(plist-get artificial :port)
"[any port]"))))
(prompt (or (auth-source--aget auth-source-creation-prompts r)
(cl-case r
(secret "%p password for %u@%h")
(user "%p user name for %h")
(host "%p host name for user %u")
(port "%p port for %u@%h"))
(format "Enter %s (%%u@%%h:%%p)" r)))
(prompt (auth-source-format-prompt
prompt
`((?u ,(auth-source--aget printable-defaults 'user))
(?h ,(auth-source--aget printable-defaults 'host))
(?p ,(auth-source--aget printable-defaults 'port))))))
;; Store the data, prompting for the password if needed.
(setq data (or data
(if (eq r 'secret)
(or (eval default)
(read-passwd (format-prompt prompt nil)))
(if (and (stringp default) auth-source-save-behavior)
(read-string
(format-prompt prompt default) nil nil default)
(eval default)))))
(when data
(setq artificial (plist-put artificial
(auth-source--symbol-keyword r)
(if (eq r 'secret)
(let ((data data))
(lambda () data))
data))))))
(list artificial)))
;;; Backend specific parsing: netrc/authinfo backend
;;;###autoload ;;;###autoload
(defun auth-source-netrc-parse-all (file) (defun auth-source-netrc-parse-all (file)
"Parse FILE and return all entries." "Parse FILE and return all entries."
@ -1360,8 +1517,7 @@ See `auth-source-search' for details on SPEC."
;; for extra required elements, see if the spec includes a value for them ;; for extra required elements, see if the spec includes a value for them
(dolist (er create-extra) (dolist (er create-extra)
(let ((k (auth-source--symbol-keyword er)) (let ((k (auth-source--symbol-keyword er))
(keys (cl-loop for i below (length spec) by 2 (keys (auth-source-keys spec)))
collect (nth i spec))))
(when (memq k keys) (when (memq k keys)
(auth-source--aput valist er (plist-get spec k))))) (auth-source--aput valist er (plist-get spec k)))))
@ -1645,30 +1801,11 @@ authentication tokens:
(let* ((coll (oref backend source)) (let* ((coll (oref backend source))
(max (or max 5000)) ; sanity check: default to stop at 5K (max (or max 5000)) ; sanity check: default to stop at 5K
(ignored-keys '(:create :delete :max :backend :label :require :type))
(search-keys (cl-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-specs (auth-source-secrets-listify-pattern
(apply #'append (mapcar
(lambda (k)
(let ((v (plist-get spec k)))
(if (or (null v)
(eq t v))
nil
(list
k
(auth-source-ensure-strings v)))))
search-keys))))
;; needed keys (always including host, login, port, and secret)
(returned-keys (delete-dups (append
'(:host :login :port :secret)
search-keys)))
(items (items
(cl-loop (cl-loop
for search-spec in search-specs for search-spec in
(apply #'auth-source-secrets-listify-pattern
(auth-source-search-spec spec))
nconc nconc
(cl-loop for item in (apply #'secrets-search-items coll search-spec) (cl-loop for item in (apply #'secrets-search-items coll search-spec)
unless (and (stringp label) unless (and (stringp label)
@ -1690,7 +1827,7 @@ authentication tokens:
(list (car entry) (cdr entry))) (list (car entry) (cdr entry)))
(secrets-get-attributes coll item))))) (secrets-get-attributes coll item)))))
items)) items))
;; ensure each item has each key in `returned-keys' ;; Ensure each item has each key in `auth-source-returned-keys'.
(items (mapcar (lambda (plist) (items (mapcar (lambda (plist)
(append (append
(apply #'append (apply #'append
@ -1698,7 +1835,7 @@ authentication tokens:
(if (plist-get plist req) (if (plist-get plist req)
nil nil
(list req nil))) (list req nil)))
returned-keys)) (auth-source-returned-keys spec)))
plist)) plist))
items))) items)))
(cond (cond
@ -1758,8 +1895,7 @@ authentication tokens:
;; for extra required elements, see if the spec includes a value for them ;; for extra required elements, see if the spec includes a value for them
(dolist (er create-extra) (dolist (er create-extra)
(let ((k (auth-source--symbol-keyword er)) (let ((k (auth-source--symbol-keyword er))
(keys (cl-loop for i below (length spec) by 2 (keys (auth-source-keys spec)))
collect (nth i spec))))
(when (memq k keys) (when (memq k keys)
(auth-source--aput valist er (plist-get spec k))))) (auth-source--aput valist er (plist-get spec k)))))
@ -1854,7 +1990,8 @@ authentication tokens:
(if (not (eq r 'label)) (if (not (eq r 'label))
;; append the key (the symbol name of r) ;; append the key (the symbol name of r)
;; and the value in r ;; and the value in r
(setq args (append args (list (auth-source--symbol-keyword r) data)))))))) (setq args (append args (list (auth-source--symbol-keyword r)
data))))))))
(when save-function (when save-function
(plist-put (plist-put
@ -1956,25 +2093,8 @@ entries for git.gnus.org:
(let* ((coll (oref backend source)) (let* ((coll (oref backend source))
(max (or max 5000)) ; sanity check: default to stop at 5K (max (or max 5000)) ; sanity check: default to stop at 5K
;; Filter out ignored keys from the spec (auth-source-ignored-keys
(ignored-keys '(:create :delete :max :backend :label :host :port)) (seq-union auth-source-ignored-keys '(:host :port)))
;; Build a search spec without the ignored keys
;; FIXME make this loop a function? it's used in at least 3 places
(search-keys (cl-loop for i below (length spec) by 2
unless (memq (nth i spec) ignored-keys)
collect (nth i spec)))
;; If a search key value is nil or t (match anything), we skip it
(search-spec (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)))
;; needed keys (always including host, login, port, and secret)
(returned-keys (delete-dups (append
'(:host :login :port :secret)
search-keys)))
;; Extract host, port and user from spec ;; Extract host, port and user from spec
(hosts (plist-get spec :host)) (hosts (plist-get spec :host))
(hosts (if (consp hosts) hosts `(,hosts))) (hosts (if (consp hosts) hosts `(,hosts)))
@ -1996,11 +2116,11 @@ entries for git.gnus.org:
type type
max max
host port user host port user
search-spec))) (auth-source-search-spec spec))))
(when items (when items
(throw 'match items)))))))) (throw 'match items))))))))
;; ensure each item has each key in `returned-keys' ;; ensure each item has each key in `auth-source-returned-keys'.
(items (mapcar (lambda (plist) (items (mapcar (lambda (plist)
(append (append
(apply #'append (apply #'append
@ -2008,7 +2128,7 @@ entries for git.gnus.org:
(if (plist-get plist req) (if (plist-get plist req)
nil nil
(list req nil))) (list req nil)))
returned-keys)) (auth-source-returned-keys spec)))
plist)) plist))
items))) items)))
items)) items))
@ -2120,27 +2240,7 @@ entries for git.gnus.org:
"Search the PLSTORE; SPEC is like `auth-source'." "Search the PLSTORE; SPEC is like `auth-source'."
(let* ((store (oref backend data)) (let* ((store (oref backend data))
(max (or max 5000)) ; sanity check: default to stop at 5K (max (or max 5000)) ; sanity check: default to stop at 5K
(ignored-keys '(:create :delete :max :backend :label :require :type)) (items (plstore-find store (auth-source-search-spec spec)))
(search-keys (cl-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 (apply #'append (mapcar
(lambda (k)
(let ((v (plist-get spec k)))
(if (or (null v)
(eq t v))
nil
(list
k
(auth-source-ensure-strings v)))))
search-keys)))
;; needed keys (always including host, login, port, and secret)
(returned-keys (delete-dups (append
'(:host :login :port :secret)
search-keys)))
(items (plstore-find store search-spec))
(item-names (mapcar #'car items)) (item-names (mapcar #'car items))
(items (take max items)) (items (take max items))
;; convert the item to a full plist ;; convert the item to a full plist
@ -2156,7 +2256,7 @@ entries for git.gnus.org:
(lambda () v))))) (lambda () v)))))
plist)) plist))
items)) items))
;; ensure each item has each key in `returned-keys' ;; ensure each item has each key in `auth-source-returned-keys'.
(items (mapcar (lambda (plist) (items (mapcar (lambda (plist)
(append (append
(apply #'append (apply #'append
@ -2164,7 +2264,7 @@ entries for git.gnus.org:
(if (plist-get plist req) (if (plist-get plist req)
nil nil
(list req nil))) (list req nil)))
returned-keys)) (auth-source-returned-keys spec)))
plist)) plist))
items))) items)))
(cond (cond
@ -2230,8 +2330,7 @@ entries for git.gnus.org:
(auth-source--aput valist br br-choice)))))) (auth-source--aput valist br br-choice))))))
;; for extra required elements, see if the spec includes a value for them ;; for extra required elements, see if the spec includes a value for them
(let ((keys (cl-loop for i below (length spec) by 2 (let ((keys (auth-source-keys spec))
collect (nth i spec)))
k) k)
(dolist (er create-extra) (dolist (er create-extra)
(setq k (auth-source--symbol-keyword er)) (setq k (auth-source--symbol-keyword er))
@ -2591,7 +2690,8 @@ by doing (clear-string STRING)."
(second (read-passwd "Confirm password: " nil default))) (second (read-passwd "Confirm password: " nil default)))
(if (equal first second) (if (equal first second)
(progn (progn
(and (arrayp second) (not (eq first second)) (clear-string second)) (and (arrayp second) (not (eq first second))
(clear-string second))
(setq success first)) (setq success first))
(and (arrayp first) (clear-string first)) (and (arrayp first) (clear-string first))
(and (arrayp second) (clear-string second)) (and (arrayp second) (clear-string second))

View file

@ -32,6 +32,13 @@
(require 'auth-source) (require 'auth-source)
(require 'secrets) (require 'secrets)
;; (dolist
;; (elt
;; (append
;; (mapcar #'intern (all-completions "auth-" obarray #'functionp))
;; (mapcar #'intern (all-completions "password-" obarray #'functionp))))
;; (trace-function-background elt))
(defun auth-source-ensure-ignored-backend (source) (defun auth-source-ensure-ignored-backend (source)
(auth-source-validate-backend source '((source . "") (auth-source-validate-backend source '((source . "")
(type . ignore)))) (type . ignore))))
@ -103,6 +110,14 @@
(create-function (create-function
. auth-source-plstore-create)))) . auth-source-plstore-create))))
(ert-deftest auth-source-backend-parse-plstore-string ()
(auth-source-validate-backend "foo.plist"
'((source . "foo.plist")
(type . plstore)
(search-function . auth-source-plstore-search)
(create-function
. auth-source-plstore-create))))
(ert-deftest auth-source-backend-parse-netrc () (ert-deftest auth-source-backend-parse-netrc ()
(auth-source-validate-backend '(:source "foo") (auth-source-validate-backend '(:source "foo")
'((source . "foo") '((source . "foo")
@ -129,6 +144,16 @@
;; . auth-source-json-create)))) ;; . auth-source-json-create))))
. ignore)))) . ignore))))
(ert-deftest auth-source-backend-parse-json-string ()
(auth-source-validate-backend "foo.json"
'((source . "foo.json")
(type . json)
(search-function . auth-source-json-search)
(create-function
;; To be implemented:
;; . auth-source-json-create))))
. ignore))))
(ert-deftest auth-source-backend-parse-secrets () (ert-deftest auth-source-backend-parse-secrets ()
(provide 'secrets) ; simulates the presence of the `secrets' package (provide 'secrets) ; simulates the presence of the `secrets' package
(let ((secrets-enabled t)) (let ((secrets-enabled t))
@ -198,6 +223,20 @@
(auth-source-ensure-ignored-backend '(:source '(foo))) (auth-source-ensure-ignored-backend '(:source '(foo)))
(auth-source-ensure-ignored-backend '(:source nil)))) (auth-source-ensure-ignored-backend '(:source nil))))
(ert-deftest auth-source-backend-parse-fallback ()
(let* (auth-sources
(backends (auth-source-backends))
(backend (car backends))
(validation-alist
'((source . "")
(type . read-passwd)
(search-function . auth-source-read-passwd-search)
(create-function . auth-source-read-passwd-create))))
(should (length= backends 1))
(should (auth-source-backend-p backend))
(dolist (pair validation-alist)
(should (equal (eieio-oref backend (car pair)) (cdr pair))))))
(defun auth-source--test-netrc-parse-entry (entry host user port) (defun auth-source--test-netrc-parse-entry (entry host user port)
"Parse a netrc entry from buffer." "Parse a netrc entry from buffer."
(auth-source-forget-all-cached) (auth-source-forget-all-cached)
@ -434,6 +473,35 @@
(should (string-equal auth-passwd passwd)) (should (string-equal auth-passwd passwd))
(should (search-forward host nil 'noerror))))))))) (should (search-forward host nil 'noerror)))))))))
(ert-deftest auth-source-test-read-passwd-create-secret ()
(let (auth-sources auth-info auth-passwd host)
(auth-source-forget-all-cached)
(dolist (passwd '("foo" "" nil))
(unwind-protect
;; Redefine `read-*' in order to avoid interactive input.
(cl-letf (((symbol-function 'read-passwd) (lambda (_) passwd))
((symbol-function 'read-string)
(lambda (_prompt &optional _initial _history default
_inherit-input-method)
default)))
(setq host
(md5 (concat (prin1-to-string process-environment) passwd))
auth-info
(car (auth-source-search
:max 1 :host host :require '(:user :secret) :create t))
auth-passwd (auth-info-password auth-info))
(should (string-equal (plist-get auth-info :user) (user-login-name)))
(should (string-equal (plist-get auth-info :host) host))
(should (equal auth-passwd passwd))
(should-not (plist-get auth-info :save-function))
;; Check, that the item hasn't been created persistently.
(auth-source-forget+ :host t)
(should-not (auth-source-search :host host)))
;; Cleanup.
t))))
(ert-deftest auth-source-delete () (ert-deftest auth-source-delete ()
(ert-with-temp-file netrc-file (ert-with-temp-file netrc-file
:suffix "auth-source-test" :text "\ :suffix "auth-source-test" :text "\