diff --git a/etc/NEWS b/etc/NEWS index 0c0ee8aa4eb..5e02f43296b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -216,14 +216,14 @@ different values for completion-affecting variables like applies for the styles configuration in 'completion-category-overrides' and 'completion-category-defaults'. -+++++ ++++ *** Navigating "*Completions*" now accommodates 'completions-format'. -When 'completions-format' is set to 'vertical', typing 'n', '' or +When 'completions-format' is set to 'vertical', typing 'n', 'TAB' or 'M-' in the "*Completions*" buffer (the latter also in the 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 last completion candidate of the current column. Likewise, typing 'p', -'S-' or 'M-' moves point to the completion candidate in the +'S-TAB' or 'M-' moves point to the completion candidate in the 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 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'. -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 when the minibuffer window is no longer selected, but the minibuffer is still waiting for input. @@ -280,7 +280,7 @@ is still waiting for input. ** Mouse *** New mode 'mouse-shift-adjust-mode' extends selection with 'S-'. -When enabled, you can use the left mouse button with the modifier +When enabled, you can use the left mouse button with the '' modifier 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'. -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; '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 user option ‘auth-source-ignore-non-existing-file’ to nil. +--- +*** 'auth-sources' set to nil means using the password cache only. + ** Autoinsert +++ @@ -823,7 +826,7 @@ with finer grained control. +++ *** 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 automatically converted to a file-query value if the buffer was visiting a file. @@ -1010,28 +1013,27 @@ next to the ellipsis. By default this is disabled. +++ *** 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. - By default this is disabled. *** 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 indicators disabled; the value of nil will activate the indicators regardless of the buffer size. +++ *** 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. The possible values can be: 'fringe', display the indicators in the fringe (the default); 'margin', display the indicators in the margin; nil, display the indicators at end-of-line. -The new icons 'hs-indicator-show' and 'hs-indicator-hide', can be used -for customize the indicators appearance, only if 'hs-indicator-type' is +The new icons 'hs-indicator-show' and 'hs-indicator-hide' can be used +to customize the indicators appearance only if 'hs-indicator-type' is set to 'margin' or nil. ** 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 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 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 menu 'bookmark-bmenu-list', or by using the command 'bookmark-set'. Shell bookmarks can be loaded via the menu and by using the command -'bookmark-jump', which open a bookmarked shell, restore its buffer name, -its current directory, and create a remote connection, if necessary. +'bookmark-jump', which opens a bookmarked shell, restores its buffer name, +its current directory, and creates a remote connection, if necessary. You can customize 'shell-bookmark-name-function'. *** 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 previous implementations of '{next,previous}-completion', which better reflect that they only take the (default) horizontal completions format -into account. Any external code using '{next,previous}-completion' that -assumes the previous implementation must be adjusted accordingly; see +into account. Any external code using '{next,previous}-completion', that +assumes the previous implementation, must be adjusted accordingly; see 'minibuffer-next-completion' for an example of such an adjustment in Emacs core. diff --git a/lisp/auth-source.el b/lisp/auth-source.el index e7c8f43b7f9..1cef682af82 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -234,10 +234,14 @@ EPA/EPG set up, the file will be encrypted and decrypted automatically. See Info node `(epa)Encrypting/decrypting gpg files' 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 the choices can get pretty complex." :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 (string :tag "Just a file") (const :tag "Default Secrets API Collection" default) @@ -301,7 +305,7 @@ the choices can get pretty complex." (const :tag "Any" t) (string :tag "Name")))))) - (sexp :tag "A data structure (external provider)"))) + (sexp :tag "A data structure (external provider)")))) :link '(custom-manual "(auth) Help for users")) (defcustom auth-source-gpg-encrypt-to t @@ -370,6 +374,44 @@ soon as a function returns non-nil.") :type 'ignore))) (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 "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 @@ -424,7 +466,8 @@ Supported backend types are `netrc', `plstore' and `json'." :create-function #'auth-source-netrc-create))))) ;; 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) ;; 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 :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) ;; take secrets:XYZ and use it as Secrets API collection "XYZ" @@ -515,7 +559,8 @@ Supported backend types are `netrc', `plstore' and `json'." :source "" :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) "Fill in the extra `auth-source-backend' parameters of ENTRY. @@ -537,7 +582,7 @@ parameters." (defun auth-source-file-name-p (file) "Say whether FILE is used by `auth-sources'." - (let* ((backends (mapcar #'auth-source-backend-parse auth-sources)) + (let* ((backends (auth-source-backends)) (files (mapcar (lambda (x) (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 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)) - (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)) ;; note that we may have cached results but found is still nil ;; (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)) (dolist (backend backends) - (cl-dolist (key keys) + (cl-dolist (key (auth-source-search-keys spec)) ;; ignore invalid slots (condition-case nil (unless (auth-source-search-collection @@ -837,6 +878,7 @@ Returns the deleted entries." (defun auth-source-format-cache-entry (spec) "Format SPEC entry to put it in the password cache." `(auth-source . ,spec)) + ;; `(auth-source . ,(auth-source-search-spec spec))) (defun auth-source-remember (spec found) "Remember FOUND search results for SPEC." @@ -880,8 +922,7 @@ while \(:host t) would find all host entries." count)) (defun auth-source-specmatchp (spec stored) - (let ((keys (cl-loop for i below (length spec) by 2 - collect (nth i spec)))) + (let ((keys (auth-source-keys spec))) (not (eq (cl-dolist (key keys) (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) "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) "Format PROMPT using %x (for any character x) specifiers in ALIST. @@ -923,8 +965,6 @@ Remove trailing \": \"." value)) values))) -;;; Backend specific parsing: netrc/authinfo backend - (defun auth-source--aput-1 (alist key val) (let ((seen ()) (rest alist)) @@ -940,6 +980,123 @@ Remove trailing \": \"." (defun auth-source--aget (alist key) (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 (defun auth-source-netrc-parse-all (file) "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 (dolist (er create-extra) (let ((k (auth-source--symbol-keyword er)) - (keys (cl-loop for i below (length spec) by 2 - collect (nth i spec)))) + (keys (auth-source-keys spec))) (when (memq k keys) (auth-source--aput valist er (plist-get spec k))))) @@ -1645,30 +1801,11 @@ authentication tokens: (let* ((coll (oref backend source)) (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 (cl-loop - for search-spec in search-specs + for search-spec in + (apply #'auth-source-secrets-listify-pattern + (auth-source-search-spec spec)) nconc (cl-loop for item in (apply #'secrets-search-items coll search-spec) unless (and (stringp label) @@ -1690,7 +1827,7 @@ authentication tokens: (list (car entry) (cdr entry))) (secrets-get-attributes coll item))))) 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) (append (apply #'append @@ -1698,7 +1835,7 @@ authentication tokens: (if (plist-get plist req) nil (list req nil))) - returned-keys)) + (auth-source-returned-keys spec))) plist)) items))) (cond @@ -1758,8 +1895,7 @@ authentication tokens: ;; for extra required elements, see if the spec includes a value for them (dolist (er create-extra) (let ((k (auth-source--symbol-keyword er)) - (keys (cl-loop for i below (length spec) by 2 - collect (nth i spec)))) + (keys (auth-source-keys spec))) (when (memq k keys) (auth-source--aput valist er (plist-get spec k))))) @@ -1854,7 +1990,8 @@ authentication tokens: (if (not (eq r 'label)) ;; append the key (the symbol name of 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 (plist-put @@ -1956,25 +2093,8 @@ entries for git.gnus.org: (let* ((coll (oref backend source)) (max (or max 5000)) ; sanity check: default to stop at 5K - ;; Filter out ignored keys from the spec - (ignored-keys '(:create :delete :max :backend :label :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))) + (auth-source-ignored-keys + (seq-union auth-source-ignored-keys '(:host :port))) ;; Extract host, port and user from spec (hosts (plist-get spec :host)) (hosts (if (consp hosts) hosts `(,hosts))) @@ -1996,11 +2116,11 @@ entries for git.gnus.org: type max host port user - search-spec))) + (auth-source-search-spec spec)))) (when 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) (append (apply #'append @@ -2008,7 +2128,7 @@ entries for git.gnus.org: (if (plist-get plist req) nil (list req nil))) - returned-keys)) + (auth-source-returned-keys spec))) plist)) items))) items)) @@ -2120,27 +2240,7 @@ entries for git.gnus.org: "Search the PLSTORE; SPEC is like `auth-source'." (let* ((store (oref backend data)) (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-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)) + (items (plstore-find store (auth-source-search-spec spec))) (item-names (mapcar #'car items)) (items (take max items)) ;; convert the item to a full plist @@ -2156,7 +2256,7 @@ entries for git.gnus.org: (lambda () v))))) plist)) 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) (append (apply #'append @@ -2164,7 +2264,7 @@ entries for git.gnus.org: (if (plist-get plist req) nil (list req nil))) - returned-keys)) + (auth-source-returned-keys spec))) plist)) items))) (cond @@ -2230,8 +2330,7 @@ entries for git.gnus.org: (auth-source--aput valist br br-choice)))))) ;; for extra required elements, see if the spec includes a value for them - (let ((keys (cl-loop for i below (length spec) by 2 - collect (nth i spec))) + (let ((keys (auth-source-keys spec)) k) (dolist (er create-extra) (setq k (auth-source--symbol-keyword er)) @@ -2591,7 +2690,8 @@ by doing (clear-string STRING)." (second (read-passwd "Confirm password: " nil default))) (if (equal first second) (progn - (and (arrayp second) (not (eq first second)) (clear-string second)) + (and (arrayp second) (not (eq first second)) + (clear-string second)) (setq success first)) (and (arrayp first) (clear-string first)) (and (arrayp second) (clear-string second)) diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index d6845b0af37..4d4786f4ca9 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -32,6 +32,13 @@ (require 'auth-source) (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) (auth-source-validate-backend source '((source . "") (type . ignore)))) @@ -103,6 +110,14 @@ (create-function . 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 () (auth-source-validate-backend '(:source "foo") '((source . "foo") @@ -129,6 +144,16 @@ ;; . auth-source-json-create)))) . 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 () (provide 'secrets) ; simulates the presence of the `secrets' package (let ((secrets-enabled t)) @@ -198,6 +223,20 @@ (auth-source-ensure-ignored-backend '(:source '(foo))) (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) "Parse a netrc entry from buffer." (auth-source-forget-all-cached) @@ -434,6 +473,35 @@ (should (string-equal auth-passwd passwd)) (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-with-temp-file netrc-file :suffix "auth-source-test" :text "\