"Unknown code $code"));
if ($code == &HTTP::Status::RC_MOVED_PERMANENTLY or
$code == &HTTP::Status::RC_FOUND or
$code == &HTTP::Status::RC_SEE_OTHER or
$code == &HTTP::Status::RC_TEMPORARY_REDIRECT)
{
my $referral = $request->clone;
# These headers should never be forwarded
$referral->remove_header('Host', 'Cookie');
if ($referral->header('Referer') &&
$request->url->scheme eq 'https' &&
$referral->url->scheme eq 'http')
{
# RFC 2616, section 15.1.3.
LWP::Debug::trace("https -> http redirect, suppressing Referer");
$referral->remove_header('Referer');
}
if ($code == &HTTP::Status::RC_SEE_OTHER ||
$code == &HTTP::Status::RC_FOUND)
{
my $method = uc($referral->method);
unless ($method eq "GET" || $method eq "HEAD") {
$referral->method("GET");
$referral->content("");
$referral->remove_content_headers;
}
}
# And then we update the URL based on the Location:-header.
my $referral_uri = $response->header('Location');
{
# Some servers erroneously return a relative URL for redirects,
# so make it absolute if it not already is.
local $URI::ABS_ALLOW_RELATIVE_SCHEME = 1;
my $base = $response->base;
$referral_uri = "" unless defined $referral_uri;
$referral_uri = $HTTP::URI_CLASS->new($referral_uri, $base)
->abs($base);
}
$referral->url($referral_uri);
return $response unless $self->redirect_ok($referral, $response);
return $self->request($referral, $arg, $size, $response);
}
elsif ($code == &HTTP::Status::RC_UNAUTHORIZED ||
$code == &HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED
)
{
my $proxy = ($code == &HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED);
my $ch_header = $proxy ? "Proxy-Authenticate" : "WWW-Authenticate";
my @challenge = $response->header($ch_header);
unless (@challenge) {
$response->header("Client-Warning" =>
"Missing Authenticate header");
return $response;
}
require HTTP::Headers::Util;
CHALLENGE: for my $challenge (@challenge) {
$challenge =~ tr/,/;/; # "," is used to separate auth-params!!
($challenge) = HTTP::Headers::Util::split_header_words($challenge);
my $scheme = shift(@$challenge);
shift(@$challenge); # no value
$challenge = { @$challenge }; # make rest into a hash
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" => $@);
}
next CHALLENGE;
}
}
unless ($class->can("authenticate")) {
$response->header("Client-Warning" =>
"Unsupported authentication scheme '$scheme'");
next CHALLENGE;
}
return $class->authenticate($self, $proxy, $challenge, $response,
=4= |