Re: bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends

"J.P." <[email protected]>
Newsgroups gmane.emacs.erc.general
Message-ID <[email protected]>
Akib Azmain Turja <[email protected]> writes:

>> +(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))
>> +    (if (eq auth-source-pass-extra-query-keywords 'test)
>> +        (reverse rv)
>
> The value `test' is not documented.  Is it used in tests?  If it is, I
> think an internal variable would be better.

I got rid of the `test' stuff completely, so this function now always
wraps secrets.
0000-v4-v5.diff (text/x-patch, 11 KB)
From ff9878576a6826e13567049629451d494afd8c9c Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email protected]>
Date: Thu, 10 Nov 2022 19:09:38 -0800
Subject: [PATCH 0/2] *** NOT A PATCH ***

*** BLURB HERE ***

F. Jason Park (2):
  [POC] Make auth-source-pass behave more like other backends
  [POC] Support auth-source-pass in ERC

 doc/misc/auth.texi                  |  11 ++
 doc/misc/erc.texi                   |   3 +-
 etc/NEWS                            |   8 ++
 lisp/auth-source-pass.el            | 105 +++++++++++++++-
 lisp/erc/erc-compat.el              |  99 +++++++++++++++
 lisp/erc/erc.el                     |   7 +-
 test/lisp/auth-source-pass-tests.el | 184 ++++++++++++++++++++++++++++
 test/lisp/erc/erc-services-tests.el |   3 -
 8 files changed, 414 insertions(+), 6 deletions(-)

Interdiff:
diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index 8d7241eb1a..54070e03eb 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -130,15 +130,13 @@ auth-source-pass--build-result-many
                                                 require (or max 1))))
     (when auth-source-debug
       (auth-source-pass--do-debug "final result: %S" rv))
