Make headers and cookies non-writable after finalize-headers

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 8cb5af5..fde9681 100644 (file)
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -16,6 +16,8 @@ use Path::Class;
 use Time::HiRes qw/gettimeofday tv_interval/;
 use URI;
 use Scalar::Util qw/weaken/;
+use Hash::Util qw/lock_hash/;
+use HTTP::Headers::ReadOnly;
 use attributes;
 
 __PACKAGE__->mk_accessors(
@@ -1023,7 +1025,11 @@ Finalizes cookies.
 
 =cut
 
-sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
+sub finalize_cookies {
+       my $c = shift;
+       $c->engine->finalize_cookies( $c, @_ );
+       lock_hash( %$_ ) for $c->res->cookies, values %{ $c->res->cookies };
+}
 
 =item $c->finalize_error
 
@@ -1066,6 +1072,8 @@ sub finalize_headers {
 
     $c->engine->finalize_headers( $c, @_ );
 
+       bless $c->response->headers, "HTTP::Headers::ReadOnly";
+
     # Done
     $c->response->{_finalized_headers} = 1;
 }
@@ -1774,6 +1782,9 @@ Writes $data to the output stream. When using this method directly, you
 will need to manually set the C<Content-Length> header to the length of
 your output data, if known.
 
+Also note that any headers created after the write can  no longer be added, and
+this includes cookies.
+
 =cut
 
 sub write {

diff --git a/lib/HTTP/Headers/ReadOnly.pm b/lib/HTTP/Headers/ReadOnly.pm
new file mode 100644 (file)
index 0000000..7f3caac
--- /dev/null
+++ b/lib/HTTP/Headers/ReadOnly.pm
@@ -0,0 +1,59 @@
+#!/usr/bin/perl
+
+package HTTP::Headers::ReadOnly;
+use base qw/HTTP::Headers/;
+
+use strict;
+use warnings;
+
+use Carp qw/croak/;
+use Class::Inspector;
+
+sub _jerk_it {
+       croak "Can't modify headers after headers have been sent to the client";
+}
+
+sub _header {
+       my ( $self, $field, $val, $op ) = @_;
+       shift;
+       _jerk_it if $val;
+
+       $self->SUPER::_header(@_);
+}
+
+BEGIN {
+       for ( @{ Class::Inspector->functions( "HTTP::Headers" ) }) {
+               no strict 'refs';
+               *$_ = \&_jerk_it if /remove|clear/;
+               
+       }
+}
+
+__PACKAGE__;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+HTTP::Headers::ReadOnly - Immutable HTTP::headers
+
+=head1 SYNOPSIS
+
+       my $headers = HTTP::Headers->new(...);
+
+       bless $headers, "HTTP::Headers::ReadOnly";
+
+       $headers->content_type( "foo" ); # dies
+
+=head1 DESCRIPTION
+
+This class blocks write access to a L<HTTP::Headers> object.
+
+It is used to raise errors in L<Catalyst> if the header object is modified
+after C<finalize_headers>.
+
+=cut
+
+

diff --git a/t/unit/core/headers.t b/t/unit/core/headers.t
new file mode 100644 (file)
index 0000000..d075b39
--- /dev/null
+++ b/t/unit/core/headers.t
@@ -0,0 +1,35 @@
+use Test::More tests => 6;
+use strict;
+use warnings;
+
+{
+
+    package MyApp;
+    use Catalyst qw/-Engine=Test/;
+    use Test::Exception;
+
+    sub stream_it : Local {
+        my ( $self, $c ) = @_;
+
+        lives_ok { $c->res->headers->content_encoding("moose") }
+          "can set header";
+        lives_ok { $c->res->headers->remove_header("moose") }
+          "can remove header";
+        lives_ok { $c->res->cookies->{yadda} = { value => "ping" } }
+          "can make cookie";
+        $c->write("foo");
+        throws_ok { $c->res->headers->content_encoding("moose") }
+          qr/can't modify/i, "can't set header after write";
+        throws_ok { $c->res->headers->remove_header("moose") }
+          qr/can't modify/i, "can't remove header after write";
+        throws_ok { $c->res->cookies->{yadda} = { value => "ping" } }
+          qr/read-only/i, "can't make cookie after write";
+    }
+
+    __PACKAGE__->setup;
+}
+
+use Catalyst::Test qw/MyApp/;
+
+get "/stream_it";
+