diff options
| -rw-r--r-- | etc/NEWS | 40 | ||||
| -rw-r--r-- | lisp/auth-source.el | 288 | ||||
| -rw-r--r-- | test/lisp/auth-source-tests.el | 68 |
3 files changed, 283 insertions, 113 deletions
| @@ -216,14 +216,14 @@ different values for completion-affecting variables like | |||
| 216 | applies for the styles configuration in 'completion-category-overrides' | 216 | applies for the styles configuration in 'completion-category-overrides' |
| 217 | and 'completion-category-defaults'. | 217 | and 'completion-category-defaults'. |
| 218 | 218 | ||
| 219 | +++++ | 219 | +++ |
| 220 | *** Navigating "*Completions*" now accommodates 'completions-format'. | 220 | *** Navigating "*Completions*" now accommodates 'completions-format'. |
| 221 | When 'completions-format' is set to 'vertical', typing 'n', '<TAB>' or | 221 | When '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 |
| 223 | minibuffer) now moves point to the completion candidate in the next line | 223 | minibuffer) now moves point to the completion candidate in the next line |
| 224 | in the current column, and wraps to the next column when typed on the | 224 | in the current column, and wraps to the next column when typed on the |
| 225 | last completion candidate of the current column. Likewise, typing 'p', | 225 | last 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 |
| 227 | previous line or wraps to the previous column. Previously, these keys | 227 | previous line or wraps to the previous column. Previously, these keys |
| 228 | ignored the vertical format, i.e., moved point only to the item in the | 228 | ignored the vertical format, i.e., moved point only to the item in the |
| 229 | same line of the next or previous column, in accordance with the default | 229 | 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.) | |||
| 272 | 272 | ||
| 273 | --- | 273 | --- |
| 274 | *** New mode 'minibuffer-nonselected-mode'. | 274 | *** New mode 'minibuffer-nonselected-mode'. |
| 275 | This mode enabled by default directs the attention to the active | 275 | This mode, enabled by default, directs the attention to the active |
| 276 | minibuffer window using the 'minibuffer-nonselected' face in case | 276 | minibuffer window using the 'minibuffer-nonselected' face in case |
| 277 | when the minibuffer window is no longer selected, but the minibuffer | 277 | when the minibuffer window is no longer selected, but the minibuffer |
| 278 | is still waiting for input. | 278 | is 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>'. |
| 283 | When enabled, you can use the left mouse button with the <Shift> modifier | 283 | When enabled, you can use the left mouse button with the '<Shift>' modifier |
| 284 | to extend the boundaries of the active region by dragging the mouse pointer. | 284 | to 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'. |
| 753 | This user options specifies a list of actions to reindent. The possible | 753 | This user option specifies a list of actions to reindent. The possible |
| 754 | elements for this list are: 'yank', reindent the yanked text; | 754 | elements 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 | |||
| 810 | target. If you want also not existing files to be selected, set the | 810 | target. If you want also not existing files to be selected, set the |
| 811 | user option ‘auth-source-ignore-non-existing-file’ to nil. | 811 | user 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'. |
| 826 | These allow users to interactively store file and buffers in registers. | 829 | These allow users to interactively store files and buffers in registers. |
| 827 | Killed buffers stored in a register using 'buffer-to-register' are | 830 | Killed buffers stored in a register using 'buffer-to-register' are |
| 828 | automatically converted to a file-query value if the buffer was visiting | 831 | automatically converted to a file-query value if the buffer was visiting |
| 829 | a file. | 832 | a 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'. |
| 1013 | This user option determines if hideshow should display indicators to | 1016 | This user option determines if Hideshow should display indicators to |
| 1014 | show and toggle the block hiding. If non-nil, the indicators are enabled. | 1017 | show and toggle the block hiding. If non-nil, the indicators are enabled. |
| 1015 | |||
| 1016 | By default this is disabled. | 1018 | By default this is disabled. |
| 1017 | 1019 | ||
| 1018 | *** New user option 'hs-indicator-maximum-buffer-size'. | 1020 | *** New user option 'hs-indicator-maximum-buffer-size'. |
| 1019 | This user option limits the display of hideshow indicators to buffers | 1021 | This user option limits the display of Hideshow indicators to buffers |
| 1020 | that are not too large. By default, buffers larger than 2MB have the | 1022 | that are not too large. By default, buffers larger than 2MB have the |
| 1021 | indicators disabled; the value of nil will activate the indicators | 1023 | indicators disabled; the value of nil will activate the indicators |
| 1022 | regardless of the buffer size. | 1024 | regardless of the buffer size. |
| 1023 | 1025 | ||
| 1024 | +++ | 1026 | +++ |
| 1025 | *** New user option 'hs-indicator-type'. | 1027 | *** New user option 'hs-indicator-type'. |
| 1026 | This user option determine which indicator type should be used for the | 1028 | This user option determines which indicator type should be used for the |
| 1027 | block indicators. | 1029 | block indicators. |
| 1028 | 1030 | ||
| 1029 | The possible values can be: 'fringe', display the indicators in the | 1031 | The possible values can be: 'fringe', display the indicators in the |
| 1030 | fringe (the default); 'margin', display the indicators in the margin; | 1032 | fringe (the default); 'margin', display the indicators in the margin; |
| 1031 | nil, display the indicators at end-of-line. | 1033 | nil, display the indicators at end-of-line. |
| 1032 | 1034 | ||
| 1033 | The new icons 'hs-indicator-show' and 'hs-indicator-hide', can be used | 1035 | The new icons 'hs-indicator-show' and 'hs-indicator-hide' can be used |
| 1034 | for customize the indicators appearance, only if 'hs-indicator-type' is | 1036 | to customize the indicators appearance only if 'hs-indicator-type' is |
| 1035 | set to 'margin' or nil. | 1037 | set 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 | |||
| 1043 | blocks are syntax-highlighted if the Doxygen grammar library is | 1045 | blocks are syntax-highlighted if the Doxygen grammar library is |
| 1044 | available. | 1046 | available. |
| 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'. |
| 1049 | The feature 'property' has been renamed to 'attribute', since this is | 1051 | The feature 'property' has been renamed to 'attribute', since this is |
| 1050 | what it is called in the general C# community. | 1052 | what it is called in the general C# community. |
| 1051 | 1053 | ||
| @@ -1491,8 +1493,8 @@ It removes all the buttons in the specified region. | |||
| 1491 | You can now bookmark local and remote shell buffers using the bookmark | 1493 | You can now bookmark local and remote shell buffers using the bookmark |
| 1492 | menu 'bookmark-bmenu-list', or by using the command 'bookmark-set'. | 1494 | menu 'bookmark-bmenu-list', or by using the command 'bookmark-set'. |
| 1493 | Shell bookmarks can be loaded via the menu and by using the command | 1495 | Shell 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, |
| 1495 | its current directory, and create a remote connection, if necessary. | 1497 | its current directory, and creates a remote connection, if necessary. |
| 1496 | You can customize 'shell-bookmark-name-function'. | 1498 | You 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 |
| 3020 | previous implementations of '{next,previous}-completion', which better | 3022 | previous implementations of '{next,previous}-completion', which better |
| 3021 | reflect that they only take the (default) horizontal completions format | 3023 | reflect that they only take the (default) horizontal completions format |
| 3022 | into account. Any external code using '{next,previous}-completion' that | 3024 | into account. Any external code using '{next,previous}-completion', that |
| 3023 | assumes the previous implementation must be adjusted accordingly; see | 3025 | assumes 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 |
| 3025 | Emacs core. | 3027 | Emacs 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 | |||
| 234 | automatically. See Info node `(epa)Encrypting/decrypting gpg files' | 234 | automatically. See Info node `(epa)Encrypting/decrypting gpg files' |
| 235 | for details. | 235 | for details. |
| 236 | 236 | ||
| 237 | If this option is nil, no authentication source is used but the local | ||
| 238 | password cache. | ||
| 239 | |||
| 237 | It's best to customize this with \\[customize-variable] because | 240 | It's best to customize this with \\[customize-variable] because |
| 238 | the choices can get pretty complex." | 241 | the 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'. | ||
| 379 | A 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. | ||
| 407 | If 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. |
| 375 | Consequently, no newly created entry is saved in such a backend when | 417 | Consequently, 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 | ||
| 696 | The token's :secret key can hold a function. In that case you | 741 | The token's :secret key can hold a function. In that case you |
| 697 | must call it to obtain the actual value." | 742 | must 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 "\ |