Hugo <[EMAIL PROTECTED]> writes: > 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. True. Known problem. > 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. For LWPng I tried to use the HTTP::Headers::Auth module to do the parsing. It will enhance the www_authenticate and proxy_authenticate methods such that they return parsed stuff in list context. Should be able to just use it for LWP5 too. > 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>`. Looks good enough for now. Thanks! > (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.) On the http://www.linpro.no/lwp/ page you will find a pointer to another archive. Regards, Gisle > --- 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; > } >
