aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--etc/NEWS40
-rw-r--r--lisp/auth-source.el288
-rw-r--r--test/lisp/auth-source-tests.el68
3 files changed, 283 insertions, 113 deletions
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
216applies for the styles configuration in 'completion-category-overrides' 216applies for the styles configuration in 'completion-category-overrides'
217and 'completion-category-defaults'. 217and 'completion-category-defaults'.
218 218
219+++++ 219+++
220*** Navigating "*Completions*" now accommodates 'completions-format'. 220*** Navigating "*Completions*" now accommodates 'completions-format'.
221When 'completions-format' is set to 'vertical', typing 'n', '<TAB>' or 221When 'completions-format' is set to 'vertical', typing 'n', 'TAB' or
222'M-<down>' in the "*Completions*" buffer (the latter also in the 222'M-<down>' in the "*Completions*" buffer (the latter also in the
223minibuffer) now moves point to the completion candidate in the next line 223minibuffer) now moves point to the completion candidate in the next line
224in the current column, and wraps to the next column when typed on the 224in the current column, and wraps to the next column when typed on the
225last completion candidate of the current column. Likewise, typing 'p', 225last completion candidate of the current column. Likewise, typing 'p',
226'S-<TAB>' or 'M-<up>' moves point to the completion candidate in the 226'S-TAB' or 'M-<up>' moves point to the completion candidate in the
227previous line or wraps to the previous column. Previously, these keys 227previous line or wraps to the previous column. Previously, these keys
228ignored the vertical format, i.e., moved point only to the item in the 228ignored the vertical format, i.e., moved point only to the item in the
229same line of the next or previous column, in accordance with the default 229same 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.)
272 272
273--- 273---
274*** New mode 'minibuffer-nonselected-mode'. 274*** New mode 'minibuffer-nonselected-mode'.
275This mode enabled by default directs the attention to the active 275This mode, enabled by default, directs the attention to the active
276minibuffer window using the 'minibuffer-nonselected' face in case 276minibuffer window using the 'minibuffer-nonselected' face in case
277when the minibuffer window is no longer selected, but the minibuffer 277when the minibuffer window is no longer selected, but the minibuffer
278is still waiting for input. 278is still waiting for input.
@@ -280,7 +280,7 @@ is still waiting for input.
280** Mouse 280** Mouse
281 281
282*** New mode 'mouse-shift-adjust-mode' extends selection with 'S-<mouse-1>'. 282*** New mode 'mouse-shift-adjust-mode' extends selection with 'S-<mouse-1>'.
283When enabled, you can use the left mouse button with the <Shift> modifier 283When enabled, you can use the left mouse button with the '<Shift>' modifier
284to extend the boundaries of the active region by dragging the mouse pointer. 284to extend the boundaries of the active region by dragging the mouse pointer.
285 285
286--- 286---
@@ -750,7 +750,7 @@ pair: '("/*" " */" t)'.
750 750
751--- 751---
752** New user option 'electric-indent-actions'. 752** New user option 'electric-indent-actions'.
753This user options specifies a list of actions to reindent. The possible 753This user option specifies a list of actions to reindent. The possible
754elements for this list are: 'yank', reindent the yanked text; 754elements for this list are: 'yank', reindent the yanked text;
755'before-save', indent the whole buffer before saving it. 755'before-save', indent the whole buffer before saving it.
756 756
@@ -810,6 +810,9 @@ in such a file; the first usable entry of ‘auth-sources’ is selected as
810target. If you want also not existing files to be selected, set the 810target. If you want also not existing files to be selected, set the
811user option ‘auth-source-ignore-non-existing-file’ to nil. 811user option ‘auth-source-ignore-non-existing-file’ to nil.
812 812
813---
814*** 'auth-sources' set to nil means using the password cache only.
815
813** Autoinsert 816** Autoinsert
814 817
815+++ 818+++
@@ -823,7 +826,7 @@ with finer grained control.
823 826
824+++ 827+++
825*** New functions 'buffer-to-register' and 'file-to-register'. 828*** New functions 'buffer-to-register' and 'file-to-register'.
826These allow users to interactively store file and buffers in registers. 829These allow users to interactively store files and buffers in registers.
827Killed buffers stored in a register using 'buffer-to-register' are 830Killed buffers stored in a register using 'buffer-to-register' are
828automatically converted to a file-query value if the buffer was visiting 831automatically converted to a file-query value if the buffer was visiting
829a file. 832a file.
@@ -1010,28 +1013,27 @@ next to the ellipsis. By default this is disabled.
1010 1013
1011+++ 1014+++
1012*** New user option 'hs-show-indicators'. 1015*** New user option 'hs-show-indicators'.
1013This user option determines if hideshow should display indicators to 1016This user option determines if Hideshow should display indicators to
1014show and toggle the block hiding. If non-nil, the indicators are enabled. 1017show and toggle the block hiding. If non-nil, the indicators are enabled.
1015
1016By default this is disabled. 1018By default this is disabled.
1017 1019
1018*** New user option 'hs-indicator-maximum-buffer-size'. 1020*** New user option 'hs-indicator-maximum-buffer-size'.
1019This user option limits the display of hideshow indicators to buffers 1021This user option limits the display of Hideshow indicators to buffers
1020that are not too large. By default, buffers larger than 2MB have the 1022that are not too large. By default, buffers larger than 2MB have the
1021indicators disabled; the value of nil will activate the indicators 1023indicators disabled; the value of nil will activate the indicators
1022regardless of the buffer size. 1024regardless of the buffer size.
1023 1025
1024+++ 1026+++
1025*** New user option 'hs-indicator-type'. 1027*** New user option 'hs-indicator-type'.
1026This user option determine which indicator type should be used for the 1028This user option determines which indicator type should be used for the
1027block indicators. 1029block indicators.
1028 1030
1029The possible values can be: 'fringe', display the indicators in the 1031The possible values can be: 'fringe', display the indicators in the
1030fringe (the default); 'margin', display the indicators in the margin; 1032fringe (the default); 'margin', display the indicators in the margin;
1031nil, display the indicators at end-of-line. 1033nil, display the indicators at end-of-line.
1032 1034
1033The new icons 'hs-indicator-show' and 'hs-indicator-hide', can be used 1035The new icons 'hs-indicator-show' and 'hs-indicator-hide' can be used
1034for customize the indicators appearance, only if 'hs-indicator-type' is 1036to customize the indicators appearance only if 'hs-indicator-type' is
1035set to 'margin' or nil. 1037set to 'margin' or nil.
1036 1038
1037** C-ts mode 1039** C-ts mode
@@ -1043,9 +1045,9 @@ are highlighted like other comments. When non-nil, Doxygen comment
1043blocks are syntax-highlighted if the Doxygen grammar library is 1045blocks are syntax-highlighted if the Doxygen grammar library is
1044available. 1046available.
1045 1047
1046** Csharp-ts-mode 1048** Csharp-ts mode
1047 1049
1048*** Renamed feature in 'treesit-font-lock-feature-list' 1050*** Renamed feature in 'treesit-font-lock-feature-list'.
1049The feature 'property' has been renamed to 'attribute', since this is 1051The feature 'property' has been renamed to 'attribute', since this is
1050what it is called in the general C# community. 1052what it is called in the general C# community.
1051 1053
@@ -1491,8 +1493,8 @@ It removes all the buttons in the specified region.
1491You can now bookmark local and remote shell buffers using the bookmark 1493You can now bookmark local and remote shell buffers using the bookmark
1492menu 'bookmark-bmenu-list', or by using the command 'bookmark-set'. 1494menu 'bookmark-bmenu-list', or by using the command 'bookmark-set'.
1493Shell bookmarks can be loaded via the menu and by using the command 1495Shell bookmarks can be loaded via the menu and by using the command
1494'bookmark-jump', which open a bookmarked shell, restore its buffer name, 1496'bookmark-jump', which opens a bookmarked shell, restores its buffer name,
1495its current directory, and create a remote connection, if necessary. 1497its current directory, and creates a remote connection, if necessary.
1496You can customize 'shell-bookmark-name-function'. 1498You can customize 'shell-bookmark-name-function'.
1497 1499
1498*** New command to complete the shell history. 1500*** New command to complete the shell history.
@@ -3019,8 +3021,8 @@ commands '{next,previous}-column-completion', depending on the value of
3019'completions-format'. The latter two commands improve and extend the 3021'completions-format'. The latter two commands improve and extend the
3020previous implementations of '{next,previous}-completion', which better 3022previous implementations of '{next,previous}-completion', which better
3021reflect that they only take the (default) horizontal completions format 3023reflect that they only take the (default) horizontal completions format
3022into account. Any external code using '{next,previous}-completion' that 3024into account. Any external code using '{next,previous}-completion', that
3023assumes the previous implementation must be adjusted accordingly; see 3025assumes the previous implementation, must be adjusted accordingly; see
3024'minibuffer-next-completion' for an example of such an adjustment in 3026'minibuffer-next-completion' for an example of such an adjustment in
3025Emacs core. 3027Emacs core.
3026 3028
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
234automatically. See Info node `(epa)Encrypting/decrypting gpg files' 234automatically. See Info node `(epa)Encrypting/decrypting gpg files'
235for details. 235for details.
236 236
237If this option is nil, no authentication source is used but the local
238password cache.
239
237It's best to customize this with \\[customize-variable] because 240It's best to customize this with \\[customize-variable] because
238the choices can get pretty complex." 241the choices can get pretty complex."
239 :version "26.1" ; neither new nor changed default 242 :version "26.1" ; neither new nor changed default
240 :type `(repeat :tag "Authentication Sources" 243 :type `(choice (const :tag "Password cache" nil)
244 (repeat :tag "Authentication Sources"
241 (choice 245 (choice
242 (string :tag "Just a file") 246 (string :tag "Just a file")
243 (const :tag "Default Secrets API Collection" default) 247 (const :tag "Default Secrets API Collection" default)
@@ -301,7 +305,7 @@ the choices can get pretty complex."
301 (const :tag "Any" t) 305 (const :tag "Any" t)
302 (string 306 (string
303 :tag "Name")))))) 307 :tag "Name"))))))
304 (sexp :tag "A data structure (external provider)"))) 308 (sexp :tag "A data structure (external provider)"))))
305 :link '(custom-manual "(auth) Help for users")) 309 :link '(custom-manual "(auth) Help for users"))
306 310
307(defcustom auth-source-gpg-encrypt-to t 311(defcustom auth-source-gpg-encrypt-to t
@@ -370,6 +374,44 @@ soon as a function returns non-nil.")
370 :type 'ignore))) 374 :type 'ignore)))
371 (auth-source-backend-parse-parameters entry backend))) 375 (auth-source-backend-parse-parameters entry backend)))
372 376
377(defmacro auth-source-backends ()
378 "List of usable backends from `auth-sources'.
379A fallback backend is added to ensure, that at least `read-passwd' is called."
380 `(or (mapcar #'auth-source-backend-parse auth-sources)
381 ;; Fallback.
382 (list (auth-source-backend
383 :source ""
384 :type 'read-passwd
385 :search-function #'auth-source-read-passwd-search
386 :create-function #'auth-source-read-passwd-create))))
387
388(defmacro auth-source-keys (spec)
389 "Return keys from SPEC."
390 `(cl-loop for i below (length ,spec) by 2
391 collect (nth i ,spec)))
392
393(defconst auth-source-ignored-keys
394 '(:create :delete :max :backend :label :require :type)
395 "List of meta keys to be ignored in data stores.")
396
397(defmacro auth-source-search-keys (spec)
398 "Filter out ignored keys from SPEC."
399 `(seq-difference (auth-source-keys ,spec) auth-source-ignored-keys))
400
401(defmacro auth-source-returned-keys (spec)
402 "Needed keys (always including host, login, port, and secret)."
403 `(seq-union '(:host :login :port :secret) (auth-source-search-keys ,spec)))
404
405(defmacro auth-source-search-spec (spec)
406 "Build a search spec without the ignored keys.
407If a search key is nil or t (match anything), skip it."
408 `(seq-keep
409 (lambda (k)
410 (and-let* ((v (plist-get ,spec k))
411 ((not (eq t v)))
412 ((cons k (auth-source-ensure-strings v))))))
413 (auth-source-search-keys spec)))
414
373(defcustom auth-source-ignore-non-existing-file t 415(defcustom auth-source-ignore-non-existing-file t
374 "If set non-nil, file-based backends are ignored if the file does not exist. 416 "If set non-nil, file-based backends are ignored if the file does not exist.
375Consequently, no newly created entry is saved in such a backend when 417Consequently, no newly created entry is saved in such a backend when
@@ -424,7 +466,8 @@ Supported backend types are `netrc', `plstore' and `json'."
424 :create-function #'auth-source-netrc-create))))) 466 :create-function #'auth-source-netrc-create)))))
425 467
426;; Note this function should be last in the parser functions, so we add it first 468;; Note this function should be last in the parser functions, so we add it first
427(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-file) 469(add-hook 'auth-source-backend-parser-functions
470 #'auth-source-backends-parser-file)
428 471
429(defun auth-source-backends-parser-macos-keychain (entry) 472(defun auth-source-backends-parser-macos-keychain (entry)
430 ;; take macos-keychain-{internet,generic}:XYZ and use it as macOS 473 ;; take macos-keychain-{internet,generic}:XYZ and use it as macOS
@@ -470,7 +513,8 @@ Supported backend types are `netrc', `plstore' and `json'."
470 :search-function #'auth-source-macos-keychain-search 513 :search-function #'auth-source-macos-keychain-search
471 :create-function #'auth-source-macos-keychain-create))))) 514 :create-function #'auth-source-macos-keychain-create)))))
472 515
473(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-macos-keychain) 516(add-hook 'auth-source-backend-parser-functions
517 #'auth-source-backends-parser-macos-keychain)
474 518
475(defun auth-source-backends-parser-secrets (entry) 519(defun auth-source-backends-parser-secrets (entry)
476 ;; take secrets:XYZ and use it as Secrets API collection "XYZ" 520 ;; take secrets:XYZ and use it as Secrets API collection "XYZ"
@@ -515,7 +559,8 @@ Supported backend types are `netrc', `plstore' and `json'."
515 :source "" 559 :source ""
516 :type 'ignore)))))) 560 :type 'ignore))))))
517 561
518(add-hook 'auth-source-backend-parser-functions #'auth-source-backends-parser-secrets) 562(add-hook 'auth-source-backend-parser-functions
563 #'auth-source-backends-parser-secrets)
519 564
520(defun auth-source-backend-parse-parameters (entry backend) 565(defun auth-source-backend-parse-parameters (entry backend)
521 "Fill in the extra `auth-source-backend' parameters of ENTRY. 566 "Fill in the extra `auth-source-backend' parameters of ENTRY.
@@ -537,7 +582,7 @@ parameters."
537 582
538(defun auth-source-file-name-p (file) 583(defun auth-source-file-name-p (file)
539 "Say whether FILE is used by `auth-sources'." 584 "Say whether FILE is used by `auth-sources'."
540 (let* ((backends (mapcar #'auth-source-backend-parse auth-sources)) 585 (let* ((backends (auth-source-backends))
541 (files 586 (files
542 (mapcar (lambda (x) 587 (mapcar (lambda (x)
543 (when (member (slot-value x 'type) '(json netrc plstore)) 588 (when (member (slot-value x 'type) '(json netrc plstore))
@@ -695,12 +740,8 @@ actually useful. So the caller must arrange to call this function.
695 740
696The token's :secret key can hold a function. In that case you 741The token's :secret key can hold a function. In that case you
697must call it to obtain the actual value." 742must call it to obtain the actual value."
698 (let* ((backends (mapcar #'auth-source-backend-parse auth-sources)) 743 (let* ((backends (auth-source-backends))
699 (max (or max 1)) 744 (max (or max 1))
700 (ignored-keys '(:require :create :delete :max))
701 (keys (cl-loop for i below (length spec) by 2
702 unless (memq (nth i spec) ignored-keys)
703 collect (nth i spec)))
704 (cached (auth-source-remembered-p spec)) 745 (cached (auth-source-remembered-p spec))
705 ;; note that we may have cached results but found is still nil 746 ;; note that we may have cached results but found is still nil
706 ;; (there were no results from the search) 747 ;; (there were no results from the search)
@@ -722,7 +763,7 @@ must call it to obtain the actual value."
722 763
723 (setq filtered-backends (copy-sequence backends)) 764 (setq filtered-backends (copy-sequence backends))
724 (dolist (backend backends) 765 (dolist (backend backends)
725 (cl-dolist (key keys) 766 (cl-dolist (key (auth-source-search-keys spec))
726 ;; ignore invalid slots 767 ;; ignore invalid slots
727 (condition-case nil 768 (condition-case nil
728 (unless (auth-source-search-collection 769 (unless (auth-source-search-collection
@@ -837,6 +878,7 @@ Returns the deleted entries."
837(defun auth-source-format-cache-entry (spec) 878(defun auth-source-format-cache-entry (spec)
838 "Format SPEC entry to put it in the password cache." 879 "Format SPEC entry to put it in the password cache."
839 `(auth-source . ,spec)) 880 `(auth-source . ,spec))
881 ;; `(auth-source . ,(auth-source-search-spec spec)))
840 882
841(defun auth-source-remember (spec found) 883(defun auth-source-remember (spec found)
842 "Remember FOUND search results for SPEC." 884 "Remember FOUND search results for SPEC."
@@ -880,8 +922,7 @@ while \(:host t) would find all host entries."
880 count)) 922 count))
881 923
882(defun auth-source-specmatchp (spec stored) 924(defun auth-source-specmatchp (spec stored)
883 (let ((keys (cl-loop for i below (length spec) by 2 925 (let ((keys (auth-source-keys spec)))
884 collect (nth i spec))))
885 (not (eq 926 (not (eq
886 (cl-dolist (key keys) 927 (cl-dolist (key keys)
887 (unless (auth-source-search-collection (plist-get stored key) 928 (unless (auth-source-search-collection (plist-get stored key)
@@ -898,7 +939,8 @@ while \(:host t) would find all host entries."
898 939
899(defun auth-source-pick-first-password (&rest spec) 940(defun auth-source-pick-first-password (&rest spec)
900 "Pick the first secret found by applying `auth-source-search' to SPEC." 941 "Pick the first secret found by applying `auth-source-search' to SPEC."
901 (auth-info-password (car (apply #'auth-source-search (plist-put spec :max 1))))) 942 (auth-info-password
943 (car (apply #'auth-source-search (plist-put spec :max 1)))))
902 944
903(defun auth-source-format-prompt (prompt alist) 945(defun auth-source-format-prompt (prompt alist)
904 "Format PROMPT using %x (for any character x) specifiers in ALIST. 946 "Format PROMPT using %x (for any character x) specifiers in ALIST.
@@ -923,8 +965,6 @@ Remove trailing \": \"."
923 value)) 965 value))
924 values))) 966 values)))
925 967
926;;; Backend specific parsing: netrc/authinfo backend
927
928(defun auth-source--aput-1 (alist key val) 968(defun auth-source--aput-1 (alist key val)
929 (let ((seen ()) 969 (let ((seen ())
930 (rest alist)) 970 (rest alist))
@@ -940,6 +980,123 @@ Remove trailing \": \"."
940(defun auth-source--aget (alist key) 980(defun auth-source--aget (alist key)
941 (cdr (assoc key alist))) 981 (cdr (assoc key alist)))
942 982
983;;; Backend specific parsing: just read the password
984
985(cl-defun auth-source-read-passwd-search (&rest spec
986 &key backend create delete
987 &allow-other-keys)
988 "Search in password cache; spec is like `auth-source'."
989
990 ;; TODO
991 (cl-assert
992 (not delete) nil
993 "The `read-passwd' auth-source backend doesn't support deletion yet")
994
995 (let ((found (auth-source-recall (auth-source-search-spec spec))))
996 (cond
997 (found (list found))
998 (create (apply (slot-value backend 'create-function) spec)))))
999
1000(cl-defun auth-source-read-passwd-create (&rest spec
1001 &key host port user
1002 &allow-other-keys)
1003 (let* ((base-required '(host user port secret))
1004 ;; we know (because of an assertion in auth-source-search) that the
1005 ;; :create parameter is either t or a list (which includes nil)
1006 (current-data (car (auth-source-search :max 1
1007 :host host
1008 :user user
1009 :port port)))
1010 ;; `valist' is an alist
1011 valist
1012 ;; `artificial' will be returned if no creation is needed
1013 artificial)
1014
1015 ;; only for base required elements (defined as function parameters):
1016 ;; fill in the valist with whatever data we may have from the search
1017 ;; we complete the first value if it's a list and use the value otherwise
1018 (dolist (br base-required)
1019 (let ((val (plist-get spec (auth-source--symbol-keyword br))))
1020 (when val
1021 (let ((br-choice (cond
1022 ;; all-accepting choice (predicate is t)
1023 ((eq t val) nil)
1024 ;; just the value otherwise
1025 (t val))))
1026 (when br-choice
1027 (auth-source--aput valist br br-choice))))))
1028
1029 ;; for each required element
1030 (dolist (r base-required)
1031 (let* ((data (auth-source--aget valist r))
1032 ;; take the first element if the data is a list
1033 (data (or (auth-source-netrc-element-or-first data)
1034 (plist-get current-data
1035 (auth-source--symbol-keyword r))))
1036 ;; this is the default to be offered
1037 (given-default (auth-source--aget
1038 auth-source-creation-defaults r))
1039 ;; the default supplementals are simple:
1040 ;; for the user, try `given-default' and then (user-login-name);
1041 ;; otherwise take `given-default'
1042 (default (cond
1043 ((and (not given-default) (eq r 'user))
1044 (user-login-name))
1045 (t given-default)))
1046 (printable-defaults (list
1047 (cons 'user
1048 (or
1049 (auth-source-netrc-element-or-first
1050 (auth-source--aget valist 'user))
1051 (plist-get artificial :user)
1052 "[any user]"))
1053 (cons 'host
1054 (or
1055 (auth-source-netrc-element-or-first
1056 (auth-source--aget valist 'host))
1057 (plist-get artificial :host)
1058 "[any host]"))
1059 (cons 'port
1060 (or
1061 (auth-source-netrc-element-or-first
1062 (auth-source--aget valist 'port))
1063 (plist-get artificial :port)
1064 "[any port]"))))
1065 (prompt (or (auth-source--aget auth-source-creation-prompts r)
1066 (cl-case r
1067 (secret "%p password for %u@%h")
1068 (user "%p user name for %h")
1069 (host "%p host name for user %u")
1070 (port "%p port for %u@%h"))
1071 (format "Enter %s (%%u@%%h:%%p)" r)))
1072 (prompt (auth-source-format-prompt
1073 prompt
1074 `((?u ,(auth-source--aget printable-defaults 'user))
1075 (?h ,(auth-source--aget printable-defaults 'host))
1076 (?p ,(auth-source--aget printable-defaults 'port))))))
1077
1078 ;; Store the data, prompting for the password if needed.
1079 (setq data (or data
1080 (if (eq r 'secret)
1081 (or (eval default)
1082 (read-passwd (format-prompt prompt nil)))
1083 (if (and (stringp default) auth-source-save-behavior)
1084 (read-string
1085 (format-prompt prompt default) nil nil default)
1086 (eval default)))))
1087
1088 (when data
1089 (setq artificial (plist-put artificial
1090 (auth-source--symbol-keyword r)
1091 (if (eq r 'secret)
1092 (let ((data data))
1093 (lambda () data))
1094 data))))))
1095
1096 (list artificial)))
1097
1098;;; Backend specific parsing: netrc/authinfo backend
1099
943;;;###autoload 1100;;;###autoload
944(defun auth-source-netrc-parse-all (file) 1101(defun auth-source-netrc-parse-all (file)
945 "Parse FILE and return all entries." 1102 "Parse FILE and return all entries."
@@ -1360,8 +1517,7 @@ See `auth-source-search' for details on SPEC."
1360 ;; for extra required elements, see if the spec includes a value for them 1517 ;; for extra required elements, see if the spec includes a value for them
1361 (dolist (er create-extra) 1518 (dolist (er create-extra)
1362 (let ((k (auth-source--symbol-keyword er)) 1519 (let ((k (auth-source--symbol-keyword er))
1363 (keys (cl-loop for i below (length spec) by 2 1520 (keys (auth-source-keys spec)))
1364 collect (nth i spec))))
1365 (when (memq k keys) 1521 (when (memq k keys)
1366 (auth-source--aput valist er (plist-get spec k))))) 1522 (auth-source--aput valist er (plist-get spec k)))))
1367 1523
@@ -1645,30 +1801,11 @@ authentication tokens:
1645 1801
1646 (let* ((coll (oref backend source)) 1802 (let* ((coll (oref backend source))
1647 (max (or max 5000)) ; sanity check: default to stop at 5K 1803 (max (or max 5000)) ; sanity check: default to stop at 5K
1648 (ignored-keys '(:create :delete :max :backend :label :require :type))
1649 (search-keys (cl-loop for i below (length spec) by 2
1650 unless (memq (nth i spec) ignored-keys)
1651 collect (nth i spec)))
1652 ;; build a search spec without the ignored keys
1653 ;; if a search key is nil or t (match anything), we skip it
1654 (search-specs (auth-source-secrets-listify-pattern
1655 (apply #'append (mapcar
1656 (lambda (k)
1657 (let ((v (plist-get spec k)))
1658 (if (or (null v)
1659 (eq t v))
1660 nil
1661 (list
1662 k
1663 (auth-source-ensure-strings v)))))
1664 search-keys))))
1665 ;; needed keys (always including host, login, port, and secret)
1666 (returned-keys (delete-dups (append
1667 '(:host :login :port :secret)
1668 search-keys)))
1669 (items 1804 (items
1670 (cl-loop 1805 (cl-loop
1671 for search-spec in search-specs 1806 for search-spec in
1807 (apply #'auth-source-secrets-listify-pattern
1808 (auth-source-search-spec spec))
1672 nconc 1809 nconc
1673 (cl-loop for item in (apply #'secrets-search-items coll search-spec) 1810 (cl-loop for item in (apply #'secrets-search-items coll search-spec)
1674 unless (and (stringp label) 1811 unless (and (stringp label)
@@ -1690,7 +1827,7 @@ authentication tokens:
1690 (list (car entry) (cdr entry))) 1827 (list (car entry) (cdr entry)))
1691 (secrets-get-attributes coll item))))) 1828 (secrets-get-attributes coll item)))))
1692 items)) 1829 items))
1693 ;; ensure each item has each key in `returned-keys' 1830 ;; Ensure each item has each key in `auth-source-returned-keys'.
1694 (items (mapcar (lambda (plist) 1831 (items (mapcar (lambda (plist)
1695 (append 1832 (append
1696 (apply #'append 1833 (apply #'append
@@ -1698,7 +1835,7 @@ authentication tokens:
1698 (if (plist-get plist req) 1835 (if (plist-get plist req)
1699 nil 1836 nil
1700 (list req nil))) 1837 (list req nil)))
1701 returned-keys)) 1838 (auth-source-returned-keys spec)))
1702 plist)) 1839 plist))
1703 items))) 1840 items)))
1704 (cond 1841 (cond
@@ -1758,8 +1895,7 @@ authentication tokens:
1758 ;; for extra required elements, see if the spec includes a value for them 1895 ;; for extra required elements, see if the spec includes a value for them
1759 (dolist (er create-extra) 1896 (dolist (er create-extra)
1760 (let ((k (auth-source--symbol-keyword er)) 1897 (let ((k (auth-source--symbol-keyword er))
1761 (keys (cl-loop for i below (length spec) by 2 1898 (keys (auth-source-keys spec)))
1762 collect (nth i spec))))
1763 (when (memq k keys) 1899 (when (memq k keys)
1764 (auth-source--aput valist er (plist-get spec k))))) 1900 (auth-source--aput valist er (plist-get spec k)))))
1765 1901
@@ -1854,7 +1990,8 @@ authentication tokens:
1854 (if (not (eq r 'label)) 1990 (if (not (eq r 'label))
1855 ;; append the key (the symbol name of r) 1991 ;; append the key (the symbol name of r)
1856 ;; and the value in r 1992 ;; and the value in r
1857 (setq args (append args (list (auth-source--symbol-keyword r) data)))))))) 1993 (setq args (append args (list (auth-source--symbol-keyword r)
1994 data))))))))
1858 1995
1859 (when save-function 1996 (when save-function
1860 (plist-put 1997 (plist-put
@@ -1956,25 +2093,8 @@ entries for git.gnus.org:
1956 2093
1957 (let* ((coll (oref backend source)) 2094 (let* ((coll (oref backend source))
1958 (max (or max 5000)) ; sanity check: default to stop at 5K 2095 (max (or max 5000)) ; sanity check: default to stop at 5K
1959 ;; Filter out ignored keys from the spec 2096 (auth-source-ignored-keys
1960 (ignored-keys '(:create :delete :max :backend :label :host :port)) 2097 (seq-union auth-source-ignored-keys '(:host :port)))
1961 ;; Build a search spec without the ignored keys
1962 ;; FIXME make this loop a function? it's used in at least 3 places
1963 (search-keys (cl-loop for i below (length spec) by 2
1964 unless (memq (nth i spec) ignored-keys)
1965 collect (nth i spec)))
1966 ;; If a search key value is nil or t (match anything), we skip it
1967 (search-spec (apply #'append (mapcar
1968 (lambda (k)
1969 (if (or (null (plist-get spec k))
1970 (eq t (plist-get spec k)))
1971 nil
1972 (list k (plist-get spec k))))
1973 search-keys)))
1974 ;; needed keys (always including host, login, port, and secret)
1975 (returned-keys (delete-dups (append
1976 '(:host :login :port :secret)
1977 search-keys)))
1978 ;; Extract host, port and user from spec 2098 ;; Extract host, port and user from spec
1979 (hosts (plist-get spec :host)) 2099 (hosts (plist-get spec :host))
1980 (hosts (if (consp hosts) hosts `(,hosts))) 2100 (hosts (if (consp hosts) hosts `(,hosts)))
@@ -1996,11 +2116,11 @@ entries for git.gnus.org:
1996 type 2116 type
1997 max 2117 max
1998 host port user 2118 host port user
1999 search-spec))) 2119 (auth-source-search-spec spec))))
2000 (when items 2120 (when items
2001 (throw 'match items)))))))) 2121 (throw 'match items))))))))
2002 2122
2003 ;; ensure each item has each key in `returned-keys' 2123 ;; ensure each item has each key in `auth-source-returned-keys'.
2004 (items (mapcar (lambda (plist) 2124 (items (mapcar (lambda (plist)
2005 (append 2125 (append
2006 (apply #'append 2126 (apply #'append
@@ -2008,7 +2128,7 @@ entries for git.gnus.org:
2008 (if (plist-get plist req) 2128 (if (plist-get plist req)
2009 nil 2129 nil
2010 (list req nil))) 2130 (list req nil)))
2011 returned-keys)) 2131 (auth-source-returned-keys spec)))
2012 plist)) 2132 plist))
2013 items))) 2133 items)))
2014 items)) 2134 items))
@@ -2120,27 +2240,7 @@ entries for git.gnus.org:
2120 "Search the PLSTORE; SPEC is like `auth-source'." 2240 "Search the PLSTORE; SPEC is like `auth-source'."
2121 (let* ((store (oref backend data)) 2241 (let* ((store (oref backend data))
2122 (max (or max 5000)) ; sanity check: default to stop at 5K 2242 (max (or max 5000)) ; sanity check: default to stop at 5K
2123 (ignored-keys '(:create :delete :max :backend :label :require :type)) 2243 (items (plstore-find store (auth-source-search-spec spec)))
2124 (search-keys (cl-loop for i below (length spec) by 2
2125 unless (memq (nth i spec) ignored-keys)
2126 collect (nth i spec)))
2127 ;; build a search spec without the ignored keys
2128 ;; if a search key is nil or t (match anything), we skip it
2129 (search-spec (apply #'append (mapcar
2130 (lambda (k)
2131 (let ((v (plist-get spec k)))
2132 (if (or (null v)
2133 (eq t v))
2134 nil
2135 (list
2136 k
2137 (auth-source-ensure-strings v)))))
2138 search-keys)))
2139 ;; needed keys (always including host, login, port, and secret)
2140 (returned-keys (delete-dups (append
2141 '(:host :login :port :secret)
2142 search-keys)))
2143 (items (plstore-find store search-spec))
2144 (item-names (mapcar #'car items)) 2244 (item-names (mapcar #'car items))
2145 (items (take max items)) 2245 (items (take max items))
2146 ;; convert the item to a full plist 2246 ;; convert the item to a full plist
@@ -2156,7 +2256,7 @@ entries for git.gnus.org:
2156 (lambda () v))))) 2256 (lambda () v)))))
2157 plist)) 2257 plist))
2158 items)) 2258 items))
2159 ;; ensure each item has each key in `returned-keys' 2259 ;; ensure each item has each key in `auth-source-returned-keys'.
2160 (items (mapcar (lambda (plist) 2260 (items (mapcar (lambda (plist)
2161 (append 2261 (append
2162 (apply #'append 2262 (apply #'append
@@ -2164,7 +2264,7 @@ entries for git.gnus.org:
2164 (if (plist-get plist req) 2264 (if (plist-get plist req)
2165 nil 2265 nil
2166 (list req nil))) 2266 (list req nil)))
2167 returned-keys)) 2267 (auth-source-returned-keys spec)))
2168 plist)) 2268 plist))
2169 items))) 2269 items)))
2170 (cond 2270 (cond
@@ -2230,8 +2330,7 @@ entries for git.gnus.org:
2230 (auth-source--aput valist br br-choice)))))) 2330 (auth-source--aput valist br br-choice))))))
2231 2331
2232 ;; for extra required elements, see if the spec includes a value for them 2332 ;; for extra required elements, see if the spec includes a value for them
2233 (let ((keys (cl-loop for i below (length spec) by 2 2333 (let ((keys (auth-source-keys spec))
2234 collect (nth i spec)))
2235 k) 2334 k)
2236 (dolist (er create-extra) 2335 (dolist (er create-extra)
2237 (setq k (auth-source--symbol-keyword er)) 2336 (setq k (auth-source--symbol-keyword er))
@@ -2591,7 +2690,8 @@ by doing (clear-string STRING)."
2591 (second (read-passwd "Confirm password: " nil default))) 2690 (second (read-passwd "Confirm password: " nil default)))
2592 (if (equal first second) 2691 (if (equal first second)
2593 (progn 2692 (progn
2594 (and (arrayp second) (not (eq first second)) (clear-string second)) 2693 (and (arrayp second) (not (eq first second))
2694 (clear-string second))
2595 (setq success first)) 2695 (setq success first))
2596 (and (arrayp first) (clear-string first)) 2696 (and (arrayp first) (clear-string first))
2597 (and (arrayp second) (clear-string second)) 2697 (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 @@
32(require 'auth-source) 32(require 'auth-source)
33(require 'secrets) 33(require 'secrets)
34 34
35;; (dolist
36;; (elt
37;; (append
38;; (mapcar #'intern (all-completions "auth-" obarray #'functionp))
39;; (mapcar #'intern (all-completions "password-" obarray #'functionp))))
40;; (trace-function-background elt))
41
35(defun auth-source-ensure-ignored-backend (source) 42(defun auth-source-ensure-ignored-backend (source)
36 (auth-source-validate-backend source '((source . "") 43 (auth-source-validate-backend source '((source . "")
37 (type . ignore)))) 44 (type . ignore))))
@@ -103,6 +110,14 @@
103 (create-function 110 (create-function
104 . auth-source-plstore-create)))) 111 . auth-source-plstore-create))))
105 112
113(ert-deftest auth-source-backend-parse-plstore-string ()
114 (auth-source-validate-backend "foo.plist"
115 '((source . "foo.plist")
116 (type . plstore)
117 (search-function . auth-source-plstore-search)
118 (create-function
119 . auth-source-plstore-create))))
120
106(ert-deftest auth-source-backend-parse-netrc () 121(ert-deftest auth-source-backend-parse-netrc ()
107 (auth-source-validate-backend '(:source "foo") 122 (auth-source-validate-backend '(:source "foo")
108 '((source . "foo") 123 '((source . "foo")
@@ -129,6 +144,16 @@
129 ;; . auth-source-json-create)))) 144 ;; . auth-source-json-create))))
130 . ignore)))) 145 . ignore))))
131 146
147(ert-deftest auth-source-backend-parse-json-string ()
148 (auth-source-validate-backend "foo.json"
149 '((source . "foo.json")
150 (type . json)
151 (search-function . auth-source-json-search)
152 (create-function
153 ;; To be implemented:
154 ;; . auth-source-json-create))))
155 . ignore))))
156
132(ert-deftest auth-source-backend-parse-secrets () 157(ert-deftest auth-source-backend-parse-secrets ()
133 (provide 'secrets) ; simulates the presence of the `secrets' package 158 (provide 'secrets) ; simulates the presence of the `secrets' package
134 (let ((secrets-enabled t)) 159 (let ((secrets-enabled t))
@@ -198,6 +223,20 @@
198 (auth-source-ensure-ignored-backend '(:source '(foo))) 223 (auth-source-ensure-ignored-backend '(:source '(foo)))
199 (auth-source-ensure-ignored-backend '(:source nil)))) 224 (auth-source-ensure-ignored-backend '(:source nil))))
200 225
226(ert-deftest auth-source-backend-parse-fallback ()
227 (let* (auth-sources
228 (backends (auth-source-backends))
229 (backend (car backends))
230 (validation-alist
231 '((source . "")
232 (type . read-passwd)
233 (search-function . auth-source-read-passwd-search)
234 (create-function . auth-source-read-passwd-create))))
235 (should (length= backends 1))
236 (should (auth-source-backend-p backend))
237 (dolist (pair validation-alist)
238 (should (equal (eieio-oref backend (car pair)) (cdr pair))))))
239
201(defun auth-source--test-netrc-parse-entry (entry host user port) 240(defun auth-source--test-netrc-parse-entry (entry host user port)
202 "Parse a netrc entry from buffer." 241 "Parse a netrc entry from buffer."
203 (auth-source-forget-all-cached) 242 (auth-source-forget-all-cached)
@@ -434,6 +473,35 @@
434 (should (string-equal auth-passwd passwd)) 473 (should (string-equal auth-passwd passwd))
435 (should (search-forward host nil 'noerror))))))))) 474 (should (search-forward host nil 'noerror)))))))))
436 475
476(ert-deftest auth-source-test-read-passwd-create-secret ()
477 (let (auth-sources auth-info auth-passwd host)
478 (auth-source-forget-all-cached)
479 (dolist (passwd '("foo" "" nil))
480 (unwind-protect
481 ;; Redefine `read-*' in order to avoid interactive input.
482 (cl-letf (((symbol-function 'read-passwd) (lambda (_) passwd))
483 ((symbol-function 'read-string)
484 (lambda (_prompt &optional _initial _history default
485 _inherit-input-method)
486 default)))
487 (setq host
488 (md5 (concat (prin1-to-string process-environment) passwd))
489 auth-info
490 (car (auth-source-search
491 :max 1 :host host :require '(:user :secret) :create t))
492 auth-passwd (auth-info-password auth-info))
493 (should (string-equal (plist-get auth-info :user) (user-login-name)))
494 (should (string-equal (plist-get auth-info :host) host))
495 (should (equal auth-passwd passwd))
496 (should-not (plist-get auth-info :save-function))
497
498 ;; Check, that the item hasn't been created persistently.
499 (auth-source-forget+ :host t)
500 (should-not (auth-source-search :host host)))
501
502 ;; Cleanup.
503 t))))
504
437(ert-deftest auth-source-delete () 505(ert-deftest auth-source-delete ()
438 (ert-with-temp-file netrc-file 506 (ert-with-temp-file netrc-file
439 :suffix "auth-source-test" :text "\ 507 :suffix "auth-source-test" :text "\