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, 111 insertions, 1 deletions

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.,