bug#72441: 31.0.50; Auth-source-pass doesn't match password attributes or hosts without user when extra-query-keywords is true

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

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

Björn Bidar <bjorn.bidar@thaodan.de> writes:

> "J.P." <jp@neverwas.me> writes:
>
>> However, I do realize that the auth-source-pass back end without the
>> extra-keywords option already dips into a file's contents looking for an
>> attributes list like the one shown on the web page. (Whether that's wise
>> is pretty much moot after all these years.) Anyway, for that reason, I
>> suppose we _should_ attempt to at least explore doing the same when the
>> extra-keywords option is enabled. For me, the most important thing
>> remains mimicking the behavior of the other built-in back ends, which at
>> times is admittedly unintuitive but nevertheless consistent and thus
>> predictable from a mechanical POV.
>
> I agree fully with the comment. Other's that use pass as source for
> passwords also use file contents to match or retrieve variables from.
> E.g. most browser plugins derive the parameter for the login or user
> name from either of these names.

Hm, actually, I was not initially thinking of including all the
attributes, only :user and :port. But it seems I'd forgotten that the
netrc reference implementation does indeed include arbitrary key/value
pairs in the results from a successful match:

  # ~/.authinfo
  machine example.org login me password 123 foo bar

  M-: (auth-source-search :host "example.org")
  => (... :foo "bar")

I've updated my previous patch to do this.

>> If we do end up going with something like the attached patch, we'll need
>> to profile it. I can create a bunch of fake trees of varying shapes and
>> sizes, but I'd rather someone with real data and a sizable store assess
>> how much slower it is to visit (and thus decrypt) potentially every file
>> in the tree, which is what any attr-reading implementation must do. On
>> my machine, it takes roughly 0.18 seconds to decrypt a single two-line
>> file via `auth-source-pass--read-entry'. (This seems prohibitively
>> expensive to do en masse, no?) FWIW, most of this time is spent in
>> `epg-wait-for-status', which blocks until the subprocess exits.
>
> That is why I was arguing that we should attempt to not try decrypt the
> password file unless a previous attribute such as :host or :user matched
> before.
> If we could do the search in parallel or at least without blocking Emacs
> that would be a different story of course.

With what I'm proposing, we would actually decrypt to inspect the parsed
attrs if :port or :user isn't found in the filename and a port or user
query parameter is given (or :port or :user appears in a :require
parameter). This behavior is currently gated by a new variable called
`auth-source-pass-check-attrs-with-extra-query-keywords', but it's t by
default. Perhaps it's better to have it be nil? If we do that, then, by
default, :port and :user attributes won't be considered, but they will
still be included in successful matches along with all other attributes.

>>> Same it should maybe also match against :host
>>> if no user was provided, I don't know how other sources do this thou.
>>
>> While the reference implementation indeed succeeds with a plain :host
>> input (see test `auth-source-pass-extra-query-keywords--netrc-host'), I
>> believe the actual problem you perceive has more to do with the content
>> of the file paths, specifically, leading directory components. Still,
>> I'm inclined to agree that this would be nice to have. However, I do
>> seem to recall this being discussed on at least one occasion, with the
>> conclusion being that it's too complicated, if not impossible, to
>> disambiguate between a trailing "hostname/user" and "folder/hostname".
>>
>> Nevertheless, we could add an option to do it anyway based on one or
>> more heuristics-based strategy (resolving hosts for real is surely a no
>> go). For example, one such strategy could ignore a penultimate file-path
>> component that's not an FQDN, even if it's, say, LDH-only and resolvable
>> as a hostname, so long as the leaf component _is_ an FQDN. However, such
>> an option would have to be disabled by default to prevent existing
>> entries like "localhost/test.user" from being parsed as (:host
>> "test.user").
>>
>
> What do you mean by resolving hosts for real?

