From 385b64c52a7ef3b1460463e285a44b70e5f11c26 Mon Sep 17 00:00:00 2001 From: Magnus Henoch Date: Wed, 8 Nov 2006 20:34:47 +0000 Subject: [PATCH] (url-http-handle-authentication): If there are several authentication headers, use the strongest available method. --- lisp/url/ChangeLog | 4 ++++ lisp/url/url-http.el | 28 +++++++++++++++++----------- 2 files changed, 21 insertions(+), 11 deletions(-) diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 2f03b9e9d67..78b2366431c 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,5 +1,9 @@ 2006-11-08 Magnus Henoch + * 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 c0bc2d9739e..68c54c249f5 100644 --- 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 -- 2.39.5