Bug in url-get-authentication

Bug in url-get-authentication

[John Wiegley]

[-- 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 --]