I just meant it'd be unrealistic to query the system resolver via
`network-lookup-address-info' or similar whenever we need to
disambiguate.

> I think another option would be for the user to specific the hierarchy
> of their password store to auth-source-pass e.g. word/%host%/%user or
> word/(or %host word)/%user where word is any word that isn't used for
> matching but just for the user to organize the hierarchy.

That could work, although it seems rather complex with pattern
substitutions and expressions (?). Perhaps it could be precomputed
somehow into a regexp before every query.

Another idea would be to just have the option be an integer indicating
the number of leading path components to mask off before matching. Given
a tree like

  ~/.password-store/
  - foo/
    - example.com
  - irc.bar.org/
    - example.net/
      - me
  - baz/
    - myvps/
      - my.user.name

if the option (which is 0 by default) were set to 1, then possible
results might be

 (:host "example.com" :user "some-attr")
 (:host "example.net" :user "me")
 (:host "myvps"       :user "my.user.name")

Although this won't work if a user wants different mask depths for
different sub-directories.

>> In any case, I'm happy to review patches, but I think someone who
>> actually uses this back end should implement the feature.
>
> I'm not a good lisp programmar but I could give it a go with some help
> such as your patch as a start point.

I should be able to handle the attribute feature, unless you want to
improve upon it. It's mainly the disambiguation feature that I'd want an
actual pass user, like yourself, to implement or at least help design.
(Although feel free to offer patches of any nature, including based on
anything I've proposed.)


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

From a0381a48cb4ff960ef2dd55dd511f5c18e535f6e Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 10 Aug 2024 07:15:36 -0700
Subject: [PATCH 0/1] *** NOT A PATCH ***

*** BLURB HERE ***

F. Jason Park (1):
  [POC] Match attrs with auth-source-pass-extra-query-keywords

 lisp/auth-source-pass.el            | 143 ++++++++++++++++++++--------
 test/lisp/auth-source-pass-tests.el |  96 ++++++++++++++++++-
 2 files changed, 195 insertions(+), 44 deletions(-)

Interdiff:
diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index 8982e07a6be..0df7817f501 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -264,10 +264,10 @@ auth-source-pass--cast-port
            n))
         (t (format "%s" val))))
 
-(defun auth-source-pass--match-parts (parts key reference require)
-  (let ((value (plist-get parts key)))
+(defun auth-source-pass--match-parts (cache key reference require)
+  (let ((value (plist-get cache key)))
     (if (memq key require)
-        (or (null reference) (equal value reference))
+        (if reference (equal value reference) value)
       (or (null reference) (null value) (equal value reference)))))
 
 (defvar auth-source-pass-check-attrs-with-extra-query-keywords t
@@ -299,13 +299,15 @@ auth-source-pass--find-matched-entry
                        (setq suffixedp t)
                        u))
                     ((match-string 20 entry))
-                    ((and user optp) (funcall getat "user"))))
+                    ((and optp (or user (memq :user require)))
+                     (funcall getat "user"))))
            (p (cond (cached (plist-get cached :port))
                     ((match-string 30 entry))
                     ((match-string 31 entry))
-                    ((and port optp) (funcall getat "port"))))
+                    ((and optp (or port (memq :port require)))
+                     (funcall getat "port"))))
            ;;
-           s)
+           s extras)
       (when p
         (setq p (auth-source-pass--cast-port p port)))
       (unless cached
@@ -320,18 +322,29 @@ auth-source-pass--find-matched-entry
                  (auth-source-pass--match-parts cached :user user require)
                  (setq s (or (funcall getat 'secret)
                              (not (memq :secret require)))))
-        (unless (or user u)
-          (when (setq u (funcall getat "user"))
-            (setq cached (plist-put cached :user u))))
-        (unless (or port p)
-          (when (setq p (funcall getat "port"))
-            (setq p (auth-source-pass--cast-port p port)
-                  cached (plist-put cached :port p))))
+        (let (tmp)
+          (while-let ((v (pop attrs))
+                      (k (pop v)))
+            (pcase k
+              ((or "user" "username")
+               (unless (or user u)
+                 (setq u v
+                       cached (plist-put cached :user u))))
+              ("port"
+               (unless (or port p)
+                 (setq p (auth-source-pass--cast-port v port)
+                       cached (plist-put cached :port p))))
+              ((pred stringp)
+               (push (intern (concat ":" k)) extras)
+               (push v extras)
+               (push (cons k v) tmp))))
+          (setq attrs (nreverse tmp)))
         (puthash entry (plist-put cached :attrs attrs) seen)
         `( :host ,host
            ,@(and u (list :user u))
            ,@(and p (list :port p))
-           ,@(and s (not (eq s t)) (list :secret s)))))))
+           ,@(and s (not (eq s t)) (list :secret s))
+           ,@(nreverse extras))))))
 
 (defun auth-source-pass--find-match-many (hosts users ports require max)
   "Return plists for valid combinations of HOSTS, USERS, PORTS."
diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el
index 2ce5d12a6bc..c6662cd8b42 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -668,6 +668,23 @@ auth-source-pass-extra-query-keywords--akib/attr/require
       (should (equal results
                      '((:host "disroot.org" :user "akib" :secret "b")))))))
 
+(ert-deftest auth-source-pass-extra-query-keywords--akib/attr/extras ()
+  (auth-source-pass--with-store '(("x.com" (secret . "a"))
+                                  ("disroot.org" (secret . "b")
+                                   ("user" . "akib")
+                                   ("port" . "42")
+                                   ("foo" . "1")
+                                   ("bar" . "2"))
+                                  ("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" :port "42"
+                              :secret "b" :foo "1" :bar "2")))))))
+
 ;; Searches for :host are case-sensitive, and a returned host isn't
 ;; normalized.
 
