From 89ec2fd5ba7d3d276cb18d1d256080aff9f2ab77 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 18 Nov 2022 19:14:30 -0800 Subject: [PATCH 1/1] [POC] Allow subdomain matching in auth-source-pass--find-match-many * doc/misc/auth.texi: Mention incompatible domain-matching behavior in `auth-source-pass-extra-query-keywords' section. * etc/NEWS: Mention incompatible behavior in `auth-source-pass-extra-query-keywords' section. * lisp/auth-source-pass.el (auth-source-pass-extra-query-keywords): Mention lack of subdomain matching in doc string. (auth-source-pass--match-host): Add function to optionally regain traditional subdomain matching behavior. (auth-source-pass--find-match-many): Call `auth-source-pass--match-host' to handle host matching. * test/lisp/auth-source-pass-tests.el: FIXME Add ephemeral tests. --- doc/misc/auth.texi | 11 ++--- etc/NEWS | 3 +- lisp/auth-source-pass.el | 20 ++++++--- test/lisp/auth-source-pass-tests.el | 67 +++++++++++++++++++++++++++++ 4 files changed, 90 insertions(+), 11 deletions(-) diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 872e5f88f5..cd8efd8607 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -560,11 +560,12 @@ The Unix password store 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). +this backend, such as prioritizing field count in a filename or +matching against subdomain labels, 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 diff --git a/etc/NEWS b/etc/NEWS index 8a34afe8d2..73c848c033 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1407,7 +1407,8 @@ database stored on disk. *** 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. +applicable keywords. This disables most known search behavior unique +to auth-source-pass, such as wildcard subdomain matching. ** Dired diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index dc274843e1..2501a1ca85 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -59,13 +59,16 @@ auth-source-pass-extra-query-keywords "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 +certain keywords, such as `:host' and `:user'. Beyond that, wrap +all returned secrets in a function and don't bother considering +subdomains when matching hosts. Also, 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 +Unix password store'. With a value of `match-domains', this +option behaves as it does when set to t except that subdomain +matching is enabled." + :type '(choice (const nil) (const t) (const match-domains)) :version "29.1") (cl-defun auth-source-pass-search (&rest spec @@ -276,6 +279,13 @@ auth-source-pass--match-parts (and value (equal mv value)) (or (not value) (not mv) (equal mv value))))) +(defun auth-source-pass--match-host (search-param matched-path) + (if (and (eq auth-source-pass-extra-query-keywords 'match-domains) + (string-match (rx "." (+ (not ".")) "." (>= 2 alpha) eot) + search-param)) + (string-suffix-p matched-path search-param) + (equal matched-path search-param))) + (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)) @@ -292,7 +302,7 @@ auth-source-pass--find-match-many (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-host 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)) diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 8bcb2739bb..cca203d790 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -751,6 +751,73 @@ auth-source-pass-extra-query-keywords--user-priorities (:host "g" :user "u" :port 2 :secret "@") ; ** (:host "g" :user "u" :port 2 :secret "/")))))))) +;; Kai demo (delete) + +;; The netrc backend is does not consider subdomains + +(ert-deftest auth-source-pass-extra-query-keywords--subdomain-miss-netrc () + (ert-with-temp-file netrc-file + :text "\ +machine open-news-network.org password a +machine onn6 port nope password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search + :max 1 + :host '("news6.open-news-network.org" "onn6") + :port '("119" "nntp" "nntp" "563" "nntps" "snews")))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should-not results)))) + +;; And neither do we, when `auth-source-pass-extra-query-keywords' is t + +(ert-deftest auth-source-pass-extra-query-keywords--subdomain-miss () + (auth-source-pass--with-store '(("open-news-network.org" (secret . "a")) + ("onn6:nope" (secret . "b"))) + (auth-source-pass-enable) + (let ((auth-source-pass-extra-query-keywords t)) + (should-not (auth-source-search + :max 1 + :host '("news6.open-news-network.org" "onn6") + :port '("119" "nntp" "nntp" "563" "nntps" "snews")))))) + +;; But we could offer optional legacy matching behavior + +(ert-deftest auth-source-pass-extra-query-keywords--match-domains () + (auth-source-pass--with-store '(("open-news-network.org" (secret . "a")) + ("onn6:nope" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords 'match-domains) + (results (auth-source-search + :max 1 + :host '("news6.open-news-network.org" "onn6") + :port '("119" "nntp" "nntp" "563" "nntps" "snews")))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "news6.open-news-network.org" :secret "a"))))))) + +;; Traditional behavior when `auth-source-pass-extra-query-keywords' is nil + +(ert-deftest auth-source-pass-extra-query-keywords--nil--subdomain-hit () + (auth-source-pass--with-store '(("open-news-network.org" (secret . "a")) + ("onn6:nope" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords nil) + (results (auth-source-search + :max 1 + :host '("news6.open-news-network.org" "onn6") + :port '("119" "nntp" "nntp" "563" "nntps" "snews")))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '(( :host "news6.open-news-network.org" + :port ("119" "nntp" "nntp" "563" "nntps" "snews") + :user nil + :secret "a"))))))) + (provide 'auth-source-pass-tests) ;;; auth-source-pass-tests.el ends here -- 2.38.1