From a0381a48cb4ff960ef2dd55dd511f5c18e535f6e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 7 Aug 2024 22:23:09 -0700 Subject: [PATCH 1/1] [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 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--netrc-akib/require) (auth-source-pass-extra-query-keywords--akib/attr/require) (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 | 143 ++++++++++++++++++++-------- test/lisp/auth-source-pass-tests.el | 96 ++++++++++++++++++- 2 files changed, 195 insertions(+), 44 deletions(-) diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 03fd1f35811..0df7817f501 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -256,32 +256,101 @@ 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--match-parts (parts key value require) - (let ((mv (plist-get parts key))) +(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))) (if (memq key require) - (and value (equal mv value)) - (or (not value) (not mv) (equal mv value))))) + (if reference (equal value reference) value) + (or (null reference) (null value) (equal value reference))))) + +(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))) @@ -289,28 +358,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)) - (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))))) + (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 6455c3393d5..c6662cd8b42 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -601,6 +601,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--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 () + (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 () + (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. @@ -632,11 +716,19 @@ auth-source-pass-extra-query-keywords--host ;; 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--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