From 9e7196511e6ae765ff7119330f249c0968849ce5 Mon Sep 17 00:00:00 2001
From: Aristotle Pagaltzis <pagaltzis@gmx.de>
Date: Thu, 7 Jun 2012 02:22:38 +0200
Subject: [PATCH] avoid overwriting Location in fabricated PSGI responses

---
 Changes                         | 3 +++
 dist.ini                        | 2 +-
 lib/Plack/Middleware/Rewrite.pm | 6 ++++--
 t/rewrite.t                     | 8 ++++++++
 4 files changed, 16 insertions(+), 3 deletions(-)

diff --git a/Changes b/Changes
index 188e518..f26f5a8 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for Plack-Middleware-Rewrite
 
+1.005 Thu 07 Jun 2012
+	- Preserve pre-existing Location header in fabricated responses
+
 1.004 Thu 29 Mar 2012
 	- Preserve query params in external redirects by dropping unnecessary use of URI
 	  (with thanks to Wallace Reis)
diff --git a/dist.ini b/dist.ini
index aa4d595..0ce537e 100644
--- a/dist.ini
+++ b/dist.ini
@@ -1,5 +1,5 @@
 name    = Plack-Middleware-Rewrite
-version = 1.004
+version = 1.005
 author  = Aristotle Pagaltzis <pagaltzis@gmx.de>
 license = Perl_5
 copyright_holder = Aristotle Pagaltzis
diff --git a/lib/Plack/Middleware/Rewrite.pm b/lib/Plack/Middleware/Rewrite.pm
index 718ad4b..6af67a9 100644
--- a/lib/Plack/Middleware/Rewrite.pm
+++ b/lib/Plack/Middleware/Rewrite.pm
@@ -40,8 +40,10 @@ sub call {
 		$res = $self->app->( $env );
 	}
 	elsif ( $res->[0] =~ /\A3[0-9][0-9]\z/ ) {
-		my $dest = Plack::Request->new( $env )->uri;
-		Plack::Util::header_set( $res->[1], Location => $dest );
+		if ( not Plack::Util::header_exists( $res->[1], 'Location' ) ) {
+			my $dest = Plack::Request->new( $env )->uri;
+			Plack::Util::header_set( $res->[1], Location => $dest );
+		}
 	}
 
 	return $res if not $modify_cb;
diff --git a/t/rewrite.t b/t/rewrite.t
index 2751364..a3b759f 100644
--- a/t/rewrite.t
+++ b/t/rewrite.t
@@ -23,6 +23,9 @@ $app = builder {
 		return sub { $_->set( 'Content-Type', $xhtml ) }
 			if $_[0]{'HTTP_ACCEPT'} =~ m{application/xhtml\+xml(?!\s*;\s*q=0)};
 
+		return [ 302, [ Location => 'http://localhost/correct' ], [] ]
+			if m{^/psgi-redirect};
+
 		s{^/baz$}{/quux};
 	};
 	$app;
@@ -68,6 +71,11 @@ test_psgi app => $app, client => sub {
 	is $res->header( 'Content-Type' ), 'text/plain', '... with headers';
 	is $res->content, 'Goodbye Web', '... body, and all.';
 
+	$req = GET 'http://localhost/psgi-redirect';
+	$res = $cb->( $req );
+	is $res->code, 302, 'Fabricated responses can be redirects';
+	is $res->header( 'Location' ), 'http://localhost/correct', '... with proper destination';
+
 	$req = GET 'http://localhost/', Accept => $xhtml;
 	$res = $cb->( $req );
 	is $res->code, 200, 'Post-modification leaves the status alone';