package LWP::NetscapeLikeUserAgent;
use LWP::UserAgent;
use vars qw(@ISA);
@ISA = qw(LWP::UserAgent);
#
# request
#
# Substitutes the default (and standard compliant) "request" method of
+ the
# LWP::UserAgent module for one that behaves like the Netscape browser
+, ie.
# it will follow redirects after POST requests.
#
sub request
{
my($self, $request, $arg, $size, $previous) = @_;
LWP::Debug::trace('()');
my $response = $self->simple_request($request, $arg, $size);
my $code = $response->code;
$response->previous($previous) if defined $previous;
LWP::Debug::debug('Simple response: ' .
(HTTP::Status::status_message($code) ||
"Unknown code $code"));
if ($code == &HTTP::Status::RC_MOVED_PERMANENTLY or
$code == &HTTP::Status::RC_MOVED_TEMPORARILY) {
# Make a copy of the request and initialize it with the new URI
my $referral = $request->clone;
# XXX This is where this routine differs from the one in LWP::User
+Agent.
# If the method of the request is POST then we make the method of
+the
# new request be GET, so that it passes the redirect_ok test. This
+ is
# non-standard but is the way Netscape does it, and many web appli
+cations
# rely on this.
if($request->method eq 'POST') {
$referral->method('GET');
$referral->content('');
}
# 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 = $HTTP::URI_CLASS->new($referral_uri, $base)
->abs($base);
}
$referral->url($referral_uri);
return $response unless $self->redirect_ok($referral);
# Check for loop in the redirects
my $count = 0;
my $r = $response;
while ($r) {
if (++$count > 13 ||
$r->request->url->as_string eq $referral_uri->as_strin
+g) {
$response->header("Client-Warning" =>
"Redirect loop detected");
return $response;
}
$r = $r->previous;
}
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_REQUI
+RED);
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($challe
+nge);
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;
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 $class->authenticate($self, $proxy, $challenge, $respon
+se,
$request, $arg, $size);
}
return $response;
}
return $response;
}
sub redirect_ok
{
1;
}
1;
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.