-    (if (eq auth-source-pass-extra-query-keywords '--test--)
-        (reverse rv)
-      (let (out)
-        (dolist (e rv out)
-          (when-let* ((s (plist-get e :secret)) ; s not captured by closure
-                      (v (auth-source--obfuscate s)))
-            (setf (plist-get e :secret)
-                  (lambda () (auth-source--deobfuscate v))))
-          (push e out))))))
+    (let (out)
+      (dolist (e rv out)
+        (when-let* ((s (plist-get e :secret)) ; s not captured by closure
+                    (v (auth-source--obfuscate s)))
+          (setf (plist-get e :secret)
+                (lambda () (auth-source--deobfuscate v))))
+        (push e out)))))
 
 ;;;###autoload
 (defun auth-source-pass-enable ()
diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el
index 1839801546..60903808e0 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -504,16 +504,18 @@ auth-source-pass-extra-query-keywords--wild-port-miss-netrc
            (auth-source-do-cache nil)
            (results (auth-source-search :host "x.com" :port 22 :max 2)))
       (dolist (result results)
-        (setf result (plist-put result :secret (auth-info-password result))))
+        (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 ()
-  (let ((auth-source-pass-extra-query-keywords '--test--))
-    (auth-source-pass--with-store '(("x.com" (secret . "a"))
-                                    ("x.com:42" (secret . "b")))
-      (auth-source-pass-enable)
-      (should (equal (auth-source-search :host "x.com" :port 22 :max 2)
-                     '((:host "x.com" :secret "a")))))))
+  (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
 
@@ -527,16 +529,19 @@ auth-source-pass-extra-query-keywords--wild-port-hit-netrc
            (auth-source-do-cache nil)
            (results (auth-source-search :host "x.com" :port 42 :max 2)))
       (dolist (result results)
-        (setf result (plist-put result :secret (auth-info-password result))))
+        (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 ()
-  (let ((auth-source-pass-extra-query-keywords '--test--))
-    (auth-source-pass--with-store '(("x.com" (secret . "a"))
-                                    ("x.com:42" (secret . "b")))
-      (auth-source-pass-enable)
-      (should (equal (auth-source-search :host "x.com" :port 42 :max 2)
+  (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")))))))
 
@@ -555,7 +560,7 @@ auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc
       (should-not results))))
 
 (ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss ()
-  (let ((auth-source-pass-extra-query-keywords '--test--))
+  (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)
@@ -577,17 +582,20 @@ auth-source-pass-extra-query-keywords--netrc-akib
            (auth-source-do-cache nil)
            (results (auth-source-search :host "disroot.org" :max 2)))
       (dolist (result results)
-        (setf result (plist-put result :secret (auth-info-password result))))
+        (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 ()
-  (let ((auth-source-pass-extra-query-keywords '--test--))
-    (auth-source-pass--with-store '(("x.com" (secret . "a"))
-                                    ("[email protected]" (secret . "b"))
-                                    ("z.com" (secret . "c")))
-      (auth-source-pass-enable)
-      (should (equal (auth-source-search :host "disroot.org" :max 2)
+  (auth-source-pass--with-store '(("x.com" (secret . "a"))
+                                  ("[email protected]" (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
@@ -603,15 +611,18 @@ auth-source-pass-extra-query-keywords--netrc-host
            (auth-source-do-cache nil)
            (results (auth-source-search :host "Libera.Chat" :max 2)))
       (dolist (result results)
-        (setf result (plist-put result :secret (auth-info-password result))))
+        (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 ()
-  (let ((auth-source-pass-extra-query-keywords '--test--))
-    (auth-source-pass--with-store '(("libera.chat" (secret . "a"))
-                                    ("Libera.Chat" (secret . "b")))
-      (auth-source-pass-enable)
-      (should (equal (auth-source-search :host "Libera.Chat" :max 2)
+  (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")))))))
 
 
@@ -619,7 +630,7 @@ auth-source-pass-extra-query-keywords--host
 ;; path contains port or user components
 
 (ert-deftest auth-source-pass-extra-query-keywords--baseline ()
-  (let ((auth-source-pass-extra-query-keywords '--test--))
+  (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")))))
@@ -627,14 +638,15 @@ auth-source-pass-extra-query-keywords--baseline
 ;; 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 '--test--))
+  (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 (auth-source-search :host "x.com" :port 42)
+      (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 (auth-source-search :host "x.com" :port "42")
+      (should (equal (mapcar f (auth-source-search :host "x.com" :port "42"))
                      '((:host "x.com" :port "42" :secret "a")))))))
 
 ;; The :host search param ordering more heavily influences the output
@@ -643,14 +655,17 @@ auth-source-pass-extra-query-keywords--port-type
 ;; returned in the order encountered
 
 (ert-deftest auth-source-pass-extra-query-keywords--hosts-first ()
-  (let ((auth-source-pass-extra-query-keywords '--test--))
-    (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)
-      (should (equal (auth-source-search :host '("x.com" "gnu.org") :max 3)
+  (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" :user "bar" :port "42" :secret "a")
                        (:host "x.com" :secret "c")
-- 
2.38.1
0001-POC-Make-auth-source-pass-behave-more-like-other-bac.patch (text/x-patch, 18.9 KB)
From 8870cb62be1ad3ac5b9e5553e52a7f6ed7533c2f Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email protected]>
Date: Tue, 1 Nov 2022 22:46:24 -0700
Subject: [PATCH 1/2] [POC] 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
(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): 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.
---
 doc/misc/auth.texi                  |  11 ++
 etc/NEWS                            |   8 ++
 lisp/auth-source-pass.el            | 105 +++++++++++++++-
 test/lisp/auth-source-pass-tests.el | 184 ++++++++++++++++++++++++++++
 4 files changed, 307 insertions(+), 1 deletion(-)

diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi
index 9dc63af6bc..222fce2058 100644
--- a/doc/misc/auth.texi
+++ b/doc/misc/auth.texi
@@ -526,6 +526,8 @@ The Unix password store
 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 filtering 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,15 @@ The Unix password store
 port in an entry.  Defaults to @samp{:}.
 @end defvar
 
+@defvar auth-source-pass-extra-query-keywords
+Set this to @code{t} if you encounter problems predicting the outcome
+of searches relative to other auth-source backends or if you have code
+that expects to query multiple backends uniformly.  This tells
+auth-source-pass to consider the @code{:max} and @code{:require}
+keywords as well as lists containing multiple query params (for
+applicable keywords).
+@end defvar
+
 @node Help for developers
 @chapter Help for developers
 
diff --git a/etc/NEWS b/etc/NEWS
index ab64eff74e..2c61732f8d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1385,6 +1385,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 0955e2ed07..54070e03eb 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -55,13 +55,27 @@ auth-source-pass-port-separator
   :type 'string
   :version "27.1")
 
+(defcustom auth-source-pass-extra-query-keywords nil
+  "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 @@ auth-source-pass-search
         ((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 @@ auth-source-pass--build-result
                                     (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)) ; s not captured by closure
+                    (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,60 @@ auth-source-pass--find-match
                 hosts
               (list hosts))))
 
+(defun auth-source-pass--retrieve-parsed (seen path port-number-p)
+  (when-let ((m (string-match auth-source-pass--match-regexp path)))
+    (puthash path
+             (list :host (or (match-string 10 path) (match-string 11 path))
+                   :user (or (match-string 20 path) (match-string 21 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.
+Each plist contains, at the very least, a host and a secret."
+  (let ((seen (make-hash-table :test #'equal))
+        (entries (auth-source-pass-entries))
+        out)
+    (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)))
+                   out)
+                  (when (or (zerop (cl-decf max))
+                            (null (setq entries (remove e entries))))
+                    (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 f5147a7ce0..60903808e0 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -488,6 +488,190 @@ auth-source-pass-prints-meaningful-debug-log
     (should (auth-source-pass--have-message-matching
              "found 2 entries matching \"gitlab.com\": (\"a/gitlab.com\" \"b/gitlab.com\")"))))
 
+
+;; FIXME move this to top of file if keeping these netrc tests
+(require 'ert-x)
+
+;; 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"))
+                                  ("[email protected]" (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")))))))
+
+;; The :host search param ordering more heavily influences the output
+;; because (h1, u1, p1), (h1, u1, p2), ... (hN, uN, pN); also, exact
+;; matches are not given precedence, i.e., matching store items are
+;; returned in the order encountered
+
+(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" :user "bar" :port "42" :secret "a")
+                       (:host "x.com" :secret "c")
+                       (:host "x.com" :user "foo" :secret "e")))))))
+
+
 (provide 'auth-source-pass-tests)
 
 ;;; auth-source-pass-tests.el ends here
-- 
2.38.1
0002-POC-Support-auth-source-pass-in-ERC.patch (text/x-patch, 9 KB)
From ff9878576a6826e13567049629451d494afd8c9c Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email protected]>
Date: Sun, 24 Apr 2022 06:20:09 -0700
Subject: [PATCH 2/2] [POC] Support auth-source-pass in ERC

* doc/misc/erc.texi: Mention that the auth-source-pass backend is
supported.
* lisp/erc/erc-compat.el (erc-compat--auth-source-pass-search,
erc-compat--auth-source-pass--build-results-many,
erc-compat--auth-source-pass--retrieve-parsed,
erc-compat--auth-source-pass-packend-parse): Copy some yet unreleased
functions from auth-source-pass that mimic the netrc backend.  Also
add forward declarations to support them.
* lisp/erc/erc.el (erc--auth-source-search): Use own auth-source-pass
erc-compat backend until 29.1 released.
* test/lisp/erc/erc-services-tests.el
(erc-join-tests--auth-source-pass-entries): Remove useless items.
(erc--auth-source-search--pass-standard,
erc--auth-source-search--pass-announced,
erc--auth-source-search--pass-overrides): Remove `ert-skip' guard.
Bug#58985.
---
 doc/misc/erc.texi                   |  3 +-
 lisp/erc/erc-compat.el              | 99 +++++++++++++++++++++++++++++
 lisp/erc/erc.el                     |  7 +-
 test/lisp/erc/erc-services-tests.el |  3 -
 4 files changed, 107 insertions(+), 5 deletions(-)

diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index 3db83197f9..ad35b78f0e 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -861,7 +861,8 @@ Connecting
 @code{erc-auth-source-search}.  It tries to merge relevant contextual
 parameters with those provided or discovered from the logical connection
 or the underlying transport.  Some auth-source back ends may not be
-compatible; netrc, plstore, json, and secrets are currently supported.
+compatible; netrc, plstore, json, secrets, and pass are currently
+supported.
 @end defopt
 
 @subheading Full name
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 03bd8f1352..739f502764 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -32,6 +32,8 @@
 ;;; Code:
 
 (require 'compat nil 'noerror)
+(eval-when-compile (require 'cl-lib))
+
 
 ;;;###autoload(autoload 'erc-define-minor-mode "erc-compat")
 (define-obsolete-function-alias 'erc-define-minor-mode
@@ -168,6 +170,103 @@ erc-compat--with-memoization
     `(cl--generic-with-memoization ,table ,@forms))
    (t `(progn ,@forms))))
 
+;;;; Auth Source
+
+(declare-function auth-source-pass--get-attr
+                  "auth-source-pass" (key entry-data))
+(declare-function auth-source-pass--disambiguate
+                  "auth-source-pass" (host &optional user port))
+(declare-function auth-source-backend-parse-parameters
+                  "auth-source-pass" (entry backend))
+(declare-function auth-source-backend "auth-source" (&rest slots))
+(declare-function auth-source-pass-entries "auth-source-pass" nil)
+(declare-function auth-source-pass-parse-entry "auth-source-pass" (entry))
+
+;; This basically hard codes `auth-source-pass-port-separator' to ":"
+(defun erc-compat--auth-source-pass--retrieve-parsed (seen e port-number-p)
+  (when-let ((pat (rx (or bot "/")
+                      (or (: (? (group-n 20 (+ (not (in " /@")))) "@")
+                             (group-n 10 (+ (not (in " /:@"))))
+                             (? ":" (group-n 30 (+ (not (in " /:"))))))
+                          (: (group-n 11 (+ (not (in " /:@"))))
+                             (? ":" (group-n 31 (+ (not (in " /:")))))
+                             (? "/" (group-n 21 (+ (not (in " /:")))))))
+                      eot))
+             (m (string-match pat e)))
+    (puthash e (list :host (or (match-string 10 e)
+                               (match-string 11 e))
+                     :user (or (match-string 20 e)
+                               (match-string 21 e))
+                     :port (and-let* ((p (or (match-string 30 e)
+                                             (match-string 31 e)))
+                                      (n (string-to-number p)))
+                             (if (or (zerop n)
+                                     (not port-number-p))
+                                 (format "%s" p)
+                               n)))
+             seen)))
+
+;; This looks bad, but it just inlines `auth-source-pass--find-match-many'.
+(defun erc-compat--auth-source-pass--build-result-many
+    (hosts users ports require max)
+  "Return a plist of HOSTS, PORTS, USERS, and secret."
+  (unless (listp hosts) (setq hosts (list hosts)))
+  (unless (listp users) (setq users (list users)))
+  (unless (listp ports) (setq ports (list ports)))
+  (unless max (setq max 1))
+  (let ((seen (make-hash-table :test #'equal))
+        (entries (auth-source-pass-entries))
+        (check (lambda (m k v)
+                 (let ((mv (plist-get m k)))
+                   (if (memq k require)
+                       (and v (equal mv v))
+                     (or (not v) (not mv) (equal mv v))))))
+        out)
+    (catch 'done
+      (dolist (host hosts)
+        (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)
+                            (erc-compat--auth-source-pass--retrieve-parsed
+                             seen e (integerp port))))
+                     ((equal host (plist-get m :host)))
+                     ((funcall check m :port port))
+                     ((funcall check m :user user))
+                     (parsed (auth-source-pass-parse-entry e))
+                     (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)))
+                   out)
+                  (when (or (zerop (cl-decf max))
+                            (null (setq entries (remove e entries))))
+                    (throw 'done nil)))))))))
+    (reverse out)))
+
+(cl-defun erc-compat--auth-source-pass-search
+    (&rest spec &key host user port require max &allow-other-keys)
+  ;; From `auth-source-pass-search'
+  (cl-assert (and host (not (eq host t)))
+             t "Invalid password-store search: %s %s")
+  (erc-compat--auth-source-pass--build-result-many host user port require max))
+
+(defun erc-compat--auth-source-pass-backend-parse (entry)
+  (when (eq entry 'password-store)
+    (auth-source-backend-parse-parameters
+     entry (auth-source-backend
+            :source "."
+            :type 'password-store
+            :search-function #'erc-compat--auth-source-pass-search))))
+
+
 (provide 'erc-compat)
 
 ;;; erc-compat.el ends here
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 6b14cf87e2..3769e73041 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3225,7 +3225,12 @@ erc--auth-source-search
 the nod.  Much the same would happen for entries sharing only a port:
 the one with host foo would win."
   (when-let*
-      ((priority (map-keys defaults))
+      ((auth-source-backend-parser-functions
+        (if (memq 'password-store auth-sources)
+            (cons #'erc-compat--auth-source-pass-backend-parse
+                  auth-source-backend-parser-functions)
+          auth-source-backend-parser-functions))
+       (priority (map-keys defaults))
        (test (lambda (a b)
                (catch 'done
                  (dolist (key priority)
diff --git a/test/lisp/erc/erc-services-tests.el b/test/lisp/erc/erc-services-tests.el
index c22d4cf75e..7ff2e36e77 100644
--- a/test/lisp/erc/erc-services-tests.el
+++ b/test/lisp/erc/erc-services-tests.el
@@ -474,7 +474,6 @@ erc-join-tests--auth-source-pass-entries
     ("GNU.chat:irc/#chan" (secret . "foo"))))
 
 (ert-deftest erc--auth-source-search--pass-standard ()
-  (ert-skip "Pass backend not yet supported")
   (let ((store erc-join-tests--auth-source-pass-entries)
         (auth-sources '(password-store))
         (auth-source-do-cache nil))
@@ -487,7 +486,6 @@ erc--auth-source-search--pass-standard
       (erc-services-tests--auth-source-standard #'erc-auth-source-search))))
 
 (ert-deftest erc--auth-source-search--pass-announced ()
-  (ert-skip "Pass backend not yet supported")
   (let ((store erc-join-tests--auth-source-pass-entries)
         (auth-sources '(password-store))
         (auth-source-do-cache nil))
@@ -500,7 +498,6 @@ erc--auth-source-search--pass-announced
       (erc-services-tests--auth-source-announced #'erc-auth-source-search))))
 
 (ert-deftest erc--auth-source-search--pass-overrides ()
-  (ert-skip "Pass backend not yet supported")
   (let ((store
          `(,@erc-join-tests--auth-source-pass-entries
            ("GNU.chat:6697/#chan" (secret . "spam"))
-- 
2.38.1
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.