Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?

I am having problems with both redirection and detecting redirection

by ted.byers (Monk)
on Sep 26, 2012 at 20:36 UTC ( #995868=perlquestion: print w/replies, xml ) Need Help??
ted.byers has asked for the wisdom of the Perl Monks concerning the following question:

I have a use case in which a service to which I am posting form data may sometimes redirect me to another page, and sometimes it sends a response directly. I have to be able to detect when the redirection happens so I can respond appropriately. Actually, if the redirectiong happens, I have to pass it back to the client that made a request to my cgi script (storing one thing in my DB), and if not, then I pass my own page back to the client while storing something else in my DB.

Here are excerpts from the little cgi script I made to dynamically redirect or not depending on a request parameter

use strict; use CGI; my $TITLE = 'Redirection Test'; my $cgi = new CGI; my $rp = $cgi->param('r'); print $cgi->header unless defined $rp; ... if (defined $rp) { if ($rp > 0) { my $full_url = $cgi->url(); # print $cgi->redirect($full_url"); print $cgi->header("Location: $full_url");exit(0); } } &print_html_header; &print_content; &print_end; exit(0); sub print_html_header { print $cgi->start_html($TITLE); } sub print_end { print $cgi->end_html; } sub print_content { print "<p><a href=\"\">Go To Google</a></p>"; }

And here is my client code:

use strict; use Log::Log4perl qw(:easy get_logger); use LWP::UserAgent; use HTTP::Request; use HTTP::Request::Common; use HTTP::Response; use HTTP::Status; $| = 1; $ua->add_handler("request_send", sub { log_it("Request: ".shift->dump +); return }); $ua->add_handler("response_done", sub { my $rsp = shift; my @red = $rs +p->redirects; my $r; foreach $r (@red) {log_it("Response redirect: ". +$r)}; log_it("Response last request: ".$rsp->request->uri); log_it("R +esponse headers: ".$rsp->headers_as_string); log_it("Response code: " +.$rsp->code); my $msg = status_message($rsp->code); log_it("Response +status: ".$msg) if defined $msg; log_it("Response status: ".$rsp->sta +tus_line); return }); # Define configuration my $conf = q( log4perl.logger = TRACE, FileApp, ScreenApp log4perl.appender.FileApp = Log::Log4perl::Appender:: +File log4perl.appender.FileApp.filename = lwp.log log4perl.appender.FileApp.layout = PatternLayout log4perl.appender.FileApp.layout.ConversionPattern = %d> %m%n log4perl.appender.ScreenApp = Log::Log4perl::Appender +::Screen log4perl.appender.ScreenApp.stderr = 0 log4perl.appender.ScreenApp.layout = PatternLayout log4perl.appender.ScreenApp.layout.ConversionPattern = %d> %m% +n ); # Initialize logging behaviour Log::Log4perl->init( \$conf ); Log::Log4perl->infiltrate_lwp(); my $logger = get_logger(); my $req_url = $ARGV[0]; $req_url = "\"$req_url \""; my $response = $ua->request(GET "$req_url"); print "Redirects: ",$response->redirects,"\n"; print "Header field names: ",$response->header_field_names,"\n"; my $prev = $response->previous; $prev = 'undef' unless defined $prev; print "Previous: $prev\n"; if ( $response->is_redirect ) { print $response->previous . " redirected to location " . $respons +e->header('Location') . "\n"; print "The content is: ",$response->content,"\n"; $logger->info($response->previous . " redirected to location " . +$response->header('Location')); } else { if ($response->is_success) { print "The content is: ",$response->content,"\n"; $logger->info("The URL $req_url was successfully retrieved."); if (lc($response->content)=~m/'error_response'/){ $logger->warn("Response problematic content: ".$response->conten +t); } } else { $logger->warn("The URL $req_url was not successfully retrieved."); } } sub log_it { my $tmp = shift; $tmp =~ s/\n+/,\t/g; $tmp =~ s/,\t$//; $logger->info($tmp); return; }

Now here is typical output

2012/09/26 15:52:32> Request: GET http://localhost:9080/cgi-bin/, User-Agent: libwww-perl/6.02, (no content) 2012/09/26 15:52:32> Response last request: http://localhost:9080/cgi- +bin/ 2012/09/26 15:52:32> Response headers: Connection: close, Date: Wed +, 26 Sep 2012 19:52:32 GMT, Server: Apache/2.2.16 (Win32) mod_ssl/ +2.2.16 OpenSSL/0.9.8o PHP/5.3.3, Content-Length: 0, Content-Typ +e: location: http://localhost:9080/cgi-bin/; charset=I +SO-8859-1, Client-Date: Wed, 26 Sep 2012 19:52:32 GMT, Client-P +eer:, Client-Response-Num: 1 2012/09/26 15:52:32> Response code: 200 2012/09/26 15:52:32> Response status: OK 2012/09/26 15:52:32> Response status: 200 OK Redirects: Header field names: ConnectionDateServerContent-LengthContent-TypeClie +nt-DateClient-PeerClient-Response-Num Previous: undef The content is: 2012/09/26 15:52:32> The URL "http://localhost:9080/cgi-bin/cgi.redire " was successfully retrieved.

Now, you can see from the log output that the request used a parameter that ought to have produced the redirect URL. NB: I used " print $cgi->header("Location: $full_url");" because "print $cgi->redirect($full_url");" generated a server error complaining about a malformed header.

I do not know why LWP is not following the redirection. I suspect that failure is why I get nothing from the previous or redirects functions. I got the functions I am trying to use from the Activestate perl documentation, but they do not seem to be working.

Did I miss something? Or is there something missing or incorrect in the documentation?

Any assistance you can provide would be greatly appreciated.



Replies are listed 'Best First'.
Re: I am having problems with both redirection and detecting redirection
by Anonymous Monk on Sep 27, 2012 at 00:43 UTC
    ->redirect($full_url") isn't working because of ", its a typo
    $ perl print $cgi->redirect($full_url"); ^Z String found where operator expected at - line 1, at end of line (Missing semicolon on previous line?) Can't find string terminator '"' anywhere before EOF at - line 1.

      Thanks. That was it.

      From the output I now see, I can use $reponse->code to detect the redirection.

      Now, how do I proceed to the next step, which is to send that redirection, unaltered, back to the client that made the original request to my cgi script. That is, imagine my client code above being in a CGI script that submits a request to a secure site, and if I get a redirect, I have to pass it back to the client that submitted the original request to my CGI script. How do I do this? Surely it isn't as simple as:

      print $cgi->redirect($response->request);

      But that is what would be implied by the following from the documentation:

      $r->request $r->request( $request ) This is used to get/set the request attribute. The request attribu +te is a reference to the the request that caused this response. It do +es not have to be the same request passed to the $ua->request() metho +d, because there might have been redirects and authorization retries +in between.

      If it is that simple, would any headers I may have printed before printing the redirect adversely affect how the redirect works, or do I have to ensure that nothing, not even headers, get printed before I know whether or not a redirection has occured?

      Thankyou very much.


        escape, encode, serialize ...

        $cgi->redirect( '?what='. CGI->escape( $res->headers->as_string ) );

        unescape, decode, deserialize ...

        my $what = $cgi->param('what') || $cgi->query_param('what'); my $headers HTTP::Message->parse( $what )->headers;
Re: I am having problems with both redirection and detecting redirection
by Anonymous Monk on Sep 27, 2012 at 02:26 UTC

    I do not know why LWP is not following the redirection.

    $ perldoc LWP::UserAgent |ack -i redir max_redirect 7 requests_redirectable ['GET', 'HEAD'] $ua->max_redirect $ua->max_redirect( $n ) redirection responses in a given request cycle. method and the response is a redirect elsewhere which is in tu +rn a redirect, and so on seven times, then LWP gives up after that $ua->requests_redirectable $ua->requests_redirectable( \@requests ) "$ua->redirect_ok(...)" will allow redirection for. By default +, this push @{ $ua->requests_redirectable }, 'POST'; received, but before any redirect handling is attempted. T +he response_redirect => sub { my($response, $ua, $h) = @_; ... } The request() method will process redirects and authentication to handle redirects or authentication responses. The request() $ua->redirect_ok( $prospective_request, $response ) redirection to the request in $response. This should return a +TRUE value if this redirection is permissible. The $prospective_req +uest the object's "requests_redirectable" list, FALSE if the propos +ed redirection is to a "file://..." URL, and TRUE otherwise.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://995868]
Approved by Corion
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (8)
As of 2018-06-18 18:03 GMT
Find Nodes?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?

    Results (110 votes). Check out past polls.