Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
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;

In reply to LWP::UserAgent subclass to make it follow redirects after POST (like Netscape) by gregorovius

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • 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.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others cooling their heels in the Monastery: (5)
As of 2024-03-28 10:32 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found