diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 03fd1f35811..dd93d414d5e 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -271,11 +271,12 @@ HOSTS can be a string or a list of strings." n))) seen))) -(defun auth-source-pass--match-parts (parts key value require) - (let ((mv (plist-get parts key))) - (if (memq key require) - (and value (equal mv value)) - (or (not value) (not mv) (equal mv value))))) +(defun auth-source-pass--match-parts (cache key reference require) + (let ((value (plist-get cache key))) + (cond ((memq key require) + (if reference (equal value reference) value)) + ((and value reference) (equal value reference)) + (t)))) (defun auth-source-pass--find-match-many (hosts users ports require max) "Return plists for valid combinations of HOSTS, USERS, PORTS." @@ -290,17 +291,17 @@ HOSTS can be a string or a list of strings." (dolist (user (or users (list u))) (dolist (port (or ports (list p))) (dolist (e entries) - (when-let* + (when-let ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed seen e (integerp port)))) ((equal host (plist-get m :host))) ((auth-source-pass--match-parts m :port port require)) ((auth-source-pass--match-parts m :user user require)) - (parsed (auth-source-pass-parse-entry e)) ;; For now, ignore body-content pairs, if any, ;; from `auth-source-pass--parse-data'. - (secret (or (auth-source-pass--get-attr 'secret parsed) - (not (memq :secret require))))) + (secret (let ((parsed (auth-source-pass-parse-entry e))) + (or (auth-source-pass--get-attr 'secret parsed) + (not (memq :secret require)))))) (push `( :host ,host ; prefer user-provided :host over h ,@(and-let* ((u (plist-get m :user))) (list :user u)) diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 6455c3393d5..c54936c3f92 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -548,6 +548,44 @@ machine x.com port 42 password b '((:host "x.com" :secret "a") (:host "x.com" :port 42 :secret "b"))))))) +;; The query requires a user and doesn't specify a user to match against. +;; The only entry matching the host lacks a user, so the search fails. + +(ert-deftest auth-source-pass-extra-query-keywords--req-noparam-miss-netrc () + (ert-with-temp-file netrc-file + :text "machine foo password a\n" + (let ((auth-sources (list netrc-file)) + (auth-source-do-cache nil)) + (should-not (auth-source-search :host "foo" :require '(:user) :max 2))))) + +(ert-deftest auth-source-pass-extra-query-keywords--req-noparam-miss () + (let ((auth-source-pass-extra-query-keywords t)) + (auth-source-pass--with-store '(("foo" (secret . "a"))) + (auth-source-pass-enable) + (should-not (auth-source-search :host "foo" :require '(:user) :max 2))))) + +;; The query requires a user but does not provide a reference value to +;; match against. An entry matching the host that specifies a user is +;; selected because any user will do. +(ert-deftest auth-source-pass-extra-query-keywords--req-param-netrc () + (ert-with-temp-file netrc-file + :text "machine foo login bob password a\n" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "foo" :require '(:user)))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "foo" :user "bob" :secret "a"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--req-param () + (let ((auth-source-pass-extra-query-keywords t)) + (auth-source-pass--with-store '(("foo/bob" (secret . "a"))) + (auth-source-pass-enable) + (let ((results (auth-source-search :host "foo" :require '(:user)))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "foo" :user "bob" :secret "a")))))))) + ;; No entry has the requested port, but :port is required, so search fails. (ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc () @@ -629,14 +667,22 @@ machine Libera.Chat password b '((:host "Libera.Chat" :secret "b"))))))) -;; A retrieved store entry mustn't be nil regardless of whether its -;; path contains port or user components. +;; An effectively empty entry in the store returns nothing but the +;; :host field matching the given host parameter. + +(ert-deftest auth-source-pass-extra-query-keywords--netrc-baseline () + (ert-with-temp-file netrc-file + :text "machine foo\n" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "foo"))) + (should (equal results '((:host "foo"))))))) (ert-deftest auth-source-pass-extra-query-keywords--baseline () (let ((auth-source-pass-extra-query-keywords t)) - (auth-source-pass--with-store '(("x.com")) + (auth-source-pass--with-store '(("foo")) (auth-source-pass-enable) - (should-not (auth-source-search :host "x.com"))))) + (should (equal (auth-source-search :host "foo") '((:host "foo"))))))) ;; Output port type (int or string) matches that of input parameter.