RFCs 2616 and 2617 imply that a page may be accessible using one of a
choice of authentication styles, indicated by multiple WWW-Authenticate
headers, or by multiple styles described in a single such header.
LWP::UserAgent v1.69 (from libwww-5.47) appears to be unaware of this
in its implementation of the request() method.
A full fix is difficult, since it requires much more careful parsing
of the individual WWW-Authenticate header lines as well as a mechanism
for choosing between the different authentication styles available. The
attached patch is a simplistic partial fix, recognising only the
possibility of multiple headers each describing a single authentication
style, and expecting to be able to use the first such style that it
actually understands. This was enough to get me past my own immediate
problem accessing an NT server that returns:
WWW-Authenticate: NTLM
WWW-Authenticate: Basic realm="some.domain.com"
.. using a simple `lwp-request <URL>`.
(There is no list archive mentioned in the README, nor on www.perl.com;
I did find an archive on www.egroups.com, and a FAQ, in which no mention
was made of this problem. If there is a better archive somewhere, it
would be useful to know it, and perhaps to mention it in the README.)
Hugo
--- lib/LWP/UserAgent.pm Thu Nov 4 20:21:01 1999
+++ /opt/perl-5.6.0.64bit/lib/site_perl/5.6.0/LWP/UserAgent.pm Mon Mar 27 14:42:20
+2000
@@ -296,48 +296,51 @@
{
my $proxy = ($code == &HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED);
my $ch_header = $proxy ? "Proxy-Authenticate" : "WWW-Authenticate";
- my $challenge = $response->header($ch_header);
- unless (defined $challenge) {
+ my @challenge = $response->header($ch_header);
+ unless (@challenge) {
$response->header("Client-Warning" =>
"Missing Authenticate header");
return $response;
}
require HTTP::Headers::Util;
- $challenge =~ tr/,/;/; # "," is used to separate auth-params!!
- ($challenge) = HTTP::Headers::Util::split_header_words($challenge);
- my $scheme = lc(shift(@$challenge));
- shift(@$challenge); # no value
- $challenge = { @$challenge }; # make rest into a hash
- for (keys %$challenge) { # make sure all keys are lower case
- $challenge->{lc $_} = delete $challenge->{$_};
- }
+ CHALLENGE: for my $challenge (@challenge) {
+ $challenge =~ tr/,/;/; # "," is used to separate auth-params!!
+ ($challenge) = HTTP::Headers::Util::split_header_words($challenge);
+ my $scheme = lc(shift(@$challenge));
+ shift(@$challenge); # no value
+ $challenge = { @$challenge }; # make rest into a hash
+ for (keys %$challenge) { # make sure all keys are lower case
+ $challenge->{lc $_} = delete $challenge->{$_};
+ }
- unless ($scheme =~ /^([a-z]+(?:-[a-z]+)*)$/) {
- $response->header("Client-Warning" =>
- "Bad authentication scheme '$scheme'");
- return $response;
- }
- $scheme = $1; # untainted now
- my $class = "LWP::Authen::\u$scheme";
- $class =~ s/-/_/g;
+ unless ($scheme =~ /^([a-z]+(?:-[a-z]+)*)$/) {
+ $response->header("Client-Warning" =>
+ "Bad authentication scheme '$scheme'");
+ return $response;
+ }
+ $scheme = $1; # untainted now
+ my $class = "LWP::Authen::\u$scheme";
+ $class =~ s/-/_/g;
- no strict 'refs';
- unless (%{"$class\::"}) {
- # try to load it
- eval "require $class";
- if ($@) {
- if ($@ =~ /^Can\'t locate/) {
- $response->header("Client-Warning" =>
- "Unsupported authentication scheme '$scheme'");
- } else {
- $response->header("Client-Warning" => $@);
+ no strict 'refs';
+ unless (%{"$class\::"}) {
+ # try to load it
+ eval "require $class";
+ if ($@) {
+ if ($@ =~ /^Can\'t locate/) {
+ $response->header("Client-Warning" =>
+ "Unsupported authentication scheme
+'$scheme'");
+ } else {
+ $response->header("Client-Warning" => $@);
+ }
+ next CHALLENGE;
}
- return $response;
}
+ return $class->authenticate($self, $proxy, $challenge, $response,
+ $request, $arg, $size);
}
- return $class->authenticate($self, $proxy, $challenge, $response,
- $request, $arg, $size);
+ return $response;
}
return $response;
}
