mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 06:20:55 -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:
parent
5c459c6084
commit
a142cc262e
3 changed files with 283 additions and 113 deletions
40
etc/NEWS
40
etc/NEWS
|
|
@ -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.
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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))
|
||||||
|
|
|
||||||
|
|
@ -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 "\
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue