all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: "J.P." <jp@neverwas.me>
To: Akib Azmain Turja <akib@disroot.org>
Cc: "Damien Cassou" <damien@cassou.me>,
	"Björn Bidar" <bjorn.bidar@thaodan.de>,
	emacs-erc@gnu.org, "Michael Albinus" <michael.albinus@gmx.de>,
	58985@debbugs.gnu.org
Subject: bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends
Date: Thu, 10 Nov 2022 19:17:21 -0800	[thread overview]
Message-ID: <877d026uym.fsf__8299.23872822604$1668136705$gmane$org@neverwas.me> (raw)
In-Reply-To: <878rkjl1vd.fsf@disroot.org> (Akib Azmain Turja's message of "Thu, 10 Nov 2022 13:12:06 +0600")

[-- Attachment #1: Type: text/plain, Size: 1044 bytes --]

Akib Azmain Turja <akib@disroot.org> 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.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v4-v5.diff --]
[-- Type: text/x-patch, Size: 11241 bytes --]

From ff9878576a6826e13567049629451d494afd8c9c Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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"))
-                                    ("akib@disroot.org" (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"))
+                                  ("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
@@ -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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-POC-Make-auth-source-pass-behave-more-like-other-bac.patch --]
[-- Type: text/x-patch, Size: 19306 bytes --]

From 8870cb62be1ad3ac5b9e5553e52a7f6ed7533c2f Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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"))
+                                  ("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")))))))
+
+;; 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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-POC-Support-auth-source-pass-in-ERC.patch --]
[-- Type: text/x-patch, Size: 9182 bytes --]

From ff9878576a6826e13567049629451d494afd8c9c Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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


  parent reply	other threads:[~2022-11-11  3:17 UTC|newest]

Thread overview: 39+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
     [not found] <87wn8cb0ym.fsf@neverwas.me>
2022-11-05 23:55 ` bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends J.P.
2022-11-06 11:23   ` Michael Albinus
     [not found]   ` <87pme09vis.fsf@gmx.de>
2022-11-07  5:00     ` J.P.
2022-11-09 18:21     ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
     [not found]     ` <87a653z7dl.fsf@neverwas.me>
2022-11-07 10:33       ` Michael Albinus
     [not found]       ` <874jvbnje1.fsf@gmx.de>
2022-11-08 13:56         ` J.P.
2022-11-10  0:39           ` Björn Bidar via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-11-10  5:25             ` J.P.
     [not found]             ` <875yfnnzy6.fsf@neverwas.me>
2022-11-10 13:40               ` Björn Bidar via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-11-10 14:40                 ` J.P.
     [not found]                 ` <87pmduc1pz.fsf@neverwas.me>
2022-11-15  3:45                   ` J.P.
2022-11-09 18:25       ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
     [not found]       ` <874jv8ouh9.fsf@disroot.org>
2022-11-10  5:26         ` J.P.
2022-11-10  7:12       ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
     [not found]       ` <878rkjl1vd.fsf@disroot.org>
2022-11-10 14:38         ` J.P.
2022-11-11  3:17         ` J.P. [this message]
     [not found]         ` <877d026uym.fsf@neverwas.me>
2022-11-11 14:45           ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
     [not found]           ` <87tu35eehq.fsf@disroot.org>
2022-11-12  4:30             ` J.P.
     [not found]             ` <87bkpcu74w.fsf@neverwas.me>
2022-11-12 15:24               ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
     [not found]               ` <875yfkdwlm.fsf@disroot.org>
2022-11-13  7:26                 ` Akib Azmain Turja
2022-11-13 15:29                   ` J.P.
     [not found]                   ` <875yfiq3d8.fsf@neverwas.me>
2022-11-14  6:50                     ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
     [not found]                     ` <87mt8uvxkp.fsf@disroot.org>
2022-11-14 15:12                       ` J.P.
2022-11-14 17:49                         ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-11-15  3:32                           ` J.P.
     [not found]                           ` <87a64s99ka.fsf@neverwas.me>
2022-11-18 14:14                             ` J.P.
2022-11-18 23:25                               ` Kai Tetzlaff
2022-11-19  0:35                                 ` J.P.
2022-11-19  1:02                                   ` Kai Tetzlaff
2022-11-19  3:39                                     ` J.P.
2022-11-19  4:08                                       ` J.P.
2022-11-19 14:59                                     ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
     [not found]                             ` <87bkp4z6xg.fsf@neverwas.me>
2022-12-07 14:30                               ` J.P.
     [not found]     ` <878rkkoup4.fsf@disroot.org>
2022-11-10  5:23       ` J.P.
2022-11-10  7:12       ` Akib Azmain Turja
     [not found]       ` <87a64zo01q.fsf@neverwas.me>
2022-11-10  8:11         ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-11-06 14:39 ` Damien Cassou
2022-11-07  4:59   ` J.P.
2022-11-03 13:51 J.P.

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to='877d026uym.fsf__8299.23872822604$1668136705$gmane$org@neverwas.me' \
    --to=jp@neverwas.me \
    --cc=58985@debbugs.gnu.org \
    --cc=akib@disroot.org \
    --cc=bjorn.bidar@thaodan.de \
    --cc=damien@cassou.me \
    --cc=emacs-erc@gnu.org \
    --cc=michael.albinus@gmx.de \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.