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: 1678 bytes --]

Kai Tetzlaff <emacs+bug@tetzco.de> writes:

> I've done some further checks and now it seems that setting
> `auth-source-pass-extra-query-keywords' to `nil' in a new emacs session
> does indeed fix the issue (maybe `auth-source' caching of the negative
> lookup caused my initial breakage to persist even after changing
> `auth-source-pass-extra-query-keywords').

Ah, right, the cache (gets me every time). BTW, it's probably still
worth mentioning the incompatibility in NEWS and the docs.

> The lookup which fails with the new code is for the following
> parameters:
>
> auth-source-search: found 0 results (max 1) matching
> (:max 1
>  :host ("news6.open-news-network.org" "onn6")
>  :port ("119" "nntp" "nntp" "563" "nntps" "snews"))
>
> My password store contains an entry for 'nntp/open-news-network.org'. I
> don't use the full hostname since the open news network has multiple
> servers (news1/2/3/4...) with the same domain name.
>
> Right now I don't have time for a more detailed analysis. But I will
> (hopefully) get back to it during the weekend.

Wow, thanks, this is really helpful. Based on that, I'm pretty sure
what's going on. Basically, the new behavior is geared toward blindly
replicating that of the other back ends, warts and all. But that means
some handy pass-specific features, like subdomain matching, are notably
absent. I've attached a demo patch that better illustrates this.

My main question for you is: do you think we ought to change the default
for `auth-source-pass-extra-query-keywords' to nil? What about
additionally demoting it from an option to a public variable intended
solely for use by dependent libraries instead of end users?


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

From 22f0e5001fe42d095285c27ec903bd074fdb0d57 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] [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, auth-source-pass--match-host-function):
Add alternate subdomain matching function and internal variable to
demo backwards compatibility.  The latter could be made non-internal
and offered as an opt-in for third-party libraries.
(auth-source-pass--find-match-many): Call
`auth-source-pass--match-host-function' 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            | 17 ++++++--
 test/lisp/auth-source-pass-tests.el | 68 +++++++++++++++++++++++++++++
 4 files changed, 90 insertions(+), 9 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..d0b7acb931 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -59,8 +59,9 @@ 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
@@ -276,6 +277,15 @@ 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)
+  (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.")
+
 (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,8 @@ 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)))
+                     ((funcall auth-source-pass--match-host-function
+                               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..dd694c72f6 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -751,6 +751,74 @@ 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--subdomain-compat-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 t)
+           (auth-source-pass--match-host-function #'auth-source-pass--match-host)
+           (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