mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-07 15:21:46 +00:00
Code Issues Releases Activity

Fix discrepancies in auth-source-pass vs netrc behavior

Browse Source 
The option `auth-source-pass-extra-query-keywords' aims to make its
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)
This commit is contained in:
F. Jason Park 2024-08-11 21:55:32 -07:00
parent 6cc87d07dd
commit 80228d1f6e
2 changed files with 60 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
lisp/auth-source-pass.el
View File

@ -271,11 +271,12 @@ HOSTS can be a string or a list of strings."
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 @@ HOSTS can be a string or a list of strings."
(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))

54
test/lisp/auth-source-pass-tests.el
View File

@ -548,6 +548,44 @@ machine x.com port 42 password b
'((: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 @@ machine Libera.Chat password b
'((: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.