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

["J.P." <jp@neverwas.me>]

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

This is probably a(nother) bad idea, but what about making
`auth-source-pass-extra-query-keywords' a "tristate" option with a
third, hybrid value, like `match-domains', that acts like `t' except
with subdomain matching turned on?


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

From 89ec2fd5ba7d3d276cb18d1d256080aff9f2ab77 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 18 Nov 2022 19:59:11 -0800
Subject: [PATCH 0/1] *** NOT A PATCH ***

*** BLURB HERE ***

F. Jason Park (1):
  [POC] Allow subdomain matching in auth-source-pass--find-match-many

 doc/misc/auth.texi                  | 11 ++---
 etc/NEWS                            |  3 +-
 lisp/auth-source-pass.el            | 20 ++++++---
 test/lisp/auth-source-pass-tests.el | 67 +++++++++++++++++++++++++++++
 4 files changed, 90 insertions(+), 11 deletions(-)

Interdiff:
diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index d0b7acb931..2501a1ca85 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -65,8 +65,10 @@ auth-source-pass-extra-query-keywords
 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
+Unix password store'.  With a value of `match-domains', this
+option behaves as it does when set to t except that subdomain
+matching is enabled."
+  :type '(choice (const nil) (const t) (const match-domains))
   :version "29.1")
 
 (cl-defun auth-source-pass-search (&rest spec
@@ -278,13 +280,11 @@ auth-source-pass--match-parts
       (or (not value) (not mv) (equal mv value)))))
 
 (defun auth-source-pass--match-host (search-param matched-path)
-  (pcase search-param
-    ((rx  "." (+ (not "."))  "." (>= 2 alpha) eot)
-     (string-suffix-p matched-path search-param))
-    (_ (equal matched-path search-param))))
-
-(defvar auth-source-pass--match-host-function #'equal
-  "An escape hatch for alternate host-matching behavior.")
+  (if (and (eq auth-source-pass-extra-query-keywords 'match-domains)
+           (string-match (rx  "." (+ (not "."))  "." (>= 2 alpha) eot)
+                         search-param))
+      (string-suffix-p matched-path search-param)
+    (equal matched-path search-param)))
 
 (defun auth-source-pass--find-match-many (hosts users ports require max)
   "Return plists for valid combinations of HOSTS, USERS, PORTS."
@@ -302,8 +302,7 @@ auth-source-pass--find-match-many
                 (when-let*
                     ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed
                                               seen e (integerp port))))
-                     ((funcall auth-source-pass--match-host-function
-                               host (plist-get m :host)))
+                     ((auth-source-pass--match-host 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))
diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el
index dd694c72f6..cca203d790 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -785,12 +785,11 @@ auth-source-pass-extra-query-keywords--subdomain-miss
 
 ;; But we could offer optional legacy matching behavior
 
-(ert-deftest auth-source-pass-extra-query-keywords--subdomain-compat-hit ()
+(ert-deftest auth-source-pass-extra-query-keywords--match-domains ()
   (auth-source-pass--with-store '(("open-news-network.org" (secret . "a"))
                                   ("onn6:nope" (secret . "b")))
     (auth-source-pass-enable)
-    (let* ((auth-source-pass-extra-query-keywords t)
-           (auth-source-pass--match-host-function #'auth-source-pass--match-host)
+    (let* ((auth-source-pass-extra-query-keywords 'match-domains)
            (results (auth-source-search
                      :max 1
                      :host '("news6.open-news-network.org" "onn6")
-- 
2.38.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-POC-Allow-subdomain-matching-in-auth-source-pass-fin.patch --]
[-- Type: text/x-patch, Size: 8725 bytes --]

From 89ec2fd5ba7d3d276cb18d1d256080aff9f2ab77 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 18 Nov 2022 19:14:30 -0800
Subject: [PATCH 1/1] [POC] Allow subdomain matching in
 auth-source-pass--find-match-many

* doc/misc/auth.texi: Mention incompatible domain-matching behavior in
`auth-source-pass-extra-query-keywords' section.

* etc/NEWS: Mention incompatible behavior in
`auth-source-pass-extra-query-keywords' section.

* lisp/auth-source-pass.el (auth-source-pass-extra-query-keywords):
Mention lack of subdomain matching in doc string.
(auth-source-pass--match-host): Add function to optionally regain
traditional subdomain matching behavior.
(auth-source-pass--find-match-many): Call
`auth-source-pass--match-host' to handle host matching.

* test/lisp/auth-source-pass-tests.el: FIXME Add ephemeral tests.
---
 doc/misc/auth.texi                  | 11 ++---
 etc/NEWS                            |  3 +-
 lisp/auth-source-pass.el            | 20 ++++++---
 test/lisp/auth-source-pass-tests.el | 67 +++++++++++++++++++++++++++++
 4 files changed, 90 insertions(+), 11 deletions(-)

diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi
index 872e5f88f5..cd8efd8607 100644
--- a/doc/misc/auth.texi
+++ b/doc/misc/auth.texi
@@ -560,11 +560,12 @@ The Unix password store
 param was provided.
 
 In general, if you prefer idiosyncrasies traditionally exhibited by
-this backend, such as prioritizing field count in a filename, try
-setting this option to @code{nil}.  But, if you experience problems
-predicting the outcome of searches relative to other auth-source
-backends or encounter code expecting to query multiple backends
-uniformly, try flipping it back to @code{t} (the default).
+this backend, such as prioritizing field count in a filename or
+matching against subdomain labels, try setting this option to
+@code{nil}.  But, if you experience problems predicting the outcome of
+searches relative to other auth-source backends or encounter code
+expecting to query multiple backends uniformly, try flipping it back
+to @code{t} (the default).
 @end defvar
 
 @node Help for developers
diff --git a/etc/NEWS b/etc/NEWS
index 8a34afe8d2..73c848c033 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1407,7 +1407,8 @@ database stored on disk.
 *** 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.
+applicable keywords.  This disables most known search behavior unique
+to auth-source-pass, such as wildcard subdomain matching.
 
 ** Dired
 
diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index dc274843e1..2501a1ca85 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -59,13 +59,16 @@ auth-source-pass-extra-query-keywords
   "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
+certain keywords, such as `:host' and `:user'.  Beyond that, wrap
+all returned secrets in a function and don't bother considering
+subdomains when matching hosts.  Also, 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
+Unix password store'.  With a value of `match-domains', this
+option behaves as it does when set to t except that subdomain
+matching is enabled."
+  :type '(choice (const nil) (const t) (const match-domains))
   :version "29.1")
 
 (cl-defun auth-source-pass-search (&rest spec
@@ -276,6 +279,13 @@ auth-source-pass--match-parts
         (and value (equal mv value))
       (or (not value) (not mv) (equal mv value)))))
 
+(defun auth-source-pass--match-host (search-param matched-path)
+  (if (and (eq auth-source-pass-extra-query-keywords 'match-domains)
+           (string-match (rx  "." (+ (not "."))  "." (>= 2 alpha) eot)
+                         search-param))
+      (string-suffix-p matched-path search-param)
+    (equal matched-path search-param)))
+
 (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))
@@ -292,7 +302,7 @@ auth-source-pass--find-match-many
                 (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-host 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))
diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el
index 8bcb2739bb..cca203d790 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -751,6 +751,73 @@ auth-source-pass-extra-query-keywords--user-priorities
                          (:host "g" :user "u" :port 2 :secret "@") ; **
                          (:host "g" :user "u" :port 2 :secret "/"))))))))
 
