Merge a8ae2b7 into dd7ea8a

Changes

@@ -1,6 +1,8 @@
 Change history for libwww-perl
 
 {{$NEXT}}
+    - Fix a looping regression in 6.45 for redirect responses without
+      a Location header (GH PR#342, Niko Tyni)
 
 6.45      2020-06-08 14:51:28Z
     - Fix Client-Warning: Internal response sometimes reset (GH#341) (Jonathan

lib/LWP/UserAgent.pm

@@ -300,10 +300,12 @@ sub request {
     my $response = $self->simple_request($request, $arg, $size);
     $response->previous($previous) if $previous;
 
-    if ($response->header('Location') && $response->redirects >= $self->{max_redirect}) {
-        $response->header("Client-Warning" =>
+    if ($response->redirects >= $self->{max_redirect}) {
+        if ($response->header('Location')) {
+            $response->header("Client-Warning" =>
                 "Redirect loop detected (max_redirect = $self->{max_redirect})"
-        );
+            );
+        }
         return $response;
     }
 

t/local/http.t

@@ -63,7 +63,7 @@ sub _test {
     return plan skip_all => 'We could not talk to our daemon' unless $DAEMON;
     return plan skip_all => 'No base URI' unless $base;
 
-    plan tests => 125;
+    plan tests => 127;
 
     my $ua = LWP::UserAgent->new;
     $ua->agent("Mozilla/0.01 " . $ua->agent);
@@ -221,6 +221,13 @@ sub _test {
         is($res->redirects, 0, 'redirect loop: zero redirects');
         $ua->max_redirect(5);
         is($ua->max_redirect(), 5, 'redirect loop: max redirects set back to 5');
+
+        # Test that redirects without a Location header work and don't loop
+        $req->uri(url("/redirect4", $base));
+        $ua->max_redirect(5);
+        is($ua->max_redirect(), 5, 'redirect loop: max redirect 5');
+        $res = $ua->request($req);
+        isa_ok($res, 'HTTP::Response', 'redirect loop: good response object');
     }
     { # basic auth
         my $req = HTTP::Request->new(GET => url("/basic", $base));
@@ -622,6 +629,7 @@ sub daemonize {
     };
     $router{get_redirect2} = sub { shift->send_redirect("/redirect3/") };
     $router{get_redirect3} = sub { shift->send_redirect("/redirect2/") };
+    $router{get_redirect4} = sub { my $r = HTTP::Response->new(303); shift->send_response($r) };
     $router{post_echo} = sub {
         my($c,$r) = @_;
         $c->send_basic_header;