From 80228d1f6eded7a042dfd29c3614b3214934b5c3 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 11 Aug 2024 21:55:32 -0700 Subject: [PATCH] Fix discrepancies in auth-source-pass vs netrc behavior The option `auth-source-pass-extra-query-keywords' aims to make its back end hew as close to the other built-in ones as possible, except WRT features not yet implemented, such as arbitrary "attribute" retrieval and new entry creation. This change only concerns behavior exhibited when the option is enabled. * lisp/auth-source-pass.el (auth-source-pass--match-parts): Account for the case in which a query lacks a reference parameter for a `:port' or `:user' but still requires one or both via the `:require' keyword. Previously, such a query would fail even when an entry met this requirement by simply specifying a field with any non-null value corresponding to the required parameter. (auth-source-pass--find-match-many): Account for the baseline case where a matching entry lacks a secret and the user doesn't require one. Although this function doesn't currently return so-called "attributes" from the contents of a matching decrypted file, were it to eventually, this case would no longer be academic. * test/lisp/auth-source-pass-tests.el (auth-source-pass-extra-query-keywords--req-noparam-miss-netrc) (auth-source-pass-extra-query-keywords--req-noparam-miss) (auth-source-pass-extra-query-keywords--req-param-netrc) (auth-source-pass-extra-query-keywords--req-param): New tests. (auth-source-pass-extra-query-keywords--netrc-baseline): New test asserting behavior of netrc backend when passed a lone `:host' as a query parameter. (auth-source-pass-extra-query-keywords--baseline): Reverse expected outcome to match that of the netrc reference implementation. (bug#72441) --- lisp/auth-source-pass.el | 19 +++++----- test/lisp/auth-source-pass-tests.el | 54 ++++++++++++++++++++++++++--- 2 files changed, 60 insertions(+), 13 deletions(-) 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.