master 80228d1f6ed: Fix discrepancies in auth-source-pass vs netrc behavior

[F. Jason Park]

branch: master
commit 80228d1f6eded7a042dfd29c3614b3214934b5c3
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    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.