-- 
2.46.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-POC-Match-attrs-with-auth-source-pass-extra-query-ke.patch --]
[-- Type: text/x-patch, Size: 15077 bytes --]

From a0381a48cb4ff960ef2dd55dd511f5c18e535f6e Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 7 Aug 2024 22:23:09 -0700
Subject: [PATCH 1/1] [POC] Match attrs with
 auth-source-pass-extra-query-keywords

* lisp/auth-source-pass.el (auth-source-pass--retrieve-parsed):
Remove unused function.
(auth-source-pass--cast-port): New function, a helper to match an
entry's port to the given query param's type.
(auth-source-pass--match-parts): Return non-nil when a key is required
but the value is null.  Not doing produced behavior that deviated from
the reference netrc implementation and was thus a bug.
(auth-source-pass-check-attrs-with-extra-query-keywords): New
variable, a flag to opt out of arguably expensive attribute lookups.
(auth-source-pass--find-matched-entry): New function to isolate
processing logic for a single entry.
(auth-source-pass--find-match-many): Move single-entry processing
logic to separate helper, mainly for readability.
* test/lisp/auth-source-pass-tests.el
(auth-source-pass-extra-query-keywords--akib/attr)
(auth-source-pass-extra-query-keywords--netrc-akib/require)
(auth-source-pass-extra-query-keywords--akib/attr/require)
(auth-source-pass-extra-query-keywords--akib/attr/extras)
(auth-source-pass-extra-query-keywords--netrc-baseline): New tests.
(auth-source-pass-extra-query-keywords--baseline): Reverse expected
outcome to match reference implementation.  That it didn't before was
a bug.  (Bug#72441)
---
 lisp/auth-source-pass.el            | 143 ++++++++++++++++++++--------
 test/lisp/auth-source-pass-tests.el |  96 ++++++++++++++++++-
 2 files changed, 195 insertions(+), 44 deletions(-)

diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index 03fd1f35811..0df7817f501 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -256,32 +256,101 @@ auth-source-pass--find-match
                 hosts
               (list hosts))))
 
