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
 while searching for an entry matching the @code{rms} user on host
 @code{gnu.org} and port @code{22}, then the entry
 @file{gnu.org:22/rms.gpg} is preferred over @file{gnu.org.gpg}.
+However, such processing is not applied when the option
+@code{auth-source-pass-extra-parameters} is set to @code{t}.
 
 Users of @code{pass} may also be interested in functionality provided
 by other Emacs packages:
@@ -549,6 +551,22 @@ Set this variable to a string that should separate an host name from a
 port in an entry.  Defaults to @samp{:}.
 @end defvar
 
+@defvar auth-source-pass-extra-query-keywords
+This expands the selection of available keywords to include
+@code{:max} and @code{:require} and tells more of them to accept a
+list of query parameters as an argument.  When searching, it also
+favors the @samp{rms@@gnu.org.gpg} form for usernames over the
+@samp{gnu.org/rms.gpg} form, regardless of whether a @code{:user}
+param was provided.
+
+In general, if you prefer idiosyncrasies traditionally exhibited by
+this backend, such as prioritizing field count in a filename, try
+setting this option to @code{nil}.  But, if you experience problems
+predicting the outcome of searches relative to other auth-source
+backends or encounter code expecting to query multiple backends
+uniformly, try flipping it back to @code{t} (the default).
+@end defvar
+
 @node Help for developers
 @chapter Help for developers
 
diff --git a/etc/NEWS b/etc/NEWS
index e39833a7045..1e7190e830b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1395,6 +1395,14 @@ If non-nil and there's only one matching option, auto-select that.
 If non-nil, this user option describes what entries not to add to the
 database stored on disk.
 
+** Auth-Source
+
++++
+*** New user option 'auth-source-pass-extra-query-keywords'.
+Whether to recognize additional keyword params, like ':max' and
+':require', as well as accept lists of query terms paired with
+applicable keywords.
+
 ** Dired
 
 +++
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 @@
   :type 'string
   :version "27.1")
 
+(defcustom auth-source-pass-extra-query-keywords t
+  "Whether to consider additional keywords when performing a query.
+Specifically, when the value is t, recognize the `:max' and
+`:require' keywords and accept lists of query parameters for
+certain keywords, such as `:host' and `:user'.  Also, wrap all
+returned secrets in a function and forgo any further results
+filtering unless given an applicable `:require' argument.  When
+this option is nil, do none of that, and enact the narrowing
+behavior described toward the bottom of the Info node `(auth) The
+Unix password store'."
+  :type 'boolean
+  :version "29.1")
+
 (cl-defun auth-source-pass-search (&rest spec
                                          &key backend type host user port
+                                         require max
                                          &allow-other-keys)
   "Given some search query, return matching credentials.
 
 See `auth-source-search' for details on the parameters SPEC, BACKEND, TYPE,
-HOST, USER and PORT."
+HOST, USER, PORT, REQUIRE, and MAX."
   (cl-assert (or (null type) (eq type (oref backend type)))
              t "Invalid password-store search: %s %s")
   (cond ((eq host t)
@@ -70,6 +84,8 @@ HOST, USER and PORT."
         ((null host)
          ;; Do not build a result, as none will match when HOST is nil
          nil)
+        (auth-source-pass-extra-query-keywords
+         (auth-source-pass--build-result-many host port user require max))
         (t
          (when-let ((result (auth-source-pass--build-result host port user)))
            (list result)))))
@@ -89,6 +105,39 @@ HOSTS can be a string or a list of strings."
                                     (seq-subseq retval 0 -2)) ;; remove password
         retval))))
 
+(defvar auth-source-pass--match-regexp nil)
+
+(defun auth-source-pass--match-regexp (s)
+  (rx-to-string ; autoloaded
+   `(: (or bot "/")
+       (or (: (? (group-n 20 (+ (not (in ?\  ?/ ?@ ,s)))) "@")
+              (group-n 10 (+ (not (in ?\  ?/ ?@ ,s))))
+              (? ,s (group-n 30 (+ (not (in ?\  ?/ ,s))))))
+           (: (group-n 11 (+ (not (in ?\  ?/ ?@ ,s))))
+              (? ,s (group-n 31 (+ (not (in ?\  ?/ ,s)))))
+              (? "/" (group-n 21 (+ (not (in ?\  ?/ ,s)))))))
+       eot)
+   'no-group))
+
+(defun auth-source-pass--build-result-many (hosts ports users require max)
+  "Return multiple `auth-source-pass--build-result' values."
+  (unless (listp hosts) (setq hosts (list hosts)))
+  (unless (listp users) (setq users (list users)))
+  (unless (listp ports) (setq ports (list ports)))
+  (let* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp
+                                          auth-source-pass-port-separator))
+         (rv (auth-source-pass--find-match-many hosts users ports
+                                                require (or max 1))))
+    (when auth-source-debug
+      (auth-source-pass--do-debug "final result: %S" rv))
+    (let (out)
+      (dolist (e rv out)
+        (when-let* ((s (plist-get e :secret)) ; not captured by closure in 29.1
+                    (v (auth-source--obfuscate s)))
+          (setf (plist-get e :secret)
+                (lambda () (auth-source--deobfuscate v))))
+        (push e out)))))
+
 ;;;###autoload
 (defun auth-source-pass-enable ()
   "Enable auth-source-password-store."
@@ -206,6 +255,67 @@ HOSTS can be a string or a list of strings."
                 hosts
               (list hosts))))
 
+(defun auth-source-pass--retrieve-parsed (seen path port-number-p)
+  (when (string-match auth-source-pass--match-regexp path)
+    (puthash path
+             `( :host ,(or (match-string 10 path) (match-string 11 path))
+                ,@(if-let* ((tr (match-string 21 path)))
+                      (list :user tr :suffix t)
+                    (list :user (match-string 20 path)))
+                :port ,(and-let* ((p (or (match-string 30 path)
+                                         (match-string 31 path)))
+                                  (n (string-to-number p)))
+                         (if (or (zerop n) (not port-number-p))
+                             (format "%s" p)
+                           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--find-match-many (hosts users ports require max)
+  "Return plists for valid combinations of HOSTS, USERS, PORTS."
+  (let ((seen (make-hash-table :test #'equal))
+        (entries (auth-source-pass-entries))
+        out suffixed suffixedp)
+    (catch 'done
+      (dolist (host hosts out)
+        (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host)))
+          (unless (or (not (equal "443" p)) (string-prefix-p "https://" host))
+            (setq p nil))
+          (dolist (user (or users (list u)))
+            (dolist (port (or ports (list p)))
+              (dolist (e entries)
+                (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)))))
+                  (push
+                   `( :host ,host ; prefer user-provided :host over h
+                      ,@(and-let* ((u (plist-get m :user))) (list :user u))
+                      ,@(and-let* ((p (plist-get m :port))) (list :port p))
+                      ,@(and secret (not (eq secret t)) (list :secret secret)))
+                   (if (setq suffixedp (plist-get m :suffix)) suffixed out))
+                  (unless suffixedp
+                    (when (or (zerop (cl-decf max))
+                              (null (setq entries (delete e entries))))
+                      (throw 'done out)))))
+              (setq suffixed (nreverse suffixed))
+              (while suffixed
+                (push (pop suffixed) out)
+                (when (zerop (cl-decf max))
+                  (throw 'done out))))))))))
+
 (defun auth-source-pass--disambiguate (host &optional user port)
   "Return (HOST USER PORT) after disambiguation.
 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 @@
 
 ;;; 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