(url-http-handle-authentication): If there are several authentication

headers, use the strongest available method.

diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 2f03b9e9d67d39177ad6182e16429f2633483bc1..78b2366431c4bd5bbc8cec111e5840f1425345c4 100644 (file)
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,5 +1,9 @@
 2006-11-08  Magnus Henoch  <mange@freemail.hu>
 
+       * url-http.el (url-http-handle-authentication): If there are
+       several authentication headers, use the strongest available
+       method.
+
        * url.el (url-retrieve-synchronously): Allow quitting when
        inhibit-quit is t.
 

diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index c0bc2d9739e2e7f434e7afdcf1fbfed13b44e36b..68c54c249f5b684bca731873af80a8e586719078 100644 (file)
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -313,21 +313,27 @@ This allows us to use `mail-fetch-field', etc."
        (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