Beefy Boxes and Bandwidth Generously Provided by pair Networks Bob
Perl-Sensitive Sunglasses
 
PerlMonks  

Comment on

( #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":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

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

    How do I use this? | Other CB clients
    Other Users?
    Others contemplating the Monastery: (15)
    As of 2014-04-16 14:03 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      April first is:







      Results (427 votes), past polls