From 8917392a520c6790e51c0febc084738c7db29d62 Mon Sep 17 00:00:00 2001 From: Magnus Henoch Date: Thu, 2 Nov 2006 23:06:20 +0000 Subject: [PATCH] (url-http-handle-authentication): If there are several authentication headers, use the first with a supported method. --- lisp/url/ChangeLog | 6 ++++++ lisp/url/url-http.el | 24 ++++++++++++++++-------- 2 files changed, 22 insertions(+), 8 deletions(-) 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 (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 * 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