+;; Kai demo (delete)
+
+;; The netrc backend is does not consider subdomains
+
+(ert-deftest auth-source-pass-extra-query-keywords--subdomain-miss-netrc ()
+  (ert-with-temp-file netrc-file
+    :text "\
+machine open-news-network.org password a
+machine onn6 port nope password b
+"
+    (let* ((auth-sources (list netrc-file))
+           (auth-source-do-cache nil)
+           (results (auth-source-search
+                     :max 1
+                     :host '("news6.open-news-network.org" "onn6")
+                     :port '("119" "nntp" "nntp" "563" "nntps" "snews"))))
+      (dolist (result results)
+        (setf (plist-get result :secret) (auth-info-password result)))
+      (should-not results))))
+
+;; And neither do we, when `auth-source-pass-extra-query-keywords' is t
+
+(ert-deftest auth-source-pass-extra-query-keywords--subdomain-miss ()
+  (auth-source-pass--with-store '(("open-news-network.org" (secret . "a"))
+                                  ("onn6:nope" (secret . "b")))
+    (auth-source-pass-enable)
+    (let ((auth-source-pass-extra-query-keywords t))
+      (should-not (auth-source-search
+                   :max 1
+                   :host '("news6.open-news-network.org" "onn6")
+                   :port '("119" "nntp" "nntp" "563" "nntps" "snews"))))))
+
+;; But we could offer optional legacy matching behavior
+
+(ert-deftest auth-source-pass-extra-query-keywords--match-domains ()
+  (auth-source-pass--with-store '(("open-news-network.org" (secret . "a"))
+                                  ("onn6:nope" (secret . "b")))
+    (auth-source-pass-enable)
+    (let* ((auth-source-pass-extra-query-keywords 'match-domains)
+           (results (auth-source-search
+                     :max 1
+                     :host '("news6.open-news-network.org" "onn6")
+                     :port '("119" "nntp" "nntp" "563" "nntps" "snews"))))
+      (dolist (result results)
+        (setf (plist-get result :secret) (auth-info-password result)))
+      (should (equal results
+                     '((:host "news6.open-news-network.org" :secret "a")))))))
+
+;; Traditional behavior when `auth-source-pass-extra-query-keywords' is nil
+
+(ert-deftest auth-source-pass-extra-query-keywords--nil--subdomain-hit ()
+  (auth-source-pass--with-store '(("open-news-network.org" (secret . "a"))
+                                  ("onn6:nope" (secret . "b")))
+    (auth-source-pass-enable)
+    (let* ((auth-source-pass-extra-query-keywords nil)
+           (results (auth-source-search
+                     :max 1
+                     :host '("news6.open-news-network.org" "onn6")
+                     :port '("119" "nntp" "nntp" "563" "nntps" "snews"))))
+      (dolist (result results)
+        (setf (plist-get result :secret) (auth-info-password result)))
+      (should (equal results
+                     '(( :host "news6.open-news-network.org"
+                         :port ("119" "nntp" "nntp" "563" "nntps" "snews")
+                         :user nil
+                         :secret "a")))))))
+
 (provide 'auth-source-pass-tests)
 
 ;;; auth-source-pass-tests.el ends here
-- 
2.38.1