changeset 73836:8368b321b13d

(url-http-handle-authentication): If there are several authentication headers, use the strongest available method.
author Magnus Henoch <mange@freemail.hu>
date Wed, 08 Nov 2006 20:34:36 +0000
parents caf324c6806f
children 28bd4e5c228d
files lisp/url/url-http.el
diffstat 1 files changed, 17 insertions(+), 11 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/url/url-http.el	Wed Nov 08 19:38:38 2006 +0000
+++ b/lisp/url/url-http.el	Wed Nov 08 20:34:36 2006 +0000
@@ -313,21 +313,27 @@
 	(type nil)
 	(url (url-recreate-url url-current-object))
 	(url-basic-auth-storage 'url-http-real-basic-auth-storage)
-	auth)
+	auth
+	(strength 0))
     ;; Cheating, but who cares? :)
     (if proxy
 	(setq url-basic-auth-storage 'url-http-proxy-basic-auth-storage))
 
-    ;; find first supported auth
-    (while auths
-      (setq auth (url-eat-trailing-space (url-strip-leading-spaces (car auths))))
-      (if (string-match "[ \t]" auth)
-	  (setq type (downcase (substring auth 0 (match-beginning 0))))
-	(setq type (downcase auth)))
-      (if (url-auth-registered type)
-	  (setq auths nil)		; no more check
-	(setq auth nil
-	      auths (cdr auths))))
+    ;; find strongest supported auth
+    (dolist (this-auth auths)
+      (setq this-auth (url-eat-trailing-space 
+		       (url-strip-leading-spaces 
+			this-auth)))
+      (let* ((this-type 
+	      (if (string-match "[ \t]" this-auth)
+		  (downcase (substring this-auth 0 (match-beginning 0)))
+		(downcase this-auth)))
+	     (registered (url-auth-registered this-type))
+	     (this-strength (cddr registered)))
+	(when (and registered (> this-strength strength))
+	  (setq auth this-auth
+		type this-type
+		strength this-strength))))
 
     (if (not (url-auth-registered type))
 	(progn