From 2cf9e699ef0fc43a4eadaf00a1ed2f876765c64d Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 1 Nov 2022 22:46:24 -0700 Subject: [PATCH] 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. --- doc/misc/auth.texi | 18 ++ etc/NEWS | 8 + lisp/auth-source-pass.el | 112 +++++++++++- test/lisp/auth-source-pass-tests.el | 267 +++++++++++++++++++++++++++- 4 files changed, 402 insertions(+), 3 deletions(-) diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 9dc63af6bcc..872e5f88f55 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -526,6 +526,8 @@ If several entries match, the one matching the most items (where an while searching for an entry matching the @code{rms} user on host @code{gnu.org} and port @code{22}, then the entry @file{gnu.org:22/rms.gpg} is preferred over @file{gnu.org.gpg}. +However, such processing is not applied when the option +@code{auth-source-pass-extra-parameters} is set to @code{t}. Users of @code{pass} may also be interested in functionality provided by other Emacs packages: @@ -549,6 +551,22 @@ Set this variable to a string that should separate an host name from a port in an entry. Defaults to @samp{:}. @end defvar +@defvar auth-source-pass-extra-query-keywords +This expands the selection of available keywords to include +@code{:max} and @code{:require} and tells more of them to accept a +list of query parameters as an argument. When searching, it also +favors the @samp{rms@@gnu.org.gpg} form for usernames over the +@samp{gnu.org/rms.gpg} form, regardless of whether a @code{:user} +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). +@end defvar + @node Help for developers @chapter Help for developers diff --git a/etc/NEWS b/etc/NEWS index e39833a7045..1e7190e830b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1395,6 +1395,14 @@ If non-nil and there's only one matching option, auto-select that. If non-nil, this user option describes what entries not to add to the database stored on disk. +** Auth-Source + ++++ +*** 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. + ** Dired +++ diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 0955e2ed07e..dc274843e10 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -55,13 +55,27 @@ :type 'string :version "27.1") +(defcustom auth-source-pass-extra-query-keywords t + "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 +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 +Unix password store'." + :type 'boolean + :version "29.1") + (cl-defun auth-source-pass-search (&rest spec &key backend type host user port + require max &allow-other-keys) "Given some search query, return matching credentials. See `auth-source-search' for details on the parameters SPEC, BACKEND, TYPE, -HOST, USER and PORT." +HOST, USER, PORT, REQUIRE, and MAX." (cl-assert (or (null type) (eq type (oref backend type))) t "Invalid password-store search: %s %s") (cond ((eq host t) @@ -70,6 +84,8 @@ HOST, USER and PORT." ((null host) ;; Do not build a result, as none will match when HOST is nil nil) + (auth-source-pass-extra-query-keywords + (auth-source-pass--build-result-many host port user require max)) (t (when-let ((result (auth-source-pass--build-result host port user))) (list result))))) @@ -89,6 +105,39 @@ HOSTS can be a string or a list of strings." (seq-subseq retval 0 -2)) ;; remove password retval)))) +(defvar auth-source-pass--match-regexp nil) + +(defun auth-source-pass--match-regexp (s) + (rx-to-string ; autoloaded + `(: (or bot "/") + (or (: (? (group-n 20 (+ (not (in ?\ ?/ ?@ ,s)))) "@") + (group-n 10 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s)))))) + (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 31 (+ (not (in ?\ ?/ ,s))))) + (? "/" (group-n 21 (+ (not (in ?\ ?/ ,s))))))) + eot) + 'no-group)) + +(defun auth-source-pass--build-result-many (hosts ports users require max) + "Return multiple `auth-source-pass--build-result' values." + (unless (listp hosts) (setq hosts (list hosts))) + (unless (listp users) (setq users (list users))) + (unless (listp ports) (setq ports (list ports))) + (let* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp + auth-source-pass-port-separator)) + (rv (auth-source-pass--find-match-many hosts users ports + require (or max 1)))) + (when auth-source-debug + (auth-source-pass--do-debug "final result: %S" rv)) + (let (out) + (dolist (e rv out) + (when-let* ((s (plist-get e :secret)) ; not captured by closure in 29.1 + (v (auth-source--obfuscate s))) + (setf (plist-get e :secret) + (lambda () (auth-source--deobfuscate v)))) + (push e out))))) + ;;;###autoload (defun auth-source-pass-enable () "Enable auth-source-password-store." @@ -206,6 +255,67 @@ HOSTS can be a string or a list of strings." 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))) + (if (memq key require) + (and value (equal mv value)) + (or (not value) (not mv) (equal mv value))))) + +(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) + (catch 'done + (dolist (host hosts out) + (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host))) + (unless (or (not (equal "443" p)) (string-prefix-p "https://" host)) + (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))))) + (setq suffixed (nreverse suffixed)) + (while suffixed + (push (pop suffixed) out) + (when (zerop (cl-decf max)) + (throw 'done out)))))))))) + (defun auth-source-pass--disambiguate (host &optional user port) "Return (HOST USER PORT) after disambiguation. Disambiguate between having user provided inside HOST (e.g., 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 -- 2.39.2