mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-05 22:20:24 -08:00
Code Issues Projects Releases Wiki Activity

Lookup cached basic-auth credentials with the correct key

Browse source 
Credentials cached in 'url-basic-auth-storage' are keyed by
"server:port", but were being looked up by just "server" in
'url-basic-auth'.
* lisp/url/url-auth.el (url-basic-auth): Lookup cached basic auth
credentials by "server:port".  (Bug#79486)

* test/lisp/url/url-auth-tests.el (url-auth-test-auth-retrieve-cache):
Check the digest auth test-cases cache retrieval test cases against the
basic auth logic.
This commit is contained in:
Steven Allen 2025-09-21 12:36:33 -07:00 • committed by Eli Zaretskii
parent 19ee128845
commit 5d11ee9f54
2 changed files with 29 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

9
lisp/url/url-auth.el
View file

@ -71,13 +71,14 @@ instead of the filename inheritance method."
(user (url-user href)) (user (url-user href))
(pass (url-password href)) (pass (url-password href))
(enable-recursive-minibuffers t) ; for url-handler-mode (bug#10298) (enable-recursive-minibuffers t) ; for url-handler-mode (bug#10298)
(serverport (format "%s:%d" server port))
byserv retval data) byserv retval data)
(setq file (cond (setq file (cond
(realm realm) (realm realm)
((string= "" file) "/") ((string= "" file) "/")
((string-match "/$" file) file) ((string-match "/$" file) file)
(t (url-file-directory file))) (t (url-file-directory file)))
byserv (cdr-safe (assoc server byserv (cdr-safe (assoc serverport
(symbol-value url-basic-auth-storage)))) (symbol-value url-basic-auth-storage))))
(cond (cond
((and user pass) ((and user pass)
@ -93,9 +94,8 @@ instead of the filename inheritance method."
(url-do-auth-source-search server type :secret user) (url-do-auth-source-search server type :secret user)
(and (url-interactive-p) (and (url-interactive-p)
(read-passwd "Password: " nil (or pass ""))))) (read-passwd "Password: " nil (or pass "")))))
(setq server (format "%s:%d" server port))
(set url-basic-auth-storage (set url-basic-auth-storage
(cons (list server (cons (list serverport
(cons file (cons file
(setq retval (setq retval
(base64-encode-string (base64-encode-string
@ -129,9 +129,8 @@ instead of the filename inheritance method."
(url-do-auth-source-search server type :secret user) (url-do-auth-source-search server type :secret user)
(and (url-interactive-p) (and (url-interactive-p)
(read-passwd "Password: "))) (read-passwd "Password: ")))
server (format "%s:%d" server port)
retval (base64-encode-string (format "%s:%s" user pass) t) retval (base64-encode-string (format "%s:%s" user pass) t)
byserv (assoc server (symbol-value url-basic-auth-storage))) byserv (assoc serverport (symbol-value url-basic-auth-storage)))
(setcdr byserv (setcdr byserv
(cons (cons file retval) (cdr byserv)))))) (cons (cons file retval) (cdr byserv))))))
(t (setq retval nil))) (t (setq retval nil)))

27
test/lisp/url/url-auth-tests.el
View file

@ -27,6 +27,7 @@
(require 'ert) (require 'ert)
(require 'url-auth) (require 'url-auth)
(require 'url-http)
(defvar url-auth-test-challenges nil (defvar url-auth-test-challenges nil
"List of challenges for testing. "List of challenges for testing.
@ -133,8 +134,8 @@ server's WWW-Authenticate header field.")
(should (string= (nth 1 key) (plist-get challenge :expected-ha2))) (should (string= (nth 1 key) (plist-get challenge :expected-ha2)))
))) )))
(ert-deftest url-auth-test-digest-auth-retrieve-cache () (ert-deftest url-auth-test-auth-retrieve-cache ()
"Check how the entry point retrieves cached authentication. "Check how the basic/digest auth entry point retrieves cached authentication.
Essential is how realms and paths are matched." Essential is how realms and paths are matched."
(let* ((url-digest-auth-storage (let* ((url-digest-auth-storage
@ -150,6 +151,14 @@ Essential is how realms and paths are matched."
("rootless.org:80" ; no "/" entry for this on purpose ("rootless.org:80" ; no "/" entry for this on purpose
("/path" "pathuser" "key") ("/path" "pathuser" "key")
("realm" "realmuser" "key")))) ("realm" "realmuser" "key"))))
(url-http-real-basic-auth-storage
(mapcar (pcase-lambda (`(,server . ,auths))
(cons server
(mapcar (pcase-lambda (`(,realm ,user ,secret))
(cons realm (base64-encode-string
(format "%s:%s" user secret) t)))
auths)))
url-digest-auth-storage))
(attrs (list (cons "nonce" "servernonce"))) (attrs (list (cons "nonce" "servernonce")))
auth) auth)
@ -215,6 +224,7 @@ Essential is how realms and paths are matched."
(list :url "http://rootless.org/path/query?q=a" (list :url "http://rootless.org/path/query?q=a"
:realm "realm" :expected-user "realmuser") :realm "realm" :expected-user "realmuser")
)) ))
;; Check digest auth.
(setq auth (url-digest-auth (plist-get row :url) (setq auth (url-digest-auth (plist-get row :url)
nil nil nil nil
(plist-get row :realm) attrs)) (plist-get row :realm) attrs))
@ -223,6 +233,19 @@ Essential is how realms and paths are matched."
(should (string-match ".*username=\"\\(.*?\\)\".*" auth)) (should (string-match ".*username=\"\\(.*?\\)\".*" auth))
(should (string= (match-string 1 auth) (should (string= (match-string 1 auth)
(plist-get row :expected-user)))) (plist-get row :expected-user))))
(should-not auth))
;; Check basic auth.
(setq auth (url-basic-auth (plist-get row :url)
nil nil
(plist-get row :realm) attrs))
(if (plist-get row :expected-user)
(progn (should auth)
(should (string-prefix-p "Basic " auth))
(setq auth (base64-decode-string
(string-remove-prefix "Basic " auth) t))
(should (string-match "\\`\\(.*?\\):key\\'" auth))
(should (string= (match-string 1 auth)
(plist-get row :expected-user))))
(should-not auth))))) (should-not auth)))))
(ert-deftest url-auth-test-digest-auth () (ert-deftest url-auth-test-digest-auth ()