| CC: | spurkis [...] sitesell.com |
| Subject: | Infinite Loops! max_redirects not respected |
On a catalyst page that redirects to itself (or indeed a redirect loop across different pages),
Test::WWW::Mechanize::Catalyst will follow redirects infinitely. It should respect
LWP::UserAgent's 'max_redirects' property, which it inherits.
The attached patch fixes this against v0.57 & trunk (who's tests are not currently passing, but
not due to this patch).
| Subject: | T-W-Mech-Catalyst-max_redirects-0.57.patch |
diff -ru Test-WWW-Mechanize-Catalyst-0.57/lib/Test/WWW/Mechanize/Catalyst.pm Test-WWW-Mechanize-Catalyst-0.57-max_redirects/lib/Test/WWW/Mechanize/Catalyst.pm
--- Test-WWW-Mechanize-Catalyst-0.57/lib/Test/WWW/Mechanize/Catalyst.pm 2012-04-04 09:05:15.000000000 -0400
+++ Test-WWW-Mechanize-Catalyst-0.57-max_redirects/lib/Test/WWW/Mechanize/Catalyst.pm 2012-04-16 21:53:58.000000000 -0400
@@ -72,7 +72,7 @@
}
sub _make_request {
- my ( $self, $request ) = @_;
+ my ( $self, $request, $arg, $size, $previous) = @_;
my $response = $self->_do_catalyst_request($request);
$response->header( 'Content-Base', $response->request->uri )
@@ -94,31 +94,31 @@
$response->content_type('');
}
+ # NOTE: cargo-culted redirect checking from LWP::UserAgent:
+ $response->previous($previous) if $previous;
+ if ($response->redirects >= $self->max_redirect) {
+ $response->header("Client-Warning" =>
+ "Redirect loop detected (max_redirect = $self->{max_redirect})");
+ return $response;
+ }
+
# check if that was a redirect
if ( $response->header('Location')
&& $response->is_redirect
&& $self->redirect_ok( $request, $response ) )
{
-
- # remember the old response
- my $old_response = $response;
+ # TODO: this should probably create the request by cloning the original
+ # request and modifying it as LWP::UserAgent::request does. But for now...
# *where* do they want us to redirect to?
- my $location = $old_response->header('Location');
+ my $location = $response->header('Location');
# no-one *should* be returning non-absolute URLs, but if they
# are then we'd better cope with it. Let's create a new URI, using
# our request as the base.
my $uri = URI->new_abs( $location, $request->uri )->as_string;
-
- # make a new response, and save the old response in it
- $response = $self->_make_request( HTTP::Request->new( GET => $uri ) );
- my $end_of_chain = $response;
- while ( $end_of_chain->previous ) # keep going till the end
- {
- $end_of_chain = $end_of_chain->previous;
- } # of the chain...
- $end_of_chain->previous($old_response); # ...and add us to it
+ my $referral = HTTP::Request->new( GET => $uri );
+ return $self->request( $referral, $arg, $size, $response );
} else {
$response->{_raw_content} = $response->content;
}
diff -ru Test-WWW-Mechanize-Catalyst-0.57/t/redirect.t Test-WWW-Mechanize-Catalyst-0.57-max_redirects/t/redirect.t
--- Test-WWW-Mechanize-Catalyst-0.57/t/redirect.t 2012-04-04 08:51:29.000000000 -0400
+++ Test-WWW-Mechanize-Catalyst-0.57-max_redirects/t/redirect.t 2012-04-16 21:56:08.000000000 -0400
@@ -2,7 +2,7 @@
use strict;
use warnings;
use lib 'lib';
-use Test::More tests => 29;
+use Test::More tests => 33;
use lib 't/lib';
use Test::WWW::Mechanize::Catalyst 'Catty';
@@ -37,3 +37,13 @@
$m->get_ok( "$root/redirect_to_utf8_upgraded_string",
"redirect using an upgraded utf8 string" );
+# Check for max_redirects support
+{
+ $m = Test::WWW::Mechanize::Catalyst->new(max_redirect => 1);
+ is( $m->max_redirect, 1, 'max_redirect set' );
+ $m->get( "$root/bonjour" );
+ ok( !$m->success, "get /bonjour with max_redirect=1 is not a success" );
+ is( $m->response->redirects, 1, 'redirects only once' );
+ like( $m->response->header('Client-Warning'), qr/Redirect loop detected/i,
+ 'sets Client-Warning header' );
+}
| Subject: | T-W-Mech-Catalyst-max_redirects-trunk.patch |
diff -ru trunk/lib/Test/WWW/Mechanize/Catalyst.pm Test-WWW-Mechanize-Catalyst/lib/Test/WWW/Mechanize/Catalyst.pm
--- trunk/lib/Test/WWW/Mechanize/Catalyst.pm 2012-04-16 21:46:02.000000000 -0400
+++ Test-WWW-Mechanize-Catalyst/lib/Test/WWW/Mechanize/Catalyst.pm 2012-04-16 21:40:08.000000000 -0400
@@ -72,7 +72,7 @@
}
sub _make_request {
- my ( $self, $request ) = @_;
+ my ( $self, $request, $arg, $size, $previous) = @_;
my $response = $self->_do_catalyst_request($request);
$response->header( 'Content-Base', $response->request->uri )
@@ -94,31 +94,31 @@
$response->content_type('');
}
+ # NOTE: cargo-culted redirect checking from LWP::UserAgent:
+ $response->previous($previous) if $previous;
+ if ($response->redirects >= $self->max_redirect) {
+ $response->header("Client-Warning" =>
+ "Redirect loop detected (max_redirect = $self->{max_redirect})");
+ return $response;
+ }
+
# check if that was a redirect
if ( $response->header('Location')
&& $response->is_redirect
&& $self->redirect_ok( $request, $response ) )
{
-
- # remember the old response
- my $old_response = $response;
+ # TODO: this should probably create the request by cloning the original
+ # request and modifying it as LWP::UserAgent::request does. But for now...
# *where* do they want us to redirect to?
- my $location = $old_response->header('Location');
+ my $location = $response->header('Location');
# no-one *should* be returning non-absolute URLs, but if they
# are then we'd better cope with it. Let's create a new URI, using
# our request as the base.
my $uri = URI->new_abs( $location, $request->uri )->as_string;
-
- # make a new response, and save the old response in it
- $response = $self->_make_request( HTTP::Request->new( GET => $uri ) );
- my $end_of_chain = $response;
- while ( $end_of_chain->previous ) # keep going till the end
- {
- $end_of_chain = $end_of_chain->previous;
- } # of the chain...
- $end_of_chain->previous($old_response); # ...and add us to it
+ my $referral = HTTP::Request->new( GET => $uri );
+ return $self->request( $referral, $arg, $size, $response );
} else {
$response->{_raw_content} = $response->content;
}
diff -ru trunk/t/redirect.t Test-WWW-Mechanize-Catalyst/t/redirect.t
--- trunk/t/redirect.t 2012-04-16 21:46:02.000000000 -0400
+++ Test-WWW-Mechanize-Catalyst/t/redirect.t 2012-04-16 21:44:47.000000000 -0400
@@ -2,7 +2,7 @@
use strict;
use warnings;
use lib 'lib';
-use Test::More tests => 30;
+use Test::More tests => 34;
use lib 't/lib';
use Test::WWW::Mechanize::Catalyst 'Catty';
use HTTP::Request::Common;
@@ -42,3 +42,15 @@
my $uri = URI->new_abs( $loc, $req->uri )->as_string;
is_sane_utf8($uri);
isnt_flagged_utf8($uri);
+
+
+# Check for max_redirects support
+{
+ $m = Test::WWW::Mechanize::Catalyst->new(max_redirect => 1);
+ is( $m->max_redirect, 1, 'max_redirect set' );
+ $m->get( "$root/bonjour" );
+ ok( !$m->success, "get /bonjour with max_redirect=1 is not a success" );
+ is( $m->response->redirects, 1, 'redirects only once' );
+ like( $m->response->header('Client-Warning'), qr/Redirect loop detected/i,
+ 'sets Client-Warning header' );
+}