From e5fe85b89746fdc90ba68f3648482e15019720fd Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 10 Nov 2022 05:38:48 -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 | 107 +++++++++++++++++- lisp/erc/erc-compat.el | 99 ++++++++++++++++ lisp/erc/erc.el | 7 +- test/lisp/auth-source-pass-tests.el | 169 ++++++++++++++++++++++++++++ test/lisp/erc/erc-services-tests.el | 3 - 8 files changed, 401 insertions(+), 6 deletions(-) Interdiff: diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index d9129667e1..8d7241eb1a 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -130,7 +130,7 @@ auth-source-pass--build-result-many require (or max 1)))) (when auth-source-debug (auth-source-pass--do-debug "final result: %S" rv)) - (if (eq auth-source-pass-extra-query-keywords 'test) + (if (eq auth-source-pass-extra-query-keywords '--test--) (reverse rv) (let (out) (dolist (e rv out) @@ -276,14 +276,11 @@ auth-source-pass--match-parts (and value (equal mv value)) (or (not value) (not mv) (equal mv value))))) -;; For now, this ignores the contents of files and only considers path -;; components when matching. (defun auth-source-pass--find-match-many (hosts users ports require max) "Return plists for valid combinations of HOSTS, USERS, PORTS. Each plist contains, at the very least, a host and a secret." (let ((seen (make-hash-table :test #'equal)) (entries (auth-source-pass-entries)) - port-number-p out) (catch 'done (dolist (host hosts out) @@ -292,15 +289,16 @@ auth-source-pass--find-match-many (setq p nil)) (dolist (user (or users (list u))) (dolist (port (or ports (list p))) - (setq port-number-p (equal 'integer (type-of port))) (dolist (e entries) (when-let* ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed - seen e port-number-p))) + 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 @@ -310,7 +308,7 @@ auth-source-pass--find-match-many ,@(and secret (not (eq secret t)) (list :secret secret))) out) (when (or (zerop (cl-decf max)) - (null (setq entries (delete e entries)))) + (null (setq entries (remove e entries)))) (throw 'done out))))))))))) (defun auth-source-pass--disambiguate (host &optional user port) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 747a1152ff..739f502764 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -221,7 +221,6 @@ 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)))))) - port-number-p out) (catch 'done (dolist (host hosts) @@ -230,12 +229,11 @@ erc-compat--auth-source-pass--build-result-many (setq p nil)) (dolist (user (or users (list u))) (dolist (port (or ports (list p))) - (setq port-number-p (equal 'integer (type-of port))) (dolist (e entries) (when-let* ((m (or (gethash e seen) (erc-compat--auth-source-pass--retrieve-parsed - seen e port-number-p))) + seen e (integerp port)))) ((equal host (plist-get m :host))) ((funcall check m :port port)) ((funcall check m :user user)) @@ -249,7 +247,7 @@ erc-compat--auth-source-pass--build-result-many ,@(and secret (not (eq secret t)) (list :secret secret))) out) (when (or (zerop (cl-decf max)) - (null (setq entries (delete e entries)))) + (null (setq entries (remove e entries)))) (throw 'done nil))))))))) (reverse out))) diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 718c7cf4ba..1839801546 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -508,7 +508,7 @@ auth-source-pass-extra-query-keywords--wild-port-miss-netrc (should (equal results '((:host "x.com" :secret "a"))))))) (ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss () - (let ((auth-source-pass-extra-query-keywords 'test)) + (let ((auth-source-pass-extra-query-keywords '--test--)) (auth-source-pass--with-store '(("x.com" (secret . "a")) ("x.com:42" (secret . "b"))) (auth-source-pass-enable) @@ -532,7 +532,7 @@ auth-source-pass-extra-query-keywords--wild-port-hit-netrc (:host "x.com" :port "42" :secret "b"))))))) (ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit () - (let ((auth-source-pass-extra-query-keywords 'test)) + (let ((auth-source-pass-extra-query-keywords '--test--)) (auth-source-pass--with-store '(("x.com" (secret . "a")) ("x.com:42" (secret . "b"))) (auth-source-pass-enable) @@ -555,7 +555,7 @@ auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc (should-not results)))) (ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss () - (let ((auth-source-pass-extra-query-keywords 'test)) + (let ((auth-source-pass-extra-query-keywords '--test--)) (auth-source-pass--with-store '(("x.com" (secret . "a")) ("x.com:42" (secret . "b"))) (auth-source-pass-enable) @@ -582,7 +582,7 @@ auth-source-pass-extra-query-keywords--netrc-akib '((:host "disroot.org" :user "akib" :secret "b"))))))) (ert-deftest auth-source-pass-extra-query-keywords--akib () - (let ((auth-source-pass-extra-query-keywords 'test)) + (let ((auth-source-pass-extra-query-keywords '--test--)) (auth-source-pass--with-store '(("x.com" (secret . "a")) ("akib@disroot.org" (secret . "b")) ("z.com" (secret . "c"))) @@ -590,11 +590,36 @@ auth-source-pass-extra-query-keywords--akib (should (equal (auth-source-search :host "disroot.org" :max 2) '((: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 result (plist-put result :secret (auth-info-password result)))) + (should (equal results '((:host "Libera.Chat" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--host () + (let ((auth-source-pass-extra-query-keywords '--test--)) + (auth-source-pass--with-store '(("libera.chat" (secret . "a")) + ("Libera.Chat" (secret . "b"))) + (auth-source-pass-enable) + (should (equal (auth-source-search :host "Libera.Chat" :max 2) + '((: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 'test)) + (let ((auth-source-pass-extra-query-keywords '--test--)) (auth-source-pass--with-store '(("x.com")) (auth-source-pass-enable) (should-not (auth-source-search :host "x.com"))))) @@ -602,7 +627,7 @@ auth-source-pass-extra-query-keywords--baseline ;; 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 'test)) + (let ((auth-source-pass-extra-query-keywords '--test--)) (auth-source-pass--with-store '(("x.com:42" (secret . "a"))) (auth-source-pass-enable) (should (equal (auth-source-search :host "x.com" :port 42) @@ -618,7 +643,7 @@ auth-source-pass-extra-query-keywords--port-type ;; returned in the order encountered (ert-deftest auth-source-pass-extra-query-keywords--hosts-first () - (let ((auth-source-pass-extra-query-keywords 'test)) + (let ((auth-source-pass-extra-query-keywords '--test--)) (auth-source-pass--with-store '(("x.com:42/bar" (secret . "a")) ("gnu.org" (secret . "b")) ("x.com" (secret . "c")) -- 2.38.1