Re: bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends
"J.P." <[email protected]>
| Newsgroups | gmane.emacs.erc.general |
|---|---|
| Message-ID | <[email protected]> |
"J.P." <[email protected]> writes: > Because I am easily swayed (or maybe just a liar), I've gone ahead and > enabled it by default [1]. I've also informed Nicolas Petton of the > change. I guess Björn was too busy or annoyed by my pestering to keep > up, which is understandable. > > Thanks, everyone, for your help with this (especially Akib, who I pray > will consider contributing to ERC in the future). And please remember to > complain if you encounter any related ugliness. In the meantime, I am > closing this bug. A couple updates for anyone who cares: 1. As you may have noticed, due to various complaints here on the tracker, the new option `auth-source-pass-extra-query-keywords' is now disabled by default. 2. The changes currently installed contain a bug involving spaces in file names. Basically, all other back ends allow spaces in an entry's user and host fields. The second (throwaway) patch below demonstrates this, and the first attempts to make things right. In my mind, item #2 is a bug that needs fixing on the release branch, and I plan on doing so in the coming days. If there are questions or concerns, please let them be known. Thanks.
0001-Allow-spaces-in-auth-source-pass-match-regexp.patch
(text/x-patch, 6.7 KB)
From 85f00ef178b59573f91f0389f67c69585742a6e2 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Thu, 24 Nov 2022 21:03:03 -0800 Subject: [PATCH 1/2] Allow spaces in auth-source-pass--match-regexp * lisp/auth-source-pass.el (auth-source-pass--match-regexp): Allow spaces in host and user components because all other backends do. * lisp/erc/erc-compat.el (erc-compat--29-auth-source-pass--retrieve-parsed): Allow spaces in host and user components in auth-source-pass regexp. * test/lisp/auth-source-pass-tests.el (auth-source-pass-any-host): Silence warning message re wildcards from `auth-source-pass-search'. (auth-source-pass-extra-query-keywords--suffixed-user): Add spaces to users and hosts of some entries. (Bug#58985.) --- lisp/auth-source-pass.el | 12 +++++------ lisp/erc/erc-compat.el | 8 ++++---- test/lisp/auth-source-pass-tests.el | 31 +++++++++++++++-------------- 3 files changed, 26 insertions(+), 25 deletions(-) diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 74d3808448..3262880c47 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -111,12 +111,12 @@ auth-source-pass--match-regexp (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))))))) + (or (: (? (group-n 20 (+ (not (in ?/ ,s)))) "@") ; user pfx + (group-n 10 (+ (not (in ?/ ?@ ,s)))) ; host + (? ,s (group-n 30 (+ (not (in ?\s ?/ ,s)))))) ; port + (: (group-n 11 (+ (not (in ?/ ?@ ,s)))) ; host + (? ,s (group-n 31 (+ (not (in ?\s ?/ ,s))))) ; port + (? "/" (group-n 21 (+ (not (in ?/ ,s))))))) ; user sfx eot) 'no-group)) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index abbaafcd93..bd93254758 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -176,12 +176,12 @@ auth-source-backend-parser-functions ;; This hard codes `auth-source-pass-port-separator' to ":" (defun erc-compat--29-auth-source-pass--retrieve-parsed (seen e port-number-p) (when (string-match (rx (or bot "/") - (or (: (? (group-n 20 (+ (not (in " /:")))) "@") - (group-n 10 (+ (not (in " /:@")))) + (or (: (? (group-n 20 (+ (not (in "/:")))) "@") + (group-n 10 (+ (not (in "/:@")))) (? ":" (group-n 30 (+ (not (in " /:")))))) - (: (group-n 11 (+ (not (in " /:@")))) + (: (group-n 11 (+ (not (in "/:@")))) (? ":" (group-n 31 (+ (not (in " /:"))))) - (? "/" (group-n 21 (+ (not (in " /:"))))))) + (? "/" (group-n 21 (+ (not (in "/:"))))))) eot) e) (puthash e `( :host ,(or (match-string 10 e) (match-string 11 e)) diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 1107e09b51..d6d42ce942 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -175,7 +175,8 @@ auth-source-pass-match-any-entry-p (ert-deftest auth-source-pass-any-host () (auth-source-pass--with-store '(("foo" ("port" . "foo-port") ("host" . "foo-user")) ("bar")) - (should-not (auth-source-pass-search :host t)))) + (let ((inhibit-message t)) ; silence "... does not handle host wildcards." + (should-not (auth-source-pass-search :host t))))) (ert-deftest auth-source-pass-undefined-host () (auth-source-pass--with-store '(("foo" ("port" . "foo-port") ("host" . "foo-user")) @@ -697,29 +698,29 @@ auth-source-pass-extra-query-keywords--ambiguous-user-host ;; 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/b@r" (secret . "a")) - ("b@[email protected]" (secret . "b")) + (let ((store (sort (copy-sequence '(("x.com:42/s p@m" (secret . "a")) + ("s p@[email protected]" (secret . "b")) ("x.com" (secret . "?")) - ("b@[email protected]" (secret . "c")) - ("fake.com" (secret . "?")) - ("fake.com/b@r" (secret . "d")) - ("y.org/b@r" (secret . "?")) - ("b@[email protected]" (secret . "e")))) + ("s p@[email protected]" (secret . "c")) + ("fa ke" (secret . "?")) + ("fa ke/s p@m" (secret . "d")) + ("y.org/s p@m" (secret . "?")) + ("s p@m@fa ke" (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 "b@r" + (results (auth-source-search :host '("x.com" "fa ke" "y.org") + :user "s p@m" :require '(:user) :max 5))) (dolist (result results) (setf (plist-get result :secret) (auth-info-password result))) (should (equal results - '((:host "x.com" :user "b@r" :secret "b") - (:host "x.com" :user "b@r" :port "42" :secret "a") - (:host "fake.com" :user "b@r" :secret "e") - (:host "fake.com" :user "b@r" :secret "d") - (:host "y.org" :user "b@r" :secret "c")))))))) + '((:host "x.com" :user "s p@m" :secret "b") + (:host "x.com" :user "s p@m" :port "42" :secret "a") + (:host "fa ke" :user "s p@m" :secret "e") + (:host "fa ke" :user "s p@m" :secret "d") + (:host "y.org" :user "s p@m" :secret "c")))))))) ;; This is a more distilled version of `suffixed-user', above. It ;; better illustrates that search order takes precedence over "/user" -- 2.38.1
0002-POC-Demo-spaces-in-hosts-users-among-auth-source-bac.patch
(text/x-patch, 11.4 KB)
From c379523c177ea0188f8c270585efc6077901479a Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Thu, 24 Nov 2022 21:03:03 -0800 Subject: [PATCH 2/2] [POC] Demo spaces in hosts/users among auth-source backends --- test/lisp/auth-source-pass-tests.el | 255 ++++++++++++++++++++++++++++ 1 file changed, 255 insertions(+) diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index d6d42ce942..59a0c1252f 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -752,6 +752,261 @@ auth-source-pass-extra-query-keywords--user-priorities (:host "g" :user "u" :port 2 :secret "@") ; ** (:host "g" :user "u" :port 2 :secret "/")))))))) +;;;; Whitespace demo + +;; These demonstrate that all back ends support spaces in host and +;; user fields. + +;; netrc + +(ert-deftest auth-source-pass-extra-query-keywords--ws-host-netrc () + (ert-with-temp-file netrc-file + :text "\ +machine \"hello world\" password a +machine localhost password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "hello world"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "hello world" :secret "a"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--ws-user-netrc () + (ert-with-temp-file netrc-file + :text "\ +machine localhost login onetwo password a +machine localhost login \"one two\" password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :user "one two"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '(( :host "localhost" + :user "one two" + :secret "b"))))))) + +;; plstore + +(require 'epg) + +(ert-deftest auth-source-pass-extra-query-keywords--ws-host-plstore () + (ert-with-temp-file plstore-file + :suffix ".plist" + :text "\ +;;; public entries -*- mode: plstore -*- +((\"8faf07aac16e46c49857598b6cd6dd809762c5cb\" + :secret-secret t :host \"hello world\") + (\"12d4700ff04a5dbadec60b55319ff3f473d026fa\" + :secret-secret t :host \"localhost\")) +;;; secret entries +((\"8faf07aac16e46c49857598b6cd6dd809762c5cb\" :secret \"a\") + (\"12d4700ff04a5dbadec60b55319ff3f473d026fa\" :secret \"b\")) +" + (cl-letf (((symbol-function 'epg-decrypt-string) + (lambda (&rest r) (prin1-to-string (cadr r)))) + ((symbol-function 'epg-find-configuration) + (lambda (&rest _) '((program . "/bin/true"))))) + (let* ((auth-sources (list plstore-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "hello world"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '(( :login nil + :port nil + :secret "a" + :host "hello world")))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--ws-user-plstore () + (ert-with-temp-file plstore-file + :suffix ".plist" + :text "\ +;;; public entries -*- mode: plstore -*- +((\"8b23ccce4b95bee4b9a8676409a7f196f1adc59e\" + :secret-secret t + :host \"localhost\" + :user \"onetwo\") + (\"e4c4fcb6c505d389ff72a58314571f37fb936365\" + :secret-secret t + :host \"localhost\" + :user \"one two\")) +;;; secret entries +((\"8b23ccce4b95bee4b9a8676409a7f196f1adc59e\" :secret \"a\") + (\"e4c4fcb6c505d389ff72a58314571f37fb936365\" :secret \"b\")) +" + (cl-letf (((symbol-function 'epg-decrypt-string) + (lambda (&rest r) (prin1-to-string (cadr r)))) + ((symbol-function 'epg-find-configuration) + (lambda (&rest _) '((program . "/bin/true"))))) + (let* ((auth-sources (list plstore-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "localhost" + :user "one two"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '(( :login nil + :port nil + :secret "b" + :host "localhost" + :user "one two")))))))) + +;; json + +(ert-deftest auth-source-pass-extra-query-keywords--ws-host-json () + (ert-with-temp-file json-store + :suffix ".json" + :text "\ +[{\"host\":\"hello world\",\"secret\":\"a\"}, + {\"host\":\"localhost\",\"secret\":\"b\"}] +" + (let* ((auth-sources (list json-store)) + (auth-source-do-cache nil) + (results (auth-source-search :host "hello world"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '(( :host "hello world" + :secret "a"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--ws-user-json () + (ert-with-temp-file json-store + :suffix ".json" + :text "\ +[{\"host\":\"localhost\", + \"user\":\"onetwo\", + \"secret\":\"a\"}, + {\"host\":\"localhost\", + \"user\":\"one two\", + \"secret\":\"b\"}] +" + (let* ((auth-sources (list json-store)) + (auth-source-do-cache nil) + (results (auth-source-search :host "localhost" :user "one two"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '(( :host "localhost" + :user "one two" + :secret "b"))))))) + +;; secrets + +(require 'secrets) + +(ert-deftest auth-source-pass-extra-query-keywords--ws-host-secrets () + (let ((auth-sources '("secrets:Test")) + (auth-source-do-cache nil) + (entries '(("nil@hello world:nil" + (:host . "hello world") + (:xdg:schema . "org.freedesktop.Secret.Generic")) + ("nil@localhost:nil" + (:host . "localhost") + (:xdg:schema . "org.freedesktop.Secret.Generic")))) + (secrets '(("nil@hello world:nil" . "a") + ("nil@localhost:nil" . "b")))) + + (cl-letf (((symbol-function 'secrets-search-items) + (lambda (_ &rest r) + (mapcan (lambda (s) + (and (seq-every-p (pcase-lambda (`(,k . ,v)) + (equal v (alist-get k (cdr s)))) + (map-pairs r)) + (list (car s)))) + entries))) + ((symbol-function 'secrets-get-secret) + (lambda (_ label) (assoc-default label secrets))) + ((symbol-function 'secrets-get-attributes) + (lambda (_ label) (assoc-default label entries)))) + + (let ((results (auth-source-search :host "hello world"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '(( :login nil + :port nil + :secret "a" + :host "hello world" + :xdg:schema "org.freedesktop.Secret.Generic")))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--secrets-joao-user () + (let ((auth-sources '("secrets:Test")) + (auth-source-do-cache nil) + (entries '(("onetwo@localhost:nil" + (:host . "localhost") + (:user . "onetwo") + (:xdg:schema . "org.freedesktop.Secret.Generic")) + ("one two@localhost:nil" + (:host . "localhost") + (:user . "one two") + (:xdg:schema . "org.freedesktop.Secret.Generic")))) + (secrets '(("onetwo@localhost:nil" . "a") + ("one two@localhost:nil" . "b")))) + + (cl-letf (((symbol-function 'secrets-search-items) + (lambda (_ &rest r) + (mapcan (lambda (s) + (and (seq-every-p (pcase-lambda (`(,k . ,v)) + (equal v (alist-get k (cdr s)))) + (map-pairs r)) + (list (car s)))) + entries))) + ((symbol-function 'secrets-get-secret) + (lambda (_ label) (assoc-default label secrets))) + ((symbol-function 'secrets-get-attributes) + (lambda (_ label) (assoc-default label entries)))) + + (let ((results (auth-source-search :host "localhost" :user "one two"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '(( :login nil + :port nil + :secret "b" + :host "localhost" + :user "one two" + :xdg:schema "org.freedesktop.Secret.Generic")))))))) + +;; Pass + +(ert-deftest auth-source-pass-extra-query-keywords--ws-host-pass () + (auth-source-pass--with-store '(("hello world:80" (secret . "a")) + ("localhost:80" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "hello world"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '(( :host "hello world" + :port "80" + :secret "a"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--ws-user-pass () + ;; "suffix" syntax + (auth-source-pass--with-store '(("localhost:80/onetwo" (secret . "a")) + ("localhost:80/one two" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "localhost" :user "one two"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '(( :host "localhost" + :user "one two" + :port "80" + :secret "b")))))) + ;; "prefix" syntax + (auth-source-pass--with-store '(("onetwo@localhost:80" (secret . "a")) + ("one two@localhost:80" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "localhost" :user "one two"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '(( :host "localhost" + :user "one two" + :port "80" + :secret "b"))))))) + (provide 'auth-source-pass-tests) ;;; auth-source-pass-tests.el ends here -- 2.38.1