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.

1 files changed, 265 insertions, 2 deletions

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 @@
 
 ;;; Code:
 
-(require 'ert)
+(require 'ert-x)
 
 (require 'auth-source-pass)
 
@@ -466,7 +466,10 @@ HOSTNAME, USER and PORT are passed unchanged to
 (ert-deftest auth-source-pass-can-start-from-auth-source-search ()
   (auth-source-pass--with-store '(("gitlab.com" ("user" . "someone")))
     (auth-source-pass-enable)
-    (let ((result (car (auth-source-search :host "gitlab.com"))))
+    ;; This also asserts an aspect of traditional search behavior
+    ;; relative to `auth-source-pass-extra-query-keywords'.
+    (let* ((auth-source-pass-extra-query-keywords nil)
+           (result (car (auth-source-search :host "gitlab.com"))))
       (should (equal (plist-get result :user) "someone"))
       (should (equal (plist-get result :host) "gitlab.com")))))
 
@@ -488,6 +491,266 @@ HOSTNAME, USER and PORT are passed unchanged to
     (should (auth-source-pass--have-message-matching
              "found 2 entries matching \"gitlab.com\": (\"a/gitlab.com\" \"b/gitlab.com\")"))))
 
+
+;;;; Option `auth-source-pass-extra-query-keywords' (bug#58985)
+
+;; No entry has the requested port, but a result is still returned.
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss-netrc ()
+  (ert-with-temp-file netrc-file
+    :text "\
+machine x.com password a
+machine x.com port 42 password b
+"
+    (let* ((auth-sources (list netrc-file))
+           (auth-source-do-cache nil)
+           (results (auth-source-search :host "x.com" :port 22 :max 2)))
+      (dolist (result results)
+        (setf (plist-get result :secret) (auth-info-password result)))
+      (should (equal results '((:host "x.com" :secret "a")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss ()
+  (auth-source-pass--with-store '(("x.com" (secret . "a"))
+                                  ("x.com:42" (secret . "b")))
+    (auth-source-pass-enable)
+    (let* ((auth-source-pass-extra-query-keywords t)
+           (results (auth-source-search :host "x.com" :port 22 :max 2)))
+      (dolist (result results)
+        (setf (plist-get result :secret) (auth-info-password result)))
+      (should (equal results '((:host "x.com" :secret "a")))))))
+
+;; One of two entries has the requested port, both returned.
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit-netrc ()
+  (ert-with-temp-file netrc-file
+    :text "\
+machine x.com password a
+machine x.com port 42 password b
+"
+    (let* ((auth-sources (list netrc-file))
+           (auth-source-do-cache nil)
+           (results (auth-source-search :host "x.com" :port 42 :max 2)))
+      (dolist (result results)
+        (setf (plist-get result :secret) (auth-info-password result)))
+      (should (equal results '((:host "x.com" :secret "a")
+                               (:host "x.com" :port "42" :secret "b")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit ()
+  (auth-source-pass--with-store '(("x.com" (secret . "a"))
+                                  ("x.com:42" (secret . "b")))
+    (auth-source-pass-enable)
+    (let* ((auth-source-pass-extra-query-keywords t)
+           (results (auth-source-search :host "x.com" :port 42 :max 2)))
+      (dolist (result results)
+        (setf (plist-get result :secret) (auth-info-password result)))
+      (should (equal results
+                     '((:host "x.com" :secret "a")
+                       (:host "x.com" :port 42 :secret "b")))))))
+
+;; 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 ()
+  (ert-with-temp-file netrc-file
+    :text "\
+machine x.com password a
+machine x.com port 42 password b
+"
+    (let* ((auth-sources (list netrc-file))
+           (auth-source-do-cache nil)
+           (results (auth-source-search
+                     :host "x.com" :port 22 :require '(:port) :max 2)))
+      (should-not results))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss ()
+  (let ((auth-source-pass-extra-query-keywords t))
+    (auth-source-pass--with-store '(("x.com" (secret . "a"))
+                                    ("x.com:42" (secret . "b")))
+      (auth-source-pass-enable)
+      (should-not (auth-source-search
+                   :host "x.com" :port 22 :require '(:port) :max 2)))))
+
+;; Specifying a :host without a :user finds a lone entry and does not
+;; include extra fields (i.e., :port nil) in the result.
+;; https://lists.gnu.org/archive/html/emacs-devel/2022-11/msg00130.html
+
+(ert-deftest auth-source-pass-extra-query-keywords--netrc-akib ()
+  (ert-with-temp-file netrc-file
+    :text "\
+machine x.com password a
+machine disroot.org user akib password b
+machine z.com password c
+"
+    (let* ((auth-sources (list netrc-file))
+           (auth-source-do-cache nil)
+           (results (auth-source-search :host "disroot.org" :max 2)))
+      (dolist (result results)
+        (setf (plist-get result :secret) (auth-info-password result)))
+      (should (equal results
+                     '((:host "disroot.org" :user "akib" :secret "b")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--akib ()
+  (auth-source-pass--with-store '(("x.com" (secret . "a"))
+                                  ("akib@disroot.org" (secret . "b"))
+                                  ("z.com" (secret . "c")))
+    (auth-source-pass-enable)
+    (let* ((auth-source-pass-extra-query-keywords t)
+           (results (auth-source-search :host "disroot.org" :max 2)))
+      (dolist (result results)
+        (setf (plist-get result :secret) (auth-info-password result)))
+      (should (equal results
+                     '((:host "disroot.org" :user "akib" :secret "b")))))))
+
+;; Searches for :host are case-sensitive, and a returned host isn't
+;; normalized.
+
+(ert-deftest auth-source-pass-extra-query-keywords--netrc-host ()
+  (ert-with-temp-file netrc-file
+    :text "\
+machine libera.chat password a
+machine Libera.Chat password b
+"
+    (let* ((auth-sources (list netrc-file))
+           (auth-source-do-cache nil)
+           (results (auth-source-search :host "Libera.Chat" :max 2)))
+      (dolist (result results)
+        (setf (plist-get result :secret) (auth-info-password result)))
+      (should (equal results '((:host "Libera.Chat" :secret "b")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--host ()
+  (auth-source-pass--with-store '(("libera.chat" (secret . "a"))
+                                  ("Libera.Chat" (secret . "b")))
+    (auth-source-pass-enable)
+    (let* ((auth-source-pass-extra-query-keywords t)
+           (results (auth-source-search :host "Libera.Chat" :max 2)))
+      (dolist (result results)
+        (setf (plist-get result :secret) (auth-info-password result)))
+      (should (equal results
+                     '((:host "Libera.Chat" :secret "b")))))))
+
+
+;; A retrieved store entry mustn't be nil regardless of whether its
+;; path contains port or user components.
+
+(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-enable)
+      (should-not (auth-source-search :host "x.com")))))
+
+;; Output port type (int or string) matches that of input parameter.
+
+(ert-deftest auth-source-pass-extra-query-keywords--port-type ()
+  (let ((auth-source-pass-extra-query-keywords t)
+        (f (lambda (r) (setf (plist-get r :secret) (auth-info-password r)) r)))
+    (auth-source-pass--with-store '(("x.com:42" (secret . "a")))
+      (auth-source-pass-enable)
+      (should (equal (mapcar f (auth-source-search :host "x.com" :port 42))
+                     '((:host "x.com" :port 42 :secret "a")))))
+    (auth-source-pass--with-store '(("x.com:42" (secret . "a")))
+      (auth-source-pass-enable)
+      (should (equal (mapcar f (auth-source-search :host "x.com" :port "42"))
+                     '((:host "x.com" :port "42" :secret "a")))))))
+
+;; Match precision sometimes takes a back seat to the traversal
+;; ordering.  Specifically, the :host (h1, ...) args hold greater sway
+;; over the output because they determine the first coordinate in the
+;; sequence of (host, user, port) combinations visited.  (Taking a
+;; tree-wise view, these become the depth-1 nodes in a DFS.)
+
+;; Note that all trailing /user forms are demoted for the sake of
+;; predictability (see tests further below for details).  This means
+;; that, in the following test, /bar is held in limbo, followed by
+;; /foo, but they both retain priority over "gnu.org", as noted above.
+
+(ert-deftest auth-source-pass-extra-query-keywords--hosts-first ()
+  (auth-source-pass--with-store '(("x.com:42/bar" (secret . "a"))
+                                  ("gnu.org" (secret . "b"))
+                                  ("x.com" (secret . "c"))
+                                  ("fake.com" (secret . "d"))
+                                  ("x.com/foo" (secret . "e")))
+    (auth-source-pass-enable)
+    (let* ((auth-source-pass-extra-query-keywords t)
+           (results (auth-source-search :host '("x.com" "gnu.org") :max 3)))
+      (dolist (result results)
+        (setf (plist-get result :secret) (auth-info-password result)))
+      (should (equal results
+                     ;; Notice gnu.org is never considered ^
+                     '((:host "x.com" :secret "c")
+                       (:host "x.com" :user "bar" :port "42" :secret "a")
+                       (:host "x.com" :user "foo" :secret "e")))))))
+
+;; This is another example given in the bug thread.
+
+(ert-deftest auth-source-pass-extra-query-keywords--ambiguous-user-host ()
+  (auth-source-pass--with-store '(("foo.com/bar.org" (secret . "a"))
+                                  ("foo.com" (secret . "b"))
+                                  ("bar.org" (secret . "c"))
+                                  ("fake.com" (secret . "d")))
+    (auth-source-pass-enable)
+    (let* ((auth-source-pass-extra-query-keywords t)
+           (results (auth-source-search :host "bar.org" :max 3)))
+      (dolist (result results)
+        (setf (plist-get result :secret) (auth-info-password result)))
+      (should (equal results '((:host "bar.org" :secret "c")))))))
+
+;; This conveys the same idea as `user-priorities', just below, but
+;; with slightly more realistic and less legible values.
+
+(ert-deftest auth-source-pass-extra-query-keywords--suffixed-user ()
+  (let ((store (sort (copy-sequence '(("x.com:42/bar" (secret . "a"))
+                                      ("bar@x.com" (secret . "b"))
+                                      ("x.com" (secret . "?"))
+                                      ("bar@y.org" (secret . "c"))
+                                      ("fake.com" (secret . "?"))
+                                      ("fake.com/bar" (secret . "d"))
+                                      ("y.org/bar" (secret . "?"))
+                                      ("bar@fake.com" (secret . "e"))))
+                     (lambda (&rest _) (zerop (random 2))))))
+    (auth-source-pass--with-store store
+      (auth-source-pass-enable)
+      (let* ((auth-source-pass-extra-query-keywords t)
+             (results (auth-source-search :host '("x.com" "fake.com" "y.org")
+                                          :user "bar"
+                                          :require '(:user) :max 5)))
+        (dolist (result results)
+          (setf (plist-get result :secret) (auth-info-password result)))
+        (should (equal results
+                       '((:host "x.com" :user "bar" :secret "b")
+                         (:host "x.com" :user "bar" :port "42" :secret "a")
+                         (:host "fake.com" :user "bar" :secret "e")
+                         (:host "fake.com" :user "bar" :secret "d")
+                         (:host "y.org" :user "bar" :secret "c"))))))))
+
+;; This is a more distilled version of `suffixed-user', above.  It
+;; better illustrates that search order takes precedence over "/user"
+;; demotion because otherwise * and ** would be swapped, below.  It
+;; follows that omitting the :port 2, gets you {u@h:1, u@h:2, h:1/u,
+;; h:2/u, u@g:1}.
+
+(ert-deftest auth-source-pass-extra-query-keywords--user-priorities ()
+  (let ((store (sort (copy-sequence '(("h:1/u" (secret . "/"))
+                                      ("h:2/u" (secret . "/"))
+                                      ("u@h:1" (secret . "@"))
+                                      ("u@h:2" (secret . "@"))
+                                      ("g:1/u" (secret . "/"))
+                                      ("g:2/u" (secret . "/"))
+                                      ("u@g:1" (secret . "@"))
+                                      ("u@g:2" (secret . "@"))))
+                     (lambda (&rest _) (zerop (random 2))))))
+    (auth-source-pass--with-store store
+      (auth-source-pass-enable)
+      (let* ((auth-source-pass-extra-query-keywords t)
+             (results (auth-source-search :host '("h" "g")
+                                          :port 2
+                                          :max 5)))
+        (dolist (result results)
+          (setf (plist-get result :secret) (auth-info-password result)))
+        (should (equal results
+                       '((:host "h" :user "u" :port 2 :secret "@")
+                         (:host "h" :user "u" :port 2 :secret "/") ; *
+                         (:host "g" :user "u" :port 2 :secret "@") ; **
+                         (:host "g" :user "u" :port 2 :secret "/"))))))))
+
 (provide 'auth-source-pass-tests)
 
 ;;; auth-source-pass-tests.el ends here