-(defun auth-source-pass--retrieve-parsed (seen path port-number-p)
-  (when (string-match auth-source-pass--match-regexp path)
-    (puthash path
-             `( :host ,(or (match-string 10 path) (match-string 11 path))
-                ,@(if-let* ((tr (match-string 21 path)))
-                      (list :user tr :suffix t)
-                    (list :user (match-string 20 path)))
-                :port ,(and-let* ((p (or (match-string 30 path)
-                                         (match-string 31 path)))
-                                  (n (string-to-number p)))
-                         (if (or (zerop n) (not port-number-p))
-                             (format "%s" p)
-                           n)))
-             seen)))
-
-(defun auth-source-pass--match-parts (parts key value require)
-  (let ((mv (plist-get parts key)))
+(defun auth-source-pass--cast-port (val ref)
+  (cond ((integerp val) val)
+        ((and-let* (((integerp ref))
+                    (n (string-to-number val))
+                    ((not (zerop n))))
+           n))
+        (t (format "%s" val))))
+
+(defun auth-source-pass--match-parts (cache key reference require)
+  (let ((value (plist-get cache key)))
     (if (memq key require)
-        (and value (equal mv value))
-      (or (not value) (not mv) (equal mv value)))))
+        (if reference (equal value reference) value)
+      (or (null reference) (null value) (equal value reference)))))
+
+(defvar auth-source-pass-check-attrs-with-extra-query-keywords t
+  "When non-nil, decrypt files to find attributes matching parameters.
+However, give precedence to fields encoded in file names.  Only applies
+when `auth-source-pass-extra-query-keywords' is non-nil.")
+
+;; This function tries to defer decryption as long as possible.  For
+;; that reason, an entry's file-path-derived :port or :user field
+;; always takes precedence over their counterparts from a decrypted
+;; file's attribute list.
+(defun auth-source-pass--find-matched-entry (host user port require seen entry)
+  "Match ENTRY against query params HOST USER PORT REQUIRE with cache SEEN."
+  (when (string-match auth-source-pass--match-regexp entry)
+    (let* ((cached (gethash entry seen))
+           (optp auth-source-pass-check-attrs-with-extra-query-keywords)
+           (suffixedp nil)
+           (h (or (and cached (plist-get cached :host))
+                  (match-string 10 entry)
+                  (match-string 11 entry)))
+           (attrs (and cached (plist-get :attrs cached)))
+           (getat (lambda (k)
+                    (save-match-data
+                      (unless attrs
+                        (setq attrs (auth-source-pass-parse-entry entry)))
+                      (auth-source-pass--get-attr k attrs))))
+           (u (cond (cached (plist-get cached :user))
+                    ((and-let* ((u (match-string 21 entry)))
+                       (setq suffixedp t)
+                       u))
+                    ((match-string 20 entry))
+                    ((and optp (or user (memq :user require)))
+                     (funcall getat "user"))))
+           (p (cond (cached (plist-get cached :port))
+                    ((match-string 30 entry))
+                    ((match-string 31 entry))
+                    ((and optp (or port (memq :port require)))
+                     (funcall getat "port"))))
+           ;;
+           s extras)
+      (when p
+        (setq p (auth-source-pass--cast-port p port)))
+      (unless cached
+        (setq cached `( :host ,h
+                        ,@(and u (list :user u))
+                        ,@(and p (list :port p))
+                        ,@(and suffixedp (list :suffix t))
+                        ,@(and attrs (list :attrs attrs))))
+        (puthash entry cached seen))
+      (when (and (equal host h)
+                 (auth-source-pass--match-parts cached :port port require)
+                 (auth-source-pass--match-parts cached :user user require)
+                 (setq s (or (funcall getat 'secret)
+                             (not (memq :secret require)))))
+        (let (tmp)
+          (while-let ((v (pop attrs))
+                      (k (pop v)))
+            (pcase k
+              ((or "user" "username")
+               (unless (or user u)
+                 (setq u v
+                       cached (plist-put cached :user u))))
+              ("port"
+               (unless (or port p)
+                 (setq p (auth-source-pass--cast-port v port)
+                       cached (plist-put cached :port p))))
+              ((pred stringp)
+               (push (intern (concat ":" k)) extras)
+               (push v extras)
+               (push (cons k v) tmp))))
+          (setq attrs (nreverse tmp)))
+        (puthash entry (plist-put cached :attrs attrs) seen)
+        `( :host ,host
+           ,@(and u (list :user u))
+           ,@(and p (list :port p))
+           ,@(and s (not (eq s t)) (list :secret s))
+           ,@(nreverse extras))))))
 
 (defun auth-source-pass--find-match-many (hosts users ports require max)
   "Return plists for valid combinations of HOSTS, USERS, PORTS."
   (let ((seen (make-hash-table :test #'equal))
         (entries (auth-source-pass-entries))
-        out suffixed suffixedp)
+        out suffixed)
     (catch 'done
       (dolist (host hosts out)
         (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host)))
@@ -289,28 +358,18 @@ auth-source-pass--find-match-many
             (setq p nil))
           (dolist (user (or users (list u)))
             (dolist (port (or ports (list p)))
-              (dolist (e entries)
-                (when-let*
-                    ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed
-                                              seen e (integerp port))))
-                     ((equal host (plist-get m :host)))
-                     ((auth-source-pass--match-parts m :port port require))
-                     ((auth-source-pass--match-parts m :user user require))
-                     (parsed (auth-source-pass-parse-entry e))
-                     ;; For now, ignore body-content pairs, if any,
-                     ;; from `auth-source-pass--parse-data'.
-                     (secret (or (auth-source-pass--get-attr 'secret parsed)
-                                 (not (memq :secret require)))))
-                  (push
-                   `( :host ,host ; prefer user-provided :host over h
-                      ,@(and-let* ((u (plist-get m :user))) (list :user u))
-                      ,@(and-let* ((p (plist-get m :port))) (list :port p))
-                      ,@(and secret (not (eq secret t)) (list :secret secret)))
-                   (if (setq suffixedp (plist-get m :suffix)) suffixed out))
-                  (unless suffixedp
-                    (when (or (zerop (cl-decf max))
-                              (null (setq entries (delete e entries))))
-                      (throw 'done out)))))
+              (dolist (entry entries)
+                (let* ((result (auth-source-pass--find-matched-entry
+                                host user port require seen entry))
+                       ;;
+                       suffixedp)
+                  (when result
+                    (setq suffixedp (plist-get (gethash entry seen) :suffix))
+                    (push result (if suffixedp suffixed out))
+                    (unless suffixedp
+                      (when (or (zerop (cl-decf max))
+                                (null (setq entries (delete entry entries))))
+                        (throw 'done out))))))
               (setq suffixed (nreverse suffixed))
               (while suffixed
                 (push (pop suffixed) out)
diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el
index 6455c3393d5..c6662cd8b42 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -601,6 +601,90 @@ auth-source-pass-extra-query-keywords--akib
       (should (equal results
                      '((:host "disroot.org" :user "akib" :secret "b")))))))
 
+(ert-deftest auth-source-pass-extra-query-keywords--akib/attr ()
+  (auth-source-pass--with-store '(("x.com" (secret . "a"))
+                                  ("disroot.org" (secret . "b")
+                                   ("user" . "akib") ("port" . "42"))
+                                  ("z.com" (secret . "c")))
+    (auth-source-pass-enable)
+    (let* ((auth-source-pass-extra-query-keywords t)
+           results)
+
+      ;; Non-matching query param.
+      (setq results (auth-source-search :host "disroot.org" :user "?" :max 2))
+      (should-not results)
+
+      ;; No query params matching attrs.
+      (setq 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"
+                         :port "42" :secret "b"))))
+
+      ;; Matching user query param.
+      (setq results (auth-source-search :host "disroot.org" :user "akib"))
+      (dolist (result results)
+        (setf (plist-get result :secret) (auth-info-password result)))
+      (should (equal results
+                     '(( :host "disroot.org" :user "akib"
+                         :port "42" :secret "b"))))
+
+      ;; Matching port typed query param.
+      (setq results (auth-source-search :host "disroot.org" :port 42))
+      (dolist (result results)
+        (setf (plist-get result :secret) (auth-info-password result)))
+      (should (equal results
+                     '(( :host "disroot.org" :user "akib"
+                         :port 42 :secret "b")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--netrc-akib/require ()
+  (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"
+                                        :require '(:user) :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/attr/require ()
+  (auth-source-pass--with-store '(("x.com" (secret . "a"))
+                                  ("disroot.org" (secret . "b")
+                                   ("user" . "akib"))
+                                  ("z.com" (secret . "c")))
+    (auth-source-pass-enable)
+    (let* ((auth-source-pass-extra-query-keywords t)
+           (results (auth-source-search :host "disroot.org"
+                                        :require '(:user) :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/attr/extras ()
+  (auth-source-pass--with-store '(("x.com" (secret . "a"))
+                                  ("disroot.org" (secret . "b")
+                                   ("user" . "akib")
+                                   ("port" . "42")
+                                   ("foo" . "1")
+                                   ("bar" . "2"))
+                                  ("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" :port "42"
+                              :secret "b" :foo "1" :bar "2")))))))
+
 ;; Searches for :host are case-sensitive, and a returned host isn't
 ;; normalized.
 
@@ -632,11 +716,19 @@ auth-source-pass-extra-query-keywords--host
 ;; 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--netrc-baseline ()
+  (ert-with-temp-file netrc-file
+    :text "machine foo\n"
+    (let* ((auth-sources (list netrc-file))
+           (auth-source-do-cache nil)
+           (results (auth-source-search :host "foo")))
+      (should (equal results '((:host "foo")))))))
+
 (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--with-store '(("foo"))
       (auth-source-pass-enable)
-      (should-not (auth-source-search :host "x.com")))))
+      (should (equal (auth-source-search :host "foo") '((:host "foo")))))))
 
 ;; Output port type (int or string) matches that of input parameter.
 
-- 
2.46.0