From 2cf9e699ef0fc43a4eadaf00a1ed2f876765c64d Mon Sep 17 00:00:00 2001 From: F. Jason Park Date: Tue, 1 Nov 2022 22:46:24 -0700 Subject: Make auth-source-pass behave more like other backends * lisp/auth-source-pass.el (auth-source-pass-extra-query-keywords): Add new option to bring search behavior more in line with other backends. (auth-source-pass-search): Add new keyword params `max' and `require' and consider new option `auth-source-pass-extra-query-keywords' for dispatch. (auth-source-pass--match-regexp, auth-source-pass--retrieve-parsed, auth-source-pass--match-parts): Add supporting variable and helpers. (auth-source-pass--build-result-many, auth-source-pass--find-match-many): Add "-many" variants for existing workhorse functions. * test/lisp/auth-source-pass-tests.el: Require `ert-x'. (auth-source-pass-can-start-from-auth-source-search): Ensure `auth-source-pass-extra-query-keywords' is enabled around test body. (auth-source-pass-extra-query-keywords--wild-port-miss-netrc, auth-source-pass-extra-query-keywords--wild-port-miss, auth-source-pass-extra-query-keywords--wild-port-hit-netrc, auth-source-pass-extra-query-keywords--wild-port-hit, auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc, auth-source-pass-extra-query-keywords--wild-port-req-miss, auth-source-pass-extra-query-keywords--netrc-akib, auth-source-pass-extra-query-keywords--akib, auth-source-pass-extra-query-keywords--netrc-host, auth-source-pass-extra-query-keywords--host, auth-source-pass-extra-query-keywords--baseline, auth-source-pass-extra-query-keywords--port-type, auth-source-pass-extra-query-keywords--hosts-first, auth-source-pass-extra-query-keywords--ambiguous-user-host, auth-source-pass-extra-query-keywords--suffixed-user, auth-source-pass-extra-query-keywords--user-priorities): Add juxtaposed netrc and extra-query-keywords pairs to demo optional extra-compliant behavior. * doc/misc/auth.texi: Add option `auth-source-pass-extra-query-keywords' to auth-source-pass section. * etc/NEWS: Mention `auth-source-pass-extra-query-keywords' in Emacs 29.1 package changes section. (Bug#58985.) Special thanks to Akib Azmain Turja for helping improve this patch. --- test/lisp/auth-source-pass-tests.el | 267 +++++++++++++++++++++++++++++++++++- 1 file changed, 265 insertions(+), 2 deletions(-) (limited to 'test') diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index f5147a7ce07..8bcb2739bb3 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -25,7 +25,7 @@ ;;; Code: -(require 'ert) +(require 'ert-x) (require 'auth-source-pass) @@ -466,7 +466,10 @@ HOSTNAME, USER and PORT are passed unchanged to (ert-deftest auth-source-pass-can-start-from-auth-source-search () (auth-source-pass--with-store '(("gitlab.com" ("user" . "someone"))) (auth-source-pass-enable) - (let ((result (car (auth-source-search :host "gitlab.com")))) + ;; This also asserts an aspect of traditional search behavior + ;; relative to `auth-source-pass-extra-query-keywords'. + (let* ((auth-source-pass-extra-query-keywords nil) + (result (car (auth-source-search :host "gitlab.com")))) (should (equal (plist-get result :user) "someone")) (should (equal (plist-get result :host) "gitlab.com"))))) @@ -488,6 +491,266 @@ HOSTNAME, USER and PORT are passed unchanged to (should (auth-source-pass--have-message-matching "found 2 entries matching \"gitlab.com\": (\"a/gitlab.com\" \"b/gitlab.com\")")))) + +;;;; Option `auth-source-pass-extra-query-keywords' (bug#58985) + +;; No entry has the requested port, but a result is still returned. + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss-netrc () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine x.com port 42 password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "x.com" :port 22 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "x.com" :secret "a"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("x.com:42" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "x.com" :port 22 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "x.com" :secret "a"))))))) + +;; One of two entries has the requested port, both returned. + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit-netrc () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine x.com port 42 password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "x.com" :port 42 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "x.com" :secret "a") + (:host "x.com" :port "42" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("x.com:42" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "x.com" :port 42 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "x.com" :secret "a") + (:host "x.com" :port 42 :secret "b"))))))) + +;; 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 () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine x.com port 42 password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search + :host "x.com" :port 22 :require '(:port) :max 2))) + (should-not results)))) + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss () + (let ((auth-source-pass-extra-query-keywords t)) + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("x.com:42" (secret . "b"))) + (auth-source-pass-enable) + (should-not (auth-source-search + :host "x.com" :port 22 :require '(:port) :max 2))))) + +;; Specifying a :host without a :user finds a lone entry and does not +;; include extra fields (i.e., :port nil) in the result. +;; https://lists.gnu.org/archive/html/emacs-devel/2022-11/msg00130.html + +(ert-deftest auth-source-pass-extra-query-keywords--netrc-akib () + (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" :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 () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("akib@disroot.org" (secret . "b")) + ("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" :secret "b"))))))) + +;; Searches for :host are case-sensitive, and a returned host isn't +;; normalized. + +(ert-deftest auth-source-pass-extra-query-keywords--netrc-host () + (ert-with-temp-file netrc-file + :text "\ +machine libera.chat password a +machine Libera.Chat password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "Libera.Chat" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "Libera.Chat" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--host () + (auth-source-pass--with-store '(("libera.chat" (secret . "a")) + ("Libera.Chat" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "Libera.Chat" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "Libera.Chat" :secret "b"))))))) + + +;; 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--baseline () + (let ((auth-source-pass-extra-query-keywords t)) + (auth-source-pass--with-store '(("x.com")) + (auth-source-pass-enable) + (should-not (auth-source-search :host "x.com"))))) + +;; Output port type (int or string) matches that of input parameter. + +(ert-deftest auth-source-pass-extra-query-keywords--port-type () + (let ((auth-source-pass-extra-query-keywords t) + (f (lambda (r) (setf (plist-get r :secret) (auth-info-password r)) r))) + (auth-source-pass--with-store '(("x.com:42" (secret . "a"))) + (auth-source-pass-enable) + (should (equal (mapcar f (auth-source-search :host "x.com" :port 42)) + '((:host "x.com" :port 42 :secret "a"))))) + (auth-source-pass--with-store '(("x.com:42" (secret . "a"))) + (auth-source-pass-enable) + (should (equal (mapcar f (auth-source-search :host "x.com" :port "42")) + '((:host "x.com" :port "42" :secret "a"))))))) + +;; Match precision sometimes takes a back seat to the traversal +;; ordering. Specifically, the :host (h1, ...) args hold greater sway +;; over the output because they determine the first coordinate in the +;; sequence of (host, user, port) combinations visited. (Taking a +;; tree-wise view, these become the depth-1 nodes in a DFS.) + +;; Note that all trailing /user forms are demoted for the sake of +;; predictability (see tests further below for details). This means +;; that, in the following test, /bar is held in limbo, followed by +;; /foo, but they both retain priority over "gnu.org", as noted above. + +(ert-deftest auth-source-pass-extra-query-keywords--hosts-first () + (auth-source-pass--with-store '(("x.com:42/bar" (secret . "a")) + ("gnu.org" (secret . "b")) + ("x.com" (secret . "c")) + ("fake.com" (secret . "d")) + ("x.com/foo" (secret . "e"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host '("x.com" "gnu.org") :max 3))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + ;; Notice gnu.org is never considered ^ + '((:host "x.com" :secret "c") + (:host "x.com" :user "bar" :port "42" :secret "a") + (:host "x.com" :user "foo" :secret "e"))))))) + +;; This is another example given in the bug thread. + +(ert-deftest auth-source-pass-extra-query-keywords--ambiguous-user-host () + (auth-source-pass--with-store '(("foo.com/bar.org" (secret . "a")) + ("foo.com" (secret . "b")) + ("bar.org" (secret . "c")) + ("fake.com" (secret . "d"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "bar.org" :max 3))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "bar.org" :secret "c"))))))) + +;; This conveys the same idea as `user-priorities', just below, but +;; with slightly more realistic and less legible values. + +(ert-deftest auth-source-pass-extra-query-keywords--suffixed-user () + (let ((store (sort (copy-sequence '(("x.com:42/bar" (secret . "a")) + ("bar@x.com" (secret . "b")) + ("x.com" (secret . "?")) + ("bar@y.org" (secret . "c")) + ("fake.com" (secret . "?")) + ("fake.com/bar" (secret . "d")) + ("y.org/bar" (secret . "?")) + ("bar@fake.com" (secret . "e")))) + (lambda (&rest _) (zerop (random 2)))))) + (auth-source-pass--with-store store + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host '("x.com" "fake.com" "y.org") + :user "bar" + :require '(:user) :max 5))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "x.com" :user "bar" :secret "b") + (:host "x.com" :user "bar" :port "42" :secret "a") + (:host "fake.com" :user "bar" :secret "e") + (:host "fake.com" :user "bar" :secret "d") + (:host "y.org" :user "bar" :secret "c")))))))) + +;; This is a more distilled version of `suffixed-user', above. It +;; better illustrates that search order takes precedence over "/user" +;; demotion because otherwise * and ** would be swapped, below. It +;; follows that omitting the :port 2, gets you {u@h:1, u@h:2, h:1/u, +;; h:2/u, u@g:1}. + +(ert-deftest auth-source-pass-extra-query-keywords--user-priorities () + (let ((store (sort (copy-sequence '(("h:1/u" (secret . "/")) + ("h:2/u" (secret . "/")) + ("u@h:1" (secret . "@")) + ("u@h:2" (secret . "@")) + ("g:1/u" (secret . "/")) + ("g:2/u" (secret . "/")) + ("u@g:1" (secret . "@")) + ("u@g:2" (secret . "@")))) + (lambda (&rest _) (zerop (random 2)))))) + (auth-source-pass--with-store store + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host '("h" "g") + :port 2 + :max 5))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "h" :user "u" :port 2 :secret "@") + (:host "h" :user "u" :port 2 :secret "/") ; * + (:host "g" :user "u" :port 2 :secret "@") ; ** + (:host "g" :user "u" :port 2 :secret "/")))))))) + (provide 'auth-source-pass-tests) ;;; auth-source-pass-tests.el ends here -- cgit v1.2.1