diff options
| author | F. Jason Park | 2022-11-01 22:46:24 -0700 |
|---|---|---|
| committer | F. Jason Park | 2022-11-16 21:34:36 -0800 |
| commit | 2cf9e699ef0fc43a4eadaf00a1ed2f876765c64d (patch) | |
| tree | c01e9bdcd25372207f94650315d1596ae445454d | |
| parent | 0147e1ed831151dddac65727886d5a70bbab9f02 (diff) | |
| download | emacs-2cf9e699ef0fc43a4eadaf00a1ed2f876765c64d.tar.gz emacs-2cf9e699ef0fc43a4eadaf00a1ed2f876765c64d.zip | |
Make auth-source-pass behave more like other backends
* lisp/auth-source-pass.el (auth-source-pass-extra-query-keywords): Add
new option to bring search behavior more in line with other backends.
(auth-source-pass-search): Add new keyword params `max' and `require'
and consider new option `auth-source-pass-extra-query-keywords' for
dispatch.
(auth-source-pass--match-regexp, auth-source-pass--retrieve-parsed,
auth-source-pass--match-parts): Add supporting variable and helpers.
(auth-source-pass--build-result-many,
auth-source-pass--find-match-many): Add "-many" variants for existing
workhorse functions.
* test/lisp/auth-source-pass-tests.el: Require `ert-x'.
(auth-source-pass-can-start-from-auth-source-search): Ensure
`auth-source-pass-extra-query-keywords' is enabled around test body.
(auth-source-pass-extra-query-keywords--wild-port-miss-netrc,
auth-source-pass-extra-query-keywords--wild-port-miss,
auth-source-pass-extra-query-keywords--wild-port-hit-netrc,
auth-source-pass-extra-query-keywords--wild-port-hit,
auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc,
auth-source-pass-extra-query-keywords--wild-port-req-miss,
auth-source-pass-extra-query-keywords--netrc-akib,
auth-source-pass-extra-query-keywords--akib,
auth-source-pass-extra-query-keywords--netrc-host,
auth-source-pass-extra-query-keywords--host,
auth-source-pass-extra-query-keywords--baseline,
auth-source-pass-extra-query-keywords--port-type,
auth-source-pass-extra-query-keywords--hosts-first,
auth-source-pass-extra-query-keywords--ambiguous-user-host,
auth-source-pass-extra-query-keywords--suffixed-user,
auth-source-pass-extra-query-keywords--user-priorities): Add
juxtaposed netrc and extra-query-keywords pairs to demo optional
extra-compliant behavior.
* doc/misc/auth.texi: Add option
`auth-source-pass-extra-query-keywords' to auth-source-pass section.
* etc/NEWS: Mention `auth-source-pass-extra-query-keywords' in Emacs
29.1 package changes section. (Bug#58985.)
Special thanks to Akib Azmain Turja <akib@disroot.org> for helping
improve this patch.
| -rw-r--r-- | doc/misc/auth.texi | 18 | ||||
| -rw-r--r-- | etc/NEWS | 8 | ||||
| -rw-r--r-- | lisp/auth-source-pass.el | 112 | ||||
| -rw-r--r-- | test/lisp/auth-source-pass-tests.el | 267 |
4 files changed, 402 insertions, 3 deletions
diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 9dc63af6bcc..872e5f88f55 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi | |||
| @@ -526,6 +526,8 @@ If several entries match, the one matching the most items (where an | |||
| 526 | while searching for an entry matching the @code{rms} user on host | 526 | while searching for an entry matching the @code{rms} user on host |
| 527 | @code{gnu.org} and port @code{22}, then the entry | 527 | @code{gnu.org} and port @code{22}, then the entry |
| 528 | @file{gnu.org:22/rms.gpg} is preferred over @file{gnu.org.gpg}. | 528 | @file{gnu.org:22/rms.gpg} is preferred over @file{gnu.org.gpg}. |
| 529 | However, such processing is not applied when the option | ||
| 530 | @code{auth-source-pass-extra-parameters} is set to @code{t}. | ||
| 529 | 531 | ||
| 530 | Users of @code{pass} may also be interested in functionality provided | 532 | Users of @code{pass} may also be interested in functionality provided |
| 531 | by other Emacs packages: | 533 | by other Emacs packages: |
| @@ -549,6 +551,22 @@ Set this variable to a string that should separate an host name from a | |||
| 549 | port in an entry. Defaults to @samp{:}. | 551 | port in an entry. Defaults to @samp{:}. |
| 550 | @end defvar | 552 | @end defvar |
| 551 | 553 | ||
| 554 | @defvar auth-source-pass-extra-query-keywords | ||
| 555 | This expands the selection of available keywords to include | ||
| 556 | @code{:max} and @code{:require} and tells more of them to accept a | ||
| 557 | list of query parameters as an argument. When searching, it also | ||
| 558 | favors the @samp{rms@@gnu.org.gpg} form for usernames over the | ||
| 559 | @samp{gnu.org/rms.gpg} form, regardless of whether a @code{:user} | ||
| 560 | param was provided. | ||
| 561 | |||
| 562 | In general, if you prefer idiosyncrasies traditionally exhibited by | ||
| 563 | this backend, such as prioritizing field count in a filename, try | ||
| 564 | setting this option to @code{nil}. But, if you experience problems | ||
| 565 | predicting the outcome of searches relative to other auth-source | ||
| 566 | backends or encounter code expecting to query multiple backends | ||
| 567 | uniformly, try flipping it back to @code{t} (the default). | ||
| 568 | @end defvar | ||
| 569 | |||
| 552 | @node Help for developers | 570 | @node Help for developers |
| 553 | @chapter Help for developers | 571 | @chapter Help for developers |
| 554 | 572 | ||
| @@ -1395,6 +1395,14 @@ If non-nil and there's only one matching option, auto-select that. | |||
| 1395 | If non-nil, this user option describes what entries not to add to the | 1395 | If non-nil, this user option describes what entries not to add to the |
| 1396 | database stored on disk. | 1396 | database stored on disk. |
| 1397 | 1397 | ||
| 1398 | ** Auth-Source | ||
| 1399 | |||
| 1400 | +++ | ||
| 1401 | *** New user option 'auth-source-pass-extra-query-keywords'. | ||
| 1402 | Whether to recognize additional keyword params, like ':max' and | ||
| 1403 | ':require', as well as accept lists of query terms paired with | ||
| 1404 | applicable keywords. | ||
| 1405 | |||
| 1398 | ** Dired | 1406 | ** Dired |
| 1399 | 1407 | ||
| 1400 | +++ | 1408 | +++ |
diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 0955e2ed07e..dc274843e10 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el | |||
| @@ -55,13 +55,27 @@ | |||
| 55 | :type 'string | 55 | :type 'string |
| 56 | :version "27.1") | 56 | :version "27.1") |
| 57 | 57 | ||
| 58 | (defcustom auth-source-pass-extra-query-keywords t | ||
| 59 | "Whether to consider additional keywords when performing a query. | ||
| 60 | Specifically, when the value is t, recognize the `:max' and | ||
| 61 | `:require' keywords and accept lists of query parameters for | ||
| 62 | certain keywords, such as `:host' and `:user'. Also, wrap all | ||
| 63 | returned secrets in a function and forgo any further results | ||
| 64 | filtering unless given an applicable `:require' argument. When | ||
| 65 | this option is nil, do none of that, and enact the narrowing | ||
| 66 | behavior described toward the bottom of the Info node `(auth) The | ||
| 67 | Unix password store'." | ||
| 68 | :type 'boolean | ||
| 69 | :version "29.1") | ||
| 70 | |||
| 58 | (cl-defun auth-source-pass-search (&rest spec | 71 | (cl-defun auth-source-pass-search (&rest spec |
| 59 | &key backend type host user port | 72 | &key backend type host user port |
| 73 | require max | ||
| 60 | &allow-other-keys) | 74 | &allow-other-keys) |
| 61 | "Given some search query, return matching credentials. | 75 | "Given some search query, return matching credentials. |
| 62 | 76 | ||
| 63 | See `auth-source-search' for details on the parameters SPEC, BACKEND, TYPE, | 77 | See `auth-source-search' for details on the parameters SPEC, BACKEND, TYPE, |
| 64 | HOST, USER and PORT." | 78 | HOST, USER, PORT, REQUIRE, and MAX." |
| 65 | (cl-assert (or (null type) (eq type (oref backend type))) | 79 | (cl-assert (or (null type) (eq type (oref backend type))) |
| 66 | t "Invalid password-store search: %s %s") | 80 | t "Invalid password-store search: %s %s") |
| 67 | (cond ((eq host t) | 81 | (cond ((eq host t) |
| @@ -70,6 +84,8 @@ HOST, USER and PORT." | |||
| 70 | ((null host) | 84 | ((null host) |
| 71 | ;; Do not build a result, as none will match when HOST is nil | 85 | ;; Do not build a result, as none will match when HOST is nil |
| 72 | nil) | 86 | nil) |
| 87 | (auth-source-pass-extra-query-keywords | ||
| 88 | (auth-source-pass--build-result-many host port user require max)) | ||
| 73 | (t | 89 | (t |
| 74 | (when-let ((result (auth-source-pass--build-result host port user))) | 90 | (when-let ((result (auth-source-pass--build-result host port user))) |
| 75 | (list result))))) | 91 | (list result))))) |
| @@ -89,6 +105,39 @@ HOSTS can be a string or a list of strings." | |||
| 89 | (seq-subseq retval 0 -2)) ;; remove password | 105 | (seq-subseq retval 0 -2)) ;; remove password |
| 90 | retval)))) | 106 | retval)))) |
| 91 | 107 | ||
| 108 | (defvar auth-source-pass--match-regexp nil) | ||
| 109 | |||
| 110 | (defun auth-source-pass--match-regexp (s) | ||
| 111 | (rx-to-string ; autoloaded | ||
| 112 | `(: (or bot "/") | ||
| 113 | (or (: (? (group-n 20 (+ (not (in ?\ ?/ ?@ ,s)))) "@") | ||
| 114 | (group-n 10 (+ (not (in ?\ ?/ ?@ ,s)))) | ||
| 115 | (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s)))))) | ||
| 116 | (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s)))) | ||
| 117 | (? ,s (group-n 31 (+ (not (in ?\ ?/ ,s))))) | ||
| 118 | (? "/" (group-n 21 (+ (not (in ?\ ?/ ,s))))))) | ||
| 119 | eot) | ||
| 120 | 'no-group)) | ||
| 121 | |||
| 122 | (defun auth-source-pass--build-result-many (hosts ports users require max) | ||
| 123 | "Return multiple `auth-source-pass--build-result' values." | ||
| 124 | (unless (listp hosts) (setq hosts (list hosts))) | ||
| 125 | (unless (listp users) (setq users (list users))) | ||
| 126 | (unless (listp ports) (setq ports (list ports))) | ||
| 127 | (let* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp | ||
| 128 | auth-source-pass-port-separator)) | ||
| 129 | (rv (auth-source-pass--find-match-many hosts users ports | ||
| 130 | require (or max 1)))) | ||
| 131 | (when auth-source-debug | ||
| 132 | (auth-source-pass--do-debug "final result: %S" rv)) | ||
| 133 | (let (out) | ||
| 134 | (dolist (e rv out) | ||
| 135 | (when-let* ((s (plist-get e :secret)) ; not captured by closure in 29.1 | ||
| 136 | (v (auth-source--obfuscate s))) | ||
| 137 | (setf (plist-get e :secret) | ||
| 138 | (lambda () (auth-source--deobfuscate v)))) | ||
| 139 | (push e out))))) | ||
| 140 | |||
| 92 | ;;;###autoload | 141 | ;;;###autoload |
| 93 | (defun auth-source-pass-enable () | 142 | (defun auth-source-pass-enable () |
| 94 | "Enable auth-source-password-store." | 143 | "Enable auth-source-password-store." |
| @@ -206,6 +255,67 @@ HOSTS can be a string or a list of strings." | |||
| 206 | hosts | 255 | hosts |
| 207 | (list hosts)))) | 256 | (list hosts)))) |
| 208 | 257 | ||
| 258 | (defun auth-source-pass--retrieve-parsed (seen path port-number-p) | ||
| 259 | (when (string-match auth-source-pass--match-regexp path) | ||
| 260 | (puthash path | ||
| 261 | `( :host ,(or (match-string 10 path) (match-string 11 path)) | ||
| 262 | ,@(if-let* ((tr (match-string 21 path))) | ||
| 263 | (list :user tr :suffix t) | ||
| 264 | (list :user (match-string 20 path))) | ||
| 265 | :port ,(and-let* ((p (or (match-string 30 path) | ||
| 266 | (match-string 31 path))) | ||
| 267 | (n (string-to-number p))) | ||
| 268 | (if (or (zerop n) (not port-number-p)) | ||
| 269 | (format "%s" p) | ||
| 270 | n))) | ||
| 271 | seen))) | ||
| 272 | |||
| 273 | (defun auth-source-pass--match-parts (parts key value require) | ||
| 274 | (let ((mv (plist-get parts key))) | ||
| 275 | (if (memq key require) | ||
| 276 | (and value (equal mv value)) | ||
| 277 | (or (not value) (not mv) (equal mv value))))) | ||
| 278 | |||
| 279 | (defun auth-source-pass--find-match-many (hosts users ports require max) | ||
| 280 | "Return plists for valid combinations of HOSTS, USERS, PORTS." | ||
| 281 | (let ((seen (make-hash-table :test #'equal)) | ||
| 282 | (entries (auth-source-pass-entries)) | ||
| 283 | out suffixed suffixedp) | ||
| 284 | (catch 'done | ||
| 285 | (dolist (host hosts out) | ||
| 286 | (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host))) | ||
| 287 | (unless (or (not (equal "443" p)) (string-prefix-p "https://" host)) | ||
| 288 | (setq p nil)) | ||
| 289 | (dolist (user (or users (list u))) | ||
| 290 | (dolist (port (or ports (list p))) | ||
| 291 | (dolist (e entries) | ||
| 292 | (when-let* | ||
| 293 | ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed | ||
| 294 | seen e (integerp port)))) | ||
| 295 | ((equal host (plist-get m :host))) | ||
| 296 | ((auth-source-pass--match-parts m :port port require)) | ||
| 297 | ((auth-source-pass--match-parts m :user user require)) | ||
| 298 | (parsed (auth-source-pass-parse-entry e)) | ||
| 299 | ;; For now, ignore body-content pairs, if any, | ||
| 300 | ;; from `auth-source-pass--parse-data'. | ||
| 301 | (secret (or (auth-source-pass--get-attr 'secret parsed) | ||
| 302 | (not (memq :secret require))))) | ||
| 303 | (push | ||
| 304 | `( :host ,host ; prefer user-provided :host over h | ||
| 305 | ,@(and-let* ((u (plist-get m :user))) (list :user u)) | ||
| 306 | ,@(and-let* ((p (plist-get m :port))) (list :port p)) | ||
| 307 | ,@(and secret (not (eq secret t)) (list :secret secret))) | ||
| 308 | (if (setq suffixedp (plist-get m :suffix)) suffixed out)) | ||
| 309 | (unless suffixedp | ||
| 310 | (when (or (zerop (cl-decf max)) | ||
| 311 | (null (setq entries (delete e entries)))) | ||
| 312 | (throw 'done out))))) | ||
| 313 | (setq suffixed (nreverse suffixed)) | ||
| 314 | (while suffixed | ||
| 315 | (push (pop suffixed) out) | ||
| 316 | (when (zerop (cl-decf max)) | ||
| 317 | (throw 'done out)))))))))) | ||
| 318 | |||
| 209 | (defun auth-source-pass--disambiguate (host &optional user port) | 319 | (defun auth-source-pass--disambiguate (host &optional user port) |
| 210 | "Return (HOST USER PORT) after disambiguation. | 320 | "Return (HOST USER PORT) after disambiguation. |
| 211 | Disambiguate between having user provided inside HOST (e.g., | 321 | Disambiguate between having user provided inside HOST (e.g., |
diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index f5147a7ce07..8bcb2739bb3 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el | |||
| @@ -25,7 +25,7 @@ | |||
| 25 | 25 | ||
| 26 | ;;; Code: | 26 | ;;; Code: |
| 27 | 27 | ||
| 28 | (require 'ert) | 28 | (require 'ert-x) |
| 29 | 29 | ||
| 30 | (require 'auth-source-pass) | 30 | (require 'auth-source-pass) |
| 31 | 31 | ||
| @@ -466,7 +466,10 @@ HOSTNAME, USER and PORT are passed unchanged to | |||
| 466 | (ert-deftest auth-source-pass-can-start-from-auth-source-search () | 466 | (ert-deftest auth-source-pass-can-start-from-auth-source-search () |
| 467 | (auth-source-pass--with-store '(("gitlab.com" ("user" . "someone"))) | 467 | (auth-source-pass--with-store '(("gitlab.com" ("user" . "someone"))) |
| 468 | (auth-source-pass-enable) | 468 | (auth-source-pass-enable) |
| 469 | (let ((result (car (auth-source-search :host "gitlab.com")))) | 469 | ;; This also asserts an aspect of traditional search behavior |
| 470 | ;; relative to `auth-source-pass-extra-query-keywords'. | ||
| 471 | (let* ((auth-source-pass-extra-query-keywords nil) | ||
| 472 | (result (car (auth-source-search :host "gitlab.com")))) | ||
| 470 | (should (equal (plist-get result :user) "someone")) | 473 | (should (equal (plist-get result :user) "someone")) |
| 471 | (should (equal (plist-get result :host) "gitlab.com"))))) | 474 | (should (equal (plist-get result :host) "gitlab.com"))))) |
| 472 | 475 | ||
| @@ -488,6 +491,266 @@ HOSTNAME, USER and PORT are passed unchanged to | |||
| 488 | (should (auth-source-pass--have-message-matching | 491 | (should (auth-source-pass--have-message-matching |
| 489 | "found 2 entries matching \"gitlab.com\": (\"a/gitlab.com\" \"b/gitlab.com\")")))) | 492 | "found 2 entries matching \"gitlab.com\": (\"a/gitlab.com\" \"b/gitlab.com\")")))) |
| 490 | 493 | ||
| 494 | |||
| 495 | ;;;; Option `auth-source-pass-extra-query-keywords' (bug#58985) | ||
| 496 | |||
| 497 | ;; No entry has the requested port, but a result is still returned. | ||
| 498 | |||
| 499 | (ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss-netrc () | ||
| 500 | (ert-with-temp-file netrc-file | ||
| 501 | :text "\ | ||
| 502 | machine x.com password a | ||
| 503 | machine x.com port 42 password b | ||
| 504 | " | ||
| 505 | (let* ((auth-sources (list netrc-file)) | ||
| 506 | (auth-source-do-cache nil) | ||
| 507 | (results (auth-source-search :host "x.com" :port 22 :max 2))) | ||
| 508 | (dolist (result results) | ||
| 509 | (setf (plist-get result :secret) (auth-info-password result))) | ||
| 510 | (should (equal results '((:host "x.com" :secret "a"))))))) | ||
| 511 | |||
| 512 | (ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss () | ||
| 513 | (auth-source-pass--with-store '(("x.com" (secret . "a")) | ||
| 514 | ("x.com:42" (secret . "b"))) | ||
| 515 | (auth-source-pass-enable) | ||
| 516 | (let* ((auth-source-pass-extra-query-keywords t) | ||
| 517 | (results (auth-source-search :host "x.com" :port 22 :max 2))) | ||
| 518 | (dolist (result results) | ||
| 519 | (setf (plist-get result :secret) (auth-info-password result))) | ||
| 520 | (should (equal results '((:host "x.com" :secret "a"))))))) | ||
| 521 | |||
| 522 | ;; One of two entries has the requested port, both returned. | ||
| 523 | |||
| 524 | (ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit-netrc () | ||
| 525 | (ert-with-temp-file netrc-file | ||
| 526 | :text "\ | ||
| 527 | machine x.com password a | ||
| 528 | machine x.com port 42 password b | ||
| 529 | " | ||
| 530 | (let* ((auth-sources (list netrc-file)) | ||
| 531 | (auth-source-do-cache nil) | ||
| 532 | (results (auth-source-search :host "x.com" :port 42 :max 2))) | ||
| 533 | (dolist (result results) | ||
| 534 | (setf (plist-get result :secret) (auth-info-password result))) | ||
| 535 | (should (equal results '((:host "x.com" :secret "a") | ||
| 536 | (:host "x.com" :port "42" :secret "b"))))))) | ||
| 537 | |||
| 538 | (ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit () | ||
| 539 | (auth-source-pass--with-store '(("x.com" (secret . "a")) | ||
| 540 | ("x.com:42" (secret . "b"))) | ||
| 541 | (auth-source-pass-enable) | ||
| 542 | (let* ((auth-source-pass-extra-query-keywords t) | ||
| 543 | (results (auth-source-search :host "x.com" :port 42 :max 2))) | ||
| 544 | (dolist (result results) | ||
| 545 | (setf (plist-get result :secret) (auth-info-password result))) | ||
| 546 | (should (equal results | ||
| 547 | '((:host "x.com" :secret "a") | ||
| 548 | (:host "x.com" :port 42 :secret "b"))))))) | ||
| 549 | |||
| 550 | ;; No entry has the requested port, but :port is required, so search fails. | ||
| 551 | |||
| 552 | (ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc () | ||
| 553 | (ert-with-temp-file netrc-file | ||
| 554 | :text "\ | ||
| 555 | machine x.com password a | ||
| 556 | machine x.com port 42 password b | ||
| 557 | " | ||
| 558 | (let* ((auth-sources (list netrc-file)) | ||
| 559 | (auth-source-do-cache nil) | ||
| 560 | (results (auth-source-search | ||
| 561 | :host "x.com" :port 22 :require '(:port) :max 2))) | ||
| 562 | (should-not results)))) | ||
| 563 | |||
| 564 | (ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss () | ||
| 565 | (let ((auth-source-pass-extra-query-keywords t)) | ||
| 566 | (auth-source-pass--with-store '(("x.com" (secret . "a")) | ||
| 567 | ("x.com:42" (secret . "b"))) | ||
| 568 | (auth-source-pass-enable) | ||
| 569 | (should-not (auth-source-search | ||
| 570 | :host "x.com" :port 22 :require '(:port) :max 2))))) | ||
| 571 | |||
| 572 | ;; Specifying a :host without a :user finds a lone entry and does not | ||
| 573 | ;; include extra fields (i.e., :port nil) in the result. | ||
| 574 | ;; https://lists.gnu.org/archive/html/emacs-devel/2022-11/msg00130.html | ||
| 575 | |||
| 576 | (ert-deftest auth-source-pass-extra-query-keywords--netrc-akib () | ||
| 577 | (ert-with-temp-file netrc-file | ||
| 578 | :text "\ | ||
| 579 | machine x.com password a | ||
| 580 | machine disroot.org user akib password b | ||
| 581 | machine z.com password c | ||
| 582 | " | ||
| 583 | (let* ((auth-sources (list netrc-file)) | ||
| 584 | (auth-source-do-cache nil) | ||
| 585 | (results (auth-source-search :host "disroot.org" :max 2))) | ||
| 586 | (dolist (result results) | ||
| 587 | (setf (plist-get result :secret) (auth-info-password result))) | ||
| 588 | (should (equal results | ||
| 589 | '((:host "disroot.org" :user "akib" :secret "b"))))))) | ||
| 590 | |||
| 591 | (ert-deftest auth-source-pass-extra-query-keywords--akib () | ||
| 592 | (auth-source-pass--with-store '(("x.com" (secret . "a")) | ||
| 593 | ("akib@disroot.org" (secret . "b")) | ||
| 594 | ("z.com" (secret . "c"))) | ||
| 595 | (auth-source-pass-enable) | ||
| 596 | (let* ((auth-source-pass-extra-query-keywords t) | ||
| 597 | (results (auth-source-search :host "disroot.org" :max 2))) | ||
| 598 | (dolist (result results) | ||
| 599 | (setf (plist-get result :secret) (auth-info-password result))) | ||
| 600 | (should (equal results | ||
| 601 | '((:host "disroot.org" :user "akib" :secret "b"))))))) | ||
| 602 | |||
| 603 | ;; Searches for :host are case-sensitive, and a returned host isn't | ||
| 604 | ;; normalized. | ||
| 605 | |||
| 606 | (ert-deftest auth-source-pass-extra-query-keywords--netrc-host () | ||
| 607 | (ert-with-temp-file netrc-file | ||
| 608 | :text "\ | ||
| 609 | machine libera.chat password a | ||
| 610 | machine Libera.Chat password b | ||
| 611 | " | ||
| 612 | (let* ((auth-sources (list netrc-file)) | ||
| 613 | (auth-source-do-cache nil) | ||
| 614 | (results (auth-source-search :host "Libera.Chat" :max 2))) | ||
| 615 | (dolist (result results) | ||
| 616 | (setf (plist-get result :secret) (auth-info-password result))) | ||
| 617 | (should (equal results '((:host "Libera.Chat" :secret "b"))))))) | ||
| 618 | |||
| 619 | (ert-deftest auth-source-pass-extra-query-keywords--host () | ||
| 620 | (auth-source-pass--with-store '(("libera.chat" (secret . "a")) | ||
| 621 | ("Libera.Chat" (secret . "b"))) | ||
| 622 | (auth-source-pass-enable) | ||
| 623 | (let* ((auth-source-pass-extra-query-keywords t) | ||
| 624 | (results (auth-source-search :host "Libera.Chat" :max 2))) | ||
| 625 | (dolist (result results) | ||
| 626 | (setf (plist-get result :secret) (auth-info-password result))) | ||
| 627 | (should (equal results | ||
| 628 | '((:host "Libera.Chat" :secret "b"))))))) | ||
| 629 | |||
| 630 | |||
| 631 | ;; A retrieved store entry mustn't be nil regardless of whether its | ||
| 632 | ;; path contains port or user components. | ||
| 633 | |||
| 634 | (ert-deftest auth-source-pass-extra-query-keywords--baseline () | ||
| 635 | (let ((auth-source-pass-extra-query-keywords t)) | ||
| 636 | (auth-source-pass--with-store '(("x.com")) | ||
| 637 | (auth-source-pass-enable) | ||
| 638 | (should-not (auth-source-search :host "x.com"))))) | ||
| 639 | |||
| 640 | ;; Output port type (int or string) matches that of input parameter. | ||
| 641 | |||
| 642 | (ert-deftest auth-source-pass-extra-query-keywords--port-type () | ||
| 643 | (let ((auth-source-pass-extra-query-keywords t) | ||
| 644 | (f (lambda (r) (setf (plist-get r :secret) (auth-info-password r)) r))) | ||
| 645 | (auth-source-pass--with-store '(("x.com:42" (secret . "a"))) | ||
| 646 | (auth-source-pass-enable) | ||
| 647 | (should (equal (mapcar f (auth-source-search :host "x.com" :port 42)) | ||
| 648 | '((:host "x.com" :port 42 :secret "a"))))) | ||
| 649 | (auth-source-pass--with-store '(("x.com:42" (secret . "a"))) | ||
| 650 | (auth-source-pass-enable) | ||
| 651 | (should (equal (mapcar f (auth-source-search :host "x.com" :port "42")) | ||
| 652 | '((:host "x.com" :port "42" :secret "a"))))))) | ||
| 653 | |||
| 654 | ;; Match precision sometimes takes a back seat to the traversal | ||
| 655 | ;; ordering. Specifically, the :host (h1, ...) args hold greater sway | ||
| 656 | ;; over the output because they determine the first coordinate in the | ||
| 657 | ;; sequence of (host, user, port) combinations visited. (Taking a | ||
| 658 | ;; tree-wise view, these become the depth-1 nodes in a DFS.) | ||
| 659 | |||
| 660 | ;; Note that all trailing /user forms are demoted for the sake of | ||
| 661 | ;; predictability (see tests further below for details). This means | ||
| 662 | ;; that, in the following test, /bar is held in limbo, followed by | ||
| 663 | ;; /foo, but they both retain priority over "gnu.org", as noted above. | ||
| 664 | |||
| 665 | (ert-deftest auth-source-pass-extra-query-keywords--hosts-first () | ||
| 666 | (auth-source-pass--with-store '(("x.com:42/bar" (secret . "a")) | ||
| 667 | ("gnu.org" (secret . "b")) | ||
| 668 | ("x.com" (secret . "c")) | ||
| 669 | ("fake.com" (secret . "d")) | ||
| 670 | ("x.com/foo" (secret . "e"))) | ||
| 671 | (auth-source-pass-enable) | ||
| 672 | (let* ((auth-source-pass-extra-query-keywords t) | ||
| 673 | (results (auth-source-search :host '("x.com" "gnu.org") :max 3))) | ||
| 674 | (dolist (result results) | ||
| 675 | (setf (plist-get result :secret) (auth-info-password result))) | ||
| 676 | (should (equal results | ||
| 677 | ;; Notice gnu.org is never considered ^ | ||
| 678 | '((:host "x.com" :secret "c") | ||
| 679 | (:host "x.com" :user "bar" :port "42" :secret "a") | ||
| 680 | (:host "x.com" :user "foo" :secret "e"))))))) | ||
| 681 | |||
| 682 | ;; This is another example given in the bug thread. | ||
| 683 | |||
| 684 | (ert-deftest auth-source-pass-extra-query-keywords--ambiguous-user-host () | ||
| 685 | (auth-source-pass--with-store '(("foo.com/bar.org" (secret . "a")) | ||
| 686 | ("foo.com" (secret . "b")) | ||
| 687 | ("bar.org" (secret . "c")) | ||
| 688 | ("fake.com" (secret . "d"))) | ||
| 689 | (auth-source-pass-enable) | ||
| 690 | (let* ((auth-source-pass-extra-query-keywords t) | ||
| 691 | (results (auth-source-search :host "bar.org" :max 3))) | ||
| 692 | (dolist (result results) | ||
| 693 | (setf (plist-get result :secret) (auth-info-password result))) | ||
| 694 | (should (equal results '((:host "bar.org" :secret "c"))))))) | ||
| 695 | |||
| 696 | ;; This conveys the same idea as `user-priorities', just below, but | ||
| 697 | ;; with slightly more realistic and less legible values. | ||
| 698 | |||
| 699 | (ert-deftest auth-source-pass-extra-query-keywords--suffixed-user () | ||
| 700 | (let ((store (sort (copy-sequence '(("x.com:42/bar" (secret . "a")) | ||
| 701 | ("bar@x.com" (secret . "b")) | ||
| 702 | ("x.com" (secret . "?")) | ||
| 703 | ("bar@y.org" (secret . "c")) | ||
| 704 | ("fake.com" (secret . "?")) | ||
| 705 | ("fake.com/bar" (secret . "d")) | ||
| 706 | ("y.org/bar" (secret . "?")) | ||
| 707 | ("bar@fake.com" (secret . "e")))) | ||
| 708 | (lambda (&rest _) (zerop (random 2)))))) | ||
| 709 | (auth-source-pass--with-store store | ||
| 710 | (auth-source-pass-enable) | ||
| 711 | (let* ((auth-source-pass-extra-query-keywords t) | ||
| 712 | (results (auth-source-search :host '("x.com" "fake.com" "y.org") | ||
| 713 | :user "bar" | ||
| 714 | :require '(:user) :max 5))) | ||
| 715 | (dolist (result results) | ||
| 716 | (setf (plist-get result :secret) (auth-info-password result))) | ||
| 717 | (should (equal results | ||
| 718 | '((:host "x.com" :user "bar" :secret "b") | ||
| 719 | (:host "x.com" :user "bar" :port "42" :secret "a") | ||
| 720 | (:host "fake.com" :user "bar" :secret "e") | ||
| 721 | (:host "fake.com" :user "bar" :secret "d") | ||
| 722 | (:host "y.org" :user "bar" :secret "c")))))))) | ||
| 723 | |||
| 724 | ;; This is a more distilled version of `suffixed-user', above. It | ||
| 725 | ;; better illustrates that search order takes precedence over "/user" | ||
| 726 | ;; demotion because otherwise * and ** would be swapped, below. It | ||
| 727 | ;; follows that omitting the :port 2, gets you {u@h:1, u@h:2, h:1/u, | ||
| 728 | ;; h:2/u, u@g:1}. | ||
| 729 | |||
| 730 | (ert-deftest auth-source-pass-extra-query-keywords--user-priorities () | ||
| 731 | (let ((store (sort (copy-sequence '(("h:1/u" (secret . "/")) | ||
| 732 | ("h:2/u" (secret . "/")) | ||
| 733 | ("u@h:1" (secret . "@")) | ||
| 734 | ("u@h:2" (secret . "@")) | ||
| 735 | ("g:1/u" (secret . "/")) | ||
| 736 | ("g:2/u" (secret . "/")) | ||
| 737 | ("u@g:1" (secret . "@")) | ||
| 738 | ("u@g:2" (secret . "@")))) | ||
| 739 | (lambda (&rest _) (zerop (random 2)))))) | ||
| 740 | (auth-source-pass--with-store store | ||
| 741 | (auth-source-pass-enable) | ||
| 742 | (let* ((auth-source-pass-extra-query-keywords t) | ||
| 743 | (results (auth-source-search :host '("h" "g") | ||
| 744 | :port 2 | ||
| 745 | :max 5))) | ||
| 746 | (dolist (result results) | ||
| 747 | (setf (plist-get result :secret) (auth-info-password result))) | ||
| 748 | (should (equal results | ||
| 749 | '((:host "h" :user "u" :port 2 :secret "@") | ||
| 750 | (:host "h" :user "u" :port 2 :secret "/") ; * | ||
| 751 | (:host "g" :user "u" :port 2 :secret "@") ; ** | ||
| 752 | (:host "g" :user "u" :port 2 :secret "/")))))))) | ||
| 753 | |||
| 491 | (provide 'auth-source-pass-tests) | 754 | (provide 'auth-source-pass-tests) |
| 492 | 755 | ||
| 493 | ;;; auth-source-pass-tests.el ends here | 756 | ;;; auth-source-pass-tests.el ends here |