mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-22 07:09:54 +00:00
Code Issues Releases Activity

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

Browse Source 
headers, use the first with a supported method.
This commit is contained in:
Magnus Henoch 2006-11-02 23:06:20 +00:00
parent 1a858672d8
commit 8917392a52
2 changed files with 22 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lisp/url/ChangeLog
View File

@ -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

24
lisp/url/url-http.el
View File

@ -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