From 7a6ee6960ded65dfdec768b094eca8d1883a8f4d Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 14 Nov 2022 06:51:56 -0800 Subject: [PATCH 0/2] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (2): [POC] Make auth-source-pass behave more like other backends [POC] Support auth-source-pass in ERC doc/misc/auth.texi | 11 ++ doc/misc/erc.texi | 3 +- etc/NEWS | 8 + lisp/auth-source-pass.el | 113 +++++++++++++- lisp/erc/erc-compat.el | 104 +++++++++++++ lisp/erc/erc.el | 7 +- test/lisp/auth-source-pass-tests.el | 223 ++++++++++++++++++++++++++++ test/lisp/erc/erc-services-tests.el | 3 - 8 files changed, 466 insertions(+), 6 deletions(-) Interdiff: diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 34edd4fa31..aa39df014c 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -258,14 +258,16 @@ auth-source-pass--find-match (defun auth-source-pass--retrieve-parsed (seen path port-number-p) (when (string-match auth-source-pass--match-regexp path) (puthash path - (list :host (or (match-string 10 path) (match-string 11 path)) - :user (or (match-string 20 path) (match-string 21 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))) + `( :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) @@ -279,7 +281,7 @@ auth-source-pass--find-match-many Each plist contains, at the very least, a host and a secret." (let ((seen (make-hash-table :test #'equal)) (entries (auth-source-pass-entries)) - out) + out suffixed suffixedp) (catch 'done (dolist (host hosts out) (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host))) @@ -304,10 +306,16 @@ auth-source-pass--find-match-many ,@(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))) - out) - (when (or (zerop (cl-decf max)) - (null (setq entries (delete e entries)))) - (throw 'done out))))))))))) + (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. diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 47d5258f92..51bf251026 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -193,17 +193,16 @@ erc-compat--auth-source-pass--retrieve-parsed (? "/" (group-n 21 (+ (not (in " /:"))))))) eot) e) - (puthash e (list :host (or (match-string 10 e) - (match-string 11 e)) - :user (or (match-string 20 e) - (match-string 21 e)) - :port (and-let* ((p (or (match-string 30 e) - (match-string 31 e))) - (n (string-to-number p))) - (if (or (zerop n) - (not port-number-p)) - (format "%s" p) - n))) + (puthash e `( :host ,(or (match-string 10 e) (match-string 11 e)) + ,@(if-let* ((tr (match-string 21 e))) + (list :user tr :suffix t) + (list :user (match-string 20 e))) + :port ,(and-let* ((p (or (match-string 30 e) + (match-string 31 e))) + (n (string-to-number p))) + (if (or (zerop n) (not port-number-p)) + (format "%s" p) + n))) seen))) ;; This looks bad, but it just inlines `auth-source-pass--find-match-many'. @@ -221,7 +220,7 @@ erc-compat--auth-source-pass--build-result-many (if (memq k require) (and v (equal mv v)) (or (not v) (not mv) (equal mv v)))))) - out) + out suffixed suffixedp) (catch 'done (dolist (host hosts) (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host))) @@ -245,10 +244,16 @@ erc-compat--auth-source-pass--build-result-many ,@(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))) - out) - (when (or (zerop (cl-decf max)) - (null (setq entries (delete e entries)))) - (throw 'done nil))))))))) + (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)))))))) (reverse out))) (cl-defun erc-compat--auth-source-pass-search diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 60903808e0..a92653b5ac 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -654,6 +654,11 @@ auth-source-pass-extra-query-keywords--port-type ;; matches are not given precedence, i.e., matching store items are ;; returned in the order encountered +;; Note that all trailing /user forms are demoted for the sake of +;; predictability, and so are quasi-deprecated. This means that, in +;; the following test, /bar is shunted off to 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")) @@ -667,10 +672,44 @@ auth-source-pass-extra-query-keywords--hosts-first (setf (plist-get result :secret) (auth-info-password result))) (should (equal results ;; Notice gnu.org is never considered ^ - '((:host "x.com" :user "bar" :port "42" :secret "a") - (:host "x.com" :secret "c") + '((:host "x.com" :secret "c") + (:host "x.com" :user "bar" :port "42" :secret "a") (:host "x.com" :user "foo" :secret "e"))))))) +(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"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--suffixed-user () + (auth-source-pass--with-store '(("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"))) + (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"))))))) (provide 'auth-source-pass-tests) -- 2.38.1