Respect some spaces in auth-source-pass--match-regexp

* lisp/auth-source-pass.el (auth-source-pass--match-regexp): Allow an
entry's host and user fields to contain spaces, just like other
backends do.
* lisp/erc/erc-compat.el
(erc-compat--29-auth-source-pass--retrieve-parsed): Change regexp to
allow spaces in host and user components of file names.
* test/lisp/auth-source-pass-tests.el (auth-source-pass-any-host):
Silence warning message re wildcards emitted by
`auth-source-pass-search'.
(auth-source-pass-extra-query-keywords--suffixed-user): Add spaces
to users and hosts of some example entries.  (Bug#58985.)
This commit is contained in:
F. Jason Park 2022-11-24 21:03:03 -08:00
parent acd462b030
commit dcf69a1da4
3 changed files with 26 additions and 25 deletions

View file

@ -111,12 +111,12 @@ HOSTS can be a string or a list of strings."
(defun auth-source-pass--match-regexp (s) (defun auth-source-pass--match-regexp (s)
(rx-to-string ; autoloaded (rx-to-string ; autoloaded
`(: (or bot "/") `(: (or bot "/")
(or (: (? (group-n 20 (+ (not (in ?\ ?/ ,s)))) "@") (or (: (? (group-n 20 (+ (not (in ?/ ,s)))) "@") ; user prefix
(group-n 10 (+ (not (in ?\ ?/ ?@ ,s)))) (group-n 10 (+ (not (in ?/ ?@ ,s)))) ; host
(? ,s (group-n 30 (+ (not (in ?\ ?/ ,s)))))) (? ,s (group-n 30 (+ (not (in ?\s ?/ ,s)))))) ; port
(: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s)))) (: (group-n 11 (+ (not (in ?/ ?@ ,s)))) ; host
(? ,s (group-n 31 (+ (not (in ?\ ?/ ,s))))) (? ,s (group-n 31 (+ (not (in ?\s ?/ ,s))))) ; port
(? "/" (group-n 21 (+ (not (in ?\ ?/ ,s))))))) (? "/" (group-n 21 (+ (not (in ?/ ,s))))))) ; user suffix
eot) eot)
'no-group)) 'no-group))

View file

@ -176,12 +176,12 @@ If START or END is negative, it counts from the end."
;; This hard codes `auth-source-pass-port-separator' to ":" ;; This hard codes `auth-source-pass-port-separator' to ":"
(defun erc-compat--29-auth-source-pass--retrieve-parsed (seen e port-number-p) (defun erc-compat--29-auth-source-pass--retrieve-parsed (seen e port-number-p)
(when (string-match (rx (or bot "/") (when (string-match (rx (or bot "/")
(or (: (? (group-n 20 (+ (not (in " /:")))) "@") (or (: (? (group-n 20 (+ (not (in "/:")))) "@")
(group-n 10 (+ (not (in " /:@")))) (group-n 10 (+ (not (in "/:@"))))
(? ":" (group-n 30 (+ (not (in " /:")))))) (? ":" (group-n 30 (+ (not (in " /:"))))))
(: (group-n 11 (+ (not (in " /:@")))) (: (group-n 11 (+ (not (in "/:@"))))
(? ":" (group-n 31 (+ (not (in " /:"))))) (? ":" (group-n 31 (+ (not (in " /:")))))
(? "/" (group-n 21 (+ (not (in " /:"))))))) (? "/" (group-n 21 (+ (not (in "/:")))))))
eot) eot)
e) e)
(puthash e `( :host ,(or (match-string 10 e) (match-string 11 e)) (puthash e `( :host ,(or (match-string 10 e) (match-string 11 e))

View file

@ -175,7 +175,8 @@ HOSTNAME, USER and PORT are passed unchanged to
(ert-deftest auth-source-pass-any-host () (ert-deftest auth-source-pass-any-host ()
(auth-source-pass--with-store '(("foo" ("port" . "foo-port") ("host" . "foo-user")) (auth-source-pass--with-store '(("foo" ("port" . "foo-port") ("host" . "foo-user"))
("bar")) ("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 () (ert-deftest auth-source-pass-undefined-host ()
(auth-source-pass--with-store '(("foo" ("port" . "foo-port") ("host" . "foo-user")) (auth-source-pass--with-store '(("foo" ("port" . "foo-port") ("host" . "foo-user"))
@ -697,29 +698,29 @@ machine Libera.Chat password b
;; with slightly more realistic and less legible values. ;; with slightly more realistic and less legible values.
(ert-deftest auth-source-pass-extra-query-keywords--suffixed-user () (ert-deftest auth-source-pass-extra-query-keywords--suffixed-user ()
(let ((store (sort (copy-sequence '(("x.com:42/b@r" (secret . "a")) (let ((store (sort (copy-sequence '(("x.com:42/s p@m" (secret . "a"))
("b@r@x.com" (secret . "b")) ("s p@m@x.com" (secret . "b"))
("x.com" (secret . "?")) ("x.com" (secret . "?"))
("b@r@y.org" (secret . "c")) ("s p@m@y.org" (secret . "c"))
("fake.com" (secret . "?")) ("fa ke" (secret . "?"))
("fake.com/b@r" (secret . "d")) ("fa ke/s p@m" (secret . "d"))
("y.org/b@r" (secret . "?")) ("y.org/s p@m" (secret . "?"))
("b@r@fake.com" (secret . "e")))) ("s p@m@fa ke" (secret . "e"))))
(lambda (&rest _) (zerop (random 2)))))) (lambda (&rest _) (zerop (random 2))))))
(auth-source-pass--with-store store (auth-source-pass--with-store store
(auth-source-pass-enable) (auth-source-pass-enable)
(let* ((auth-source-pass-extra-query-keywords t) (let* ((auth-source-pass-extra-query-keywords t)
(results (auth-source-search :host '("x.com" "fake.com" "y.org") (results (auth-source-search :host '("x.com" "fa ke" "y.org")
:user "b@r" :user "s p@m"
:require '(:user) :max 5))) :require '(:user) :max 5)))
(dolist (result results) (dolist (result results)
(setf (plist-get result :secret) (auth-info-password result))) (setf (plist-get result :secret) (auth-info-password result)))
(should (equal results (should (equal results
'((:host "x.com" :user "b@r" :secret "b") '((:host "x.com" :user "s p@m" :secret "b")
(:host "x.com" :user "b@r" :port "42" :secret "a") (:host "x.com" :user "s p@m" :port "42" :secret "a")
(:host "fake.com" :user "b@r" :secret "e") (:host "fa ke" :user "s p@m" :secret "e")
(:host "fake.com" :user "b@r" :secret "d") (:host "fa ke" :user "s p@m" :secret "d")
(:host "y.org" :user "b@r" :secret "c")))))))) (:host "y.org" :user "s p@m" :secret "c"))))))))
;; This is a more distilled version of `suffixed-user', above. It ;; This is a more distilled version of `suffixed-user', above. It
;; better illustrates that search order takes precedence over "/user" ;; better illustrates that search order takes precedence over "/user"