From: Magnus Henoch <mange@freemail.hu>
Date: Thu, 2 Nov 2006 23:06:20 +0000 (+0000)
Subject: (url-http-handle-authentication): If there are several authentication
X-Git-Tag: emacs-pretest-22.0.91~395
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=8917392a520c6790e51c0febc084738c7db29d62;p=emacs.git

(url-http-handle-authentication): If there are several authentication
headers, use the first with a supported method.
---

diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 1d4c4aa24fc..678e7e5a8db 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,9 @@
+2006-11-03  Shun-ichi GOTO  <gotoh@taiyo.co.jp> (tiny change)
+
+	* url-http.el (url-http-handle-authentication): If there are
+	several authentication headers, use the first with a supported
+	method.
+
 2006-11-01  Magnus Henoch  <mange@freemail.hu>
 
 	* url-http.el (url-http-create-request): Use buffer-local
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 6b6ec7d6b22..c0bc2d9739e 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -305,21 +305,29 @@ This allows us to use `mail-fetch-field', etc."
   (declare (special status success url-http-method url-http-data
 		    url-callback-function url-callback-arguments))
   (url-http-debug "Handling %s authentication" (if proxy "proxy" "normal"))
-  (let ((auth (or (mail-fetch-field (if proxy "proxy-authenticate" "www-authenticate"))
-		  "basic"))
+  (let ((auths (or (nreverse
+		    (mail-fetch-field
+		     (if proxy "proxy-authenticate" "www-authenticate")
+		     nil nil t))
+		  '("basic")))
 	(type nil)
 	(url (url-recreate-url url-current-object))
 	(url-basic-auth-storage 'url-http-real-basic-auth-storage)
-	)
-
+	auth)
     ;; Cheating, but who cares? :)
     (if proxy
 	(setq url-basic-auth-storage 'url-http-proxy-basic-auth-storage))
 
-    (setq auth (url-eat-trailing-space (url-strip-leading-spaces auth)))
-    (if (string-match "[ \t]" auth)
-	(setq type (downcase (substring auth 0 (match-beginning 0))))
-      (setq type (downcase auth)))
+    ;; 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))))
 
     (if (not (url-auth-registered type))
 	(progn