From: "J.P." <jp@neverwas.me>
To: 72441@debbugs.gnu.org
Cc: "Björn Bidar" <bjorn.bidar@thaodan.de>
Subject: bug#72441: 31.0.50; Auth-source-pass doesn't match password attributes or hosts without user when extra-query-keywords is true
Date: Mon, 12 Aug 2024 12:33:48 -0700 [thread overview]
Message-ID: <874j7pedsz.fsf@neverwas.me> (raw)
In-Reply-To: <877ccoo4x8.fsf@neverwas.me> (J. P.'s message of "Sat, 10 Aug 2024 06:58:43 -0700")
[-- Attachment #1: Type: text/plain, Size: 481 bytes --]
While exploring ways to tackle this feature, I stumbled on a couple
minor bugs related to `auth-source-pass-extra-query-keywords'.
Because there's no telling when we'll end up with something installable
for this feature, I've gone ahead and isolated the fixes into a separate
patch (0001 in the attached). It's probably safe enough for Emacs 30,
but since the option was introduced back in 29, I'll just install it on
master (unless I hear otherwise in the coming days). Thanks.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v2-v3.diff --]
[-- Type: text/x-patch, Size: 7149 bytes --]
From d9bd10debf6c3930669aedb896026f9f19b54466 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 12 Aug 2024 07:00:23 -0700
Subject: [PATCH 0/2] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (2):
Fix deviations in auth-source-pass behavior WRT netrc
[POC] Match attrs with auth-source-pass-extra-query-keywords
lisp/auth-source-pass.el | 146 ++++++++++++++++++++--------
test/lisp/auth-source-pass-tests.el | 138 +++++++++++++++++++++++++-
2 files changed, 237 insertions(+), 47 deletions(-)
Interdiff:
diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index 0df7817f501..a52dafc5ab2 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -266,9 +266,10 @@ auth-source-pass--cast-port
(defun auth-source-pass--match-parts (cache key reference require)
(let ((value (plist-get cache key)))
- (if (memq key require)
- (if reference (equal value reference) value)
- (or (null reference) (null value) (equal value reference)))))
+ (cond ((memq key require)
+ (if reference (equal value reference) value))
+ ((and value reference) (equal value reference))
+ (t))))
(defvar auth-source-pass-check-attrs-with-extra-query-keywords t
"When non-nil, decrypt files to find attributes matching parameters.
diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el
index c6662cd8b42..695635299f9 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -548,6 +548,44 @@ auth-source-pass-extra-query-keywords--wild-port-hit
'((:host "x.com" :secret "a")
(:host "x.com" :port 42 :secret "b")))))))
+;; The query requires a user and doesn't specify a user to match against.
+;; The only entry matching the host lacks a user, so the search fails.
+
+(ert-deftest auth-source-pass-extra-query-keywords--req-noparam-miss-netrc ()
+ (ert-with-temp-file netrc-file
+ :text "machine foo password a\n"
+ (let ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil))
+ (should-not (auth-source-search :host "foo" :require '(:user) :max 2)))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--req-noparam-miss ()
+ (let ((auth-source-pass-extra-query-keywords t))
+ (auth-source-pass--with-store '(("foo" (secret . "a")))
+ (auth-source-pass-enable)
+ (should-not (auth-source-search :host "foo" :require '(:user) :max 2)))))
+
+;; The query requires a user but does not provide a reference value to
+;; match against. An entry matching the host that specifies a user is
+;; selected because any user will do.
+(ert-deftest auth-source-pass-extra-query-keywords--req-param-netrc ()
+ (ert-with-temp-file netrc-file
+ :text "machine foo login bob password a\n"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ (results (auth-source-search :host "foo" :require '(:user))))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "foo" :user "bob" :secret "a")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--req-param ()
+ (let ((auth-source-pass-extra-query-keywords t))
+ (auth-source-pass--with-store '(("foo/bob" (secret . "a")))
+ (auth-source-pass-enable)
+ (let ((results (auth-source-search :host "foo" :require '(:user))))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "foo" :user "bob" :secret "a"))))))))
+
;; 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 ()
@@ -601,7 +639,7 @@ 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 ()
+(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"))
@@ -638,23 +676,7 @@ auth-source-pass-extra-query-keywords--akib/attr
'(( :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 ()
+(ert-deftest auth-source-pass-extra-query-keywords--akib-attr-req ()
(auth-source-pass--with-store '(("x.com" (secret . "a"))
("disroot.org" (secret . "b")
("user" . "akib"))
@@ -668,7 +690,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 ()
+(ert-deftest auth-source-pass-extra-query-keywords--akib-attr-extras-netrc ()
+ (ert-with-temp-file netrc-file
+ :text "\
+machine x.com password a
+machine disroot.org user akib port 42 password b foo 1 bar 2
+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" :port "42"
+ :secret "b" :foo "1" :bar "2")))))))
+
+(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")
@@ -713,8 +751,8 @@ auth-source-pass-extra-query-keywords--host
'((:host "Libera.Chat" :secret "b")))))))
-;; A retrieved store entry mustn't be nil regardless of whether its
-;; path contains port or user components.
+;; An effectively empty entry in the store returns nothing but the
+;; :host field matching the given host parameter.
(ert-deftest auth-source-pass-extra-query-keywords--netrc-baseline ()
(ert-with-temp-file netrc-file
--
2.46.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Fix-deviations-in-auth-source-pass-behavior-WRT-netr.patch --]
[-- Type: text/x-patch, Size: 7898 bytes --]
From 1aa0f941d79b77de4a87a8043f13607c0719f5d0 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 11 Aug 2024 21:55:32 -0700
Subject: [PATCH 1/2] Fix deviations in auth-source-pass behavior WRT netrc
The option `auth-source-pass-extra-query-keywords' aims to make this
back end hew as close to the other built-in ones as possible, except
WRT features not yet implemented, such as arbitrary "attribute"
retrieval and new entry creation. This change only concerns behavior
exhibited when the option is enabled.
* lisp/auth-source-pass.el (auth-source-pass--match-parts): Account
for the case in which a query lacks a reference parameter for a
`:port' or `:user' but still requires one or both via the `:require'
keyword. Previously, such a query would fail even when an entry met
this requirement by simply specifying a field with any non-null value
corresponding to the required parameter.
(auth-source-pass--find-match-many): Account for the baseline case
where a matching entry lacks a secret and the user doesn't require
one. Although this function doesn't currently return so-called
"attributes" from the contents of a matching decrypted file, were it
to eventually, this case would no longer be academic.
* test/lisp/auth-source-pass-tests.el
(auth-source-pass-extra-query-keywords--req-noparam-miss-netrc)
(auth-source-pass-extra-query-keywords--req-noparam-miss)
(auth-source-pass-extra-query-keywords--req-param-netrc)
(auth-source-pass-extra-query-keywords--req-param): New tests.
(auth-source-pass-extra-query-keywords--netrc-baseline): New test
asserting behavior of netrc backend when passed a lone `:host' as a
query parameter.
(auth-source-pass-extra-query-keywords--baseline): Reverse expected
outcome to match that of the netrc reference
implementation. (bug#72441)
---
lisp/auth-source-pass.el | 19 +++++-----
test/lisp/auth-source-pass-tests.el | 54 ++++++++++++++++++++++++++---
2 files changed, 60 insertions(+), 13 deletions(-)
diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index 03fd1f35811..dd93d414d5e 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -271,11 +271,12 @@ auth-source-pass--retrieve-parsed
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--match-parts (cache key reference require)
+ (let ((value (plist-get cache key)))
+ (cond ((memq key require)
+ (if reference (equal value reference) value))
+ ((and value reference) (equal value reference))
+ (t))))
(defun auth-source-pass--find-match-many (hosts users ports require max)
"Return plists for valid combinations of HOSTS, USERS, PORTS."
@@ -290,17 +291,17 @@ auth-source-pass--find-match-many
(dolist (user (or users (list u)))
(dolist (port (or ports (list p)))
(dolist (e entries)
- (when-let*
+ (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)))))
+ (secret (let ((parsed (auth-source-pass-parse-entry e)))
+ (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))
diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el
index 6455c3393d5..c54936c3f92 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -548,6 +548,44 @@ auth-source-pass-extra-query-keywords--wild-port-hit
'((:host "x.com" :secret "a")
(:host "x.com" :port 42 :secret "b")))))))
+;; The query requires a user and doesn't specify a user to match against.
+;; The only entry matching the host lacks a user, so the search fails.
+
+(ert-deftest auth-source-pass-extra-query-keywords--req-noparam-miss-netrc ()
+ (ert-with-temp-file netrc-file
+ :text "machine foo password a\n"
+ (let ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil))
+ (should-not (auth-source-search :host "foo" :require '(:user) :max 2)))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--req-noparam-miss ()
+ (let ((auth-source-pass-extra-query-keywords t))
+ (auth-source-pass--with-store '(("foo" (secret . "a")))
+ (auth-source-pass-enable)
+ (should-not (auth-source-search :host "foo" :require '(:user) :max 2)))))
+
+;; The query requires a user but does not provide a reference value to
+;; match against. An entry matching the host that specifies a user is
+;; selected because any user will do.
+(ert-deftest auth-source-pass-extra-query-keywords--req-param-netrc ()
+ (ert-with-temp-file netrc-file
+ :text "machine foo login bob password a\n"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ (results (auth-source-search :host "foo" :require '(:user))))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "foo" :user "bob" :secret "a")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--req-param ()
+ (let ((auth-source-pass-extra-query-keywords t))
+ (auth-source-pass--with-store '(("foo/bob" (secret . "a")))
+ (auth-source-pass-enable)
+ (let ((results (auth-source-search :host "foo" :require '(:user))))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "foo" :user "bob" :secret "a"))))))))
+
;; 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 ()
@@ -629,14 +667,22 @@ auth-source-pass-extra-query-keywords--host
'((:host "Libera.Chat" :secret "b")))))))
-;; A retrieved store entry mustn't be nil regardless of whether its
-;; path contains port or user components.
+;; An effectively empty entry in the store returns nothing but the
+;; :host field matching the given host parameter.
+
+(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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-POC-Match-attrs-with-auth-source-pass-extra-query-ke.patch --]
[-- Type: text/x-patch, Size: 13936 bytes --]
From d9bd10debf6c3930669aedb896026f9f19b54466 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 2/2] [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 so 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--akib-attr-req)
(auth-source-pass-extra-query-keywords--akib-attr-netrc)
(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 | 133 ++++++++++++++++++++--------
test/lisp/auth-source-pass-tests.el | 84 ++++++++++++++++++
2 files changed, 180 insertions(+), 37 deletions(-)
diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index dd93d414d5e..a52dafc5ab2 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -256,20 +256,13 @@ 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--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)))
@@ -278,11 +271,87 @@ auth-source-pass--match-parts
((and value reference) (equal value reference))
(t))))
+(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)))
@@ -290,28 +359,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))
- ;; For now, ignore body-content pairs, if any,
- ;; from `auth-source-pass--parse-data'.
- (secret (let ((parsed (auth-source-pass-parse-entry e)))
- (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 c54936c3f92..695635299f9 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -639,6 +639,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--akib-attr-req ()
+ (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-netrc ()
+ (ert-with-temp-file netrc-file
+ :text "\
+machine x.com password a
+machine disroot.org user akib port 42 password b foo 1 bar 2
+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" :port "42"
+ :secret "b" :foo "1" :bar "2")))))))
+
+(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
next prev parent reply other threads:[~2024-08-12 19:33 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-08-03 11:12 bug#72441: 31.0.50; Auth-source-pass doesn't match password attributes or hosts without user when extra-query-keywords is true Björn Bidar via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-08-09 18:02 ` J.P.
2024-08-09 19:20 ` Björn Bidar via Bug reports for GNU Emacs, the Swiss army knife of text editors
[not found] ` <87ed6xy03r.fsf@>
2024-08-10 13:58 ` J.P.
2024-08-12 19:33 ` J.P. [this message]
2024-09-06 23:16 ` 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
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=874j7pedsz.fsf@neverwas.me \
--to=jp@neverwas.me \
--cc=72441@debbugs.gnu.org \
--cc=bjorn.bidar@thaodan.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 public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).