* Bug in url-get-authentication
@ 2007-12-10 18:40 John Wiegley
0 siblings, 0 replies; only message in thread
From: John Wiegley @ 2007-12-10 18:40 UTC (permalink / raw)
To: bug-gnu-emacs
[-- Attachment #1: Type: text/plain, Size: 867 bytes --]
At the bottom of url-get-authentication, there is a sexp that looks
like this:
(if (and scheme (fboundp scheme))
(funcall scheme url prompt
(and prompt
(funcall scheme url nil nil realm args))
realm args))
What this says is that if the scheme succeeds, the same function is
called again and the user/pass authentication info overwrites whatever
was previously stored. However, if prompt is t, the user gets
prompted _every_ time a page requiring authentication is accessed --
even if they have already successfully authenticated. This is because
there is an (or (and (not retval) prompt) overwrite) sexp inside url-
digest-auth, meaning that overwrite true == show prompt, even if
authentication succeeded on the previous pass.
The solution to this is yet another version of url-digest-auth (which
includes my previous fix):
[-- Attachment #2: url-digest-auth.el --]
[-- Type: application/octet-stream, Size: 2987 bytes --]
(defun url-digest-auth (url &optional prompt overwrite realm args)
"Get the username/password for the specified URL.
If optional argument PROMPT is non-nil, ask for the username/password
to use for the url and its descendants. If optional third argument
OVERWRITE is non-nil, overwrite the old username/password pair if it
is found in the assoc list. If REALM is specified, use that as the realm
instead of hostname:portnum."
(if args
(let* ((href (if (stringp url)
(url-generic-parse-url url)
url))
(server (url-host href))
(port (url-port href))
(path (url-filename href))
user pass byserv retval data)
(setq path (cond
(realm realm)
((string-match "/$" path) path)
(t (url-basepath path)))
server (format "%s:%d" server port)
byserv (cdr-safe (assoc server url-digest-auth-storage)))
(cond
((and prompt (not byserv))
(setq user (read-string (url-auth-user-prompt url realm)
(user-real-login-name))
pass (read-passwd "Password: ")
url-digest-auth-storage
(cons (list server
(cons path
(setq retval
(cons user
(url-digest-auth-create-key
user pass realm
(or url-request-method "GET")
url)))))
url-digest-auth-storage)))
(byserv
(setq retval (cdr-safe (assoc path byserv)))
(if (and (not retval) ; no exact match, check directories
(string-match "/" path)) ; not looking for a realm
(while (and byserv (not retval))
(setq data (car (car byserv)))
(if (or (not (string-match "/" data))
(and
(>= (length path) (length data))
(string= data (substring path 0 (length data)))))
(setq retval (cdr (car byserv))))
(setq byserv (cdr byserv))))
(if overwrite
(if (and (not retval) prompt)
(setq user (read-string (url-auth-user-prompt url realm)
(user-real-login-name))
pass (read-passwd "Password: ")
retval (setq retval
(cons user
(url-digest-auth-create-key
user pass realm
(or url-request-method "GET")
url)))
byserv (assoc server url-digest-auth-storage))
(setcdr byserv
(cons (cons path retval) (cdr byserv))))))
(t (setq retval nil)))
(if retval
(if (cdr-safe (assoc "opaque" args))
(let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven"))
(opaque (cdr-safe (assoc "opaque" args))))
(format
(concat "Digest username=\"%s\", realm=\"%s\","
"nonce=\"%s\", uri=\"%s\","
"response=\"%s\", opaque=\"%s\"")
(nth 0 retval) realm nonce (url-filename href)
(md5 (concat (nth 1 retval) ":" nonce ":"
(nth 2 retval))) opaque))
(let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven")))
(format
(concat "Digest username=\"%s\", realm=\"%s\","
"nonce=\"%s\", uri=\"%s\","
"response=\"%s\"")
(nth 0 retval) realm nonce (url-filename href)
(md5 (concat (nth 1 retval) ":" nonce ":"
(nth 2 retval))))))))))
[-- Attachment #3: Type: text/plain, Size: 1 bytes --]
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2007-12-10 18:40 UTC | newest]
Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2007-12-10 18:40 Bug in url-get-authentication John Wiegley
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).