On Mon, Dec 27, 2010 at 03:33:21PM +0200, Niko Tyni wrote:
> On Wed, Dec 08, 2010 at 08:53:28PM +0100, Moritz Muehlenhoff wrote:
> > On Wed, Dec 08, 2010 at 08:35:47PM +0100, Ansgar Burchardt wrote:
> > > Moritz Muehlenhoff <[email protected]> writes:
> > > > Three security issues have been reported in libcgi-pm-perl:
> > > >
> > > > http://security-tracker.debian.org/tracker/CVE-2010-2761
> > > > http://security-tracker.debian.org/tracker/CVE-2010-4410
> > > > http://security-tracker.debian.org/tracker/CVE-2010-4411
>
> > > I'm not quite sure yet what CVE-2010-4411 refers to. It seems that the
> > > fix for CVE-2010-2761 was not complete, but it is not a different, new
> > > issue?
>
> https://github.com/markstos/CGI.pm/commit/77b3b2056c003edee034a2a890212edab800900d
>
> Mark, is this double newline injection fix the new patch referred above?
Assuming this is the case, I'm attaching preliminary patches for
3.29 (perl-modules / lenny)
3.38 (libcgi-pm-perl / lenny)
3.43 (perl-modules / squeeze + sid)
3.49 (libcgi-pm-perl / squeeze)
3.50 (libcgi-pm-perl / sid)
They include relevant test suite additions from the github repository
and a small test fix I sent to [rt.cpan.org #64261].
Eyeballs and testing would be welcome. In particular, I'm not entirely
sure about the //s modifier change in header() around CGI.pm:1500 in
the pre-3.49 patches. The change was introduced upstream with 3.49 along
with the header fixes but it's not covered by the test suite.
I haven't looked at libcgi-simple-perl at all.
--
Niko Tyni [email protected]
diff --git a/lib/CGI.pm b/lib/CGI.pm
index 1bc74a3..191fb54 100644
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -1379,7 +1379,14 @@ END_OF_FUNC
sub multipart_init {
my($self,@p) = self_or_default(@_);
my($boundary,@other) = rearrange([BOUNDARY],@p);
- $boundary = $boundary || '------- =_aaaaaaaaaa0';
+ if (!$boundary) {
+ $boundary = '------- =_';
+ my @chrs = ('0'..'9', 'A'..'Z', 'a'..'z');
+ for (1..17) {
+ $boundary .= $chrs[rand(scalar @chrs)];
+ }
+ }
+
$self->{'separator'} = "$CRLF--$boundary$CRLF";
$self->{'final_separator'} = "$CRLF--$boundary--$CRLF";
$type = SERVER_PUSH($boundary);
@@ -1464,6 +1471,23 @@ sub header {
'EXPIRES','NPH','CHARSET',
'ATTACHMENT','P3P'],@p);
+ # CR escaping for values, per RFC 822
+ for my $header ($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) {
+ if (defined $header) {
+ # From RFC 822:
+ # Unfolding is accomplished by regarding CRLF immediately
+ # followed by a LWSP-char as equivalent to the LWSP-char.
+ $header =~ s/$CRLF(\s)/$1/g;
+
+ # All other uses of newlines are invalid input.
+ if ($header =~ m/$CRLF|\015|\012/) {
+ # shorten very long values in the diagnostic
+ $header = substr($header,0,72).'...' if (length $header > 72);
+ die "Invalid header value contains a newline not followed by whitespace: $header";
+ }
+ }
+ }
+
$nph ||= $NPH;
$type ||= 'text/html' unless defined($type);
@@ -1479,7 +1503,7 @@ sub header {
# need to fix it up a little.
foreach (@other) {
# Don't use \s because of perl bug 21951
- next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/;
+ next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/s;
($_ = $header) =~ s/^(\w)(.*)/"\u$1\L$2" . ': '.$self->unescapeHTML($value)/e;
}
@@ -5052,6 +5076,18 @@ In either case, the outgoing header will be formatted as:
P3P: policyref="/w3c/p3p.xml" cp="CAO DSP LAW CURa"
+Note that if a header value contains a carriage return, a leading space will be
+added to each new line that doesn't already have one as specified by RFC2616
+section 4.2. For example:
+
+ print header( -ingredients => "ham\neggs\nbacon" );
+
+will generate
+
+ Ingredients: ham
+ eggs
+ bacon
+
=head2 GENERATING A REDIRECTION HEADER
print redirect('http://somewhere.else/in/movie/land');
diff --git a/lib/CGI/t/headers.t b/lib/CGI/t/headers.t
new file mode 100644
index 0000000..661b74b
--- /dev/null
+++ b/lib/CGI/t/headers.t
@@ -0,0 +1,47 @@
+
+# Test that header generation is spec compliant.
+# References:
+# http://www.w3.org/Protocols/rfc2616/rfc2616.html
+# http://www.w3.org/Protocols/rfc822/3_Lexical.html
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use CGI;
+
+my $cgi = CGI->new;
+
+like $cgi->header( -type => "text/html" ),
+ qr#Type: text/html#, 'known header, basic case: type => "text/html"';
+
+eval { $cgi->header( -type => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'invalid header blows up');
+
+like $cgi->header( -type => "text/html".$CGI::CRLF." evil: stuff " ),
+ qr#Content-Type: text/html evil: stuff#, 'known header, with leading and trailing whitespace on the continuation line';
+
+eval { $cgi->header( -foobar => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'unknown header with CRLF embedded blows up');
+
+eval { $cgi->header( -foobar => $CGI::CRLF."Content-type: evil/header" ) };
+like($@,qr/contains a newline/, 'unknown header with leading newlines blows up');
+
+eval { $cgi->redirect( -type => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'redirect with known header with CRLF embedded blows up');
+
+eval { $cgi->redirect( -foobar => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'redirect with unknown header with CRLF embedded blows up');
+
+eval { $cgi->redirect( $CGI::CRLF.$CGI::CRLF."Content-Type: text/html") };
+like($@,qr/contains a newline/,'redirect with leading newlines blows up');
+
+{
+ my $cgi = CGI->new('t=bogus%0A%0A<html>');
+ my $out;
+ eval { $out = $cgi->redirect( $cgi->param('t') ) };
+ like($@,qr/contains a newline/, "redirect does not allow double-newline injection");
+}
+
+
diff --git a/lib/CGI/t/multipart_init.t b/lib/CGI/t/multipart_init.t
new file mode 100644
index 0000000..f0a05e0
--- /dev/null
+++ b/lib/CGI/t/multipart_init.t
@@ -0,0 +1,20 @@
+use Test::More 'no_plan';
+
+use CGI;
+
+my $q = CGI->new;
+
+my $sv = $q->multipart_init;
+like( $sv, qr|Content-Type: multipart/x-mixed-replace;boundary="------- =|, 'multipart_init(), basic');
+
+like( $sv, qr/$CGI::CRLF$/, 'multipart_init(), ends in CRLF' );
+
+$sv = $q->multipart_init( 'this_is_the_boundary' );
+like( $sv, qr/boundary="this_is_the_boundary"/, 'multipart_init("simple_boundary")' );
+$sv = $q->multipart_init( -boundary => 'this_is_another_boundary' );
+like($sv,
+ qr/boundary="this_is_another_boundary"/, "multipart_init( -boundary => 'this_is_another_boundary')");
+
+$sv = $q->multipart_init;
+my $sv2 = $q->multipart_init;
+isnt($sv,$sv2,"due to random boundaries, multiple calls produce different results");
diff --git a/CGI.pm b/CGI.pm
index 64fbc91..d84e536 100644
--- a/CGI.pm
+++ b/CGI.pm
@@ -1382,7 +1382,14 @@ END_OF_FUNC
sub multipart_init {
my($self,@p) = self_or_default(@_);
my($boundary,@other) = rearrange([BOUNDARY],@p);
- $boundary = $boundary || '------- =_aaaaaaaaaa0';
+ if (!$boundary) {
+ $boundary = '------- =_';
+ my @chrs = ('0'..'9', 'A'..'Z', 'a'..'z');
+ for (1..17) {
+ $boundary .= $chrs[rand(scalar @chrs)];
+ }
+ }
+
$self->{'separator'} = "$CRLF--$boundary$CRLF";
$self->{'final_separator'} = "$CRLF--$boundary--$CRLF";
$type = SERVER_PUSH($boundary);
@@ -1467,6 +1474,23 @@ sub header {
'EXPIRES','NPH','CHARSET',
'ATTACHMENT','P3P'],@p);
+ # CR escaping for values, per RFC 822
+ for my $header ($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) {
+ if (defined $header) {
+ # From RFC 822:
+ # Unfolding is accomplished by regarding CRLF immediately
+ # followed by a LWSP-char as equivalent to the LWSP-char.
+ $header =~ s/$CRLF(\s)/$1/g;
+
+ # All other uses of newlines are invalid input.
+ if ($header =~ m/$CRLF|\015|\012/) {
+ # shorten very long values in the diagnostic
+ $header = substr($header,0,72).'...' if (length $header > 72);
+ die "Invalid header value contains a newline not followed by whitespace: $header";
+ }
+ }
+ }
+
$nph ||= $NPH;
$type ||= 'text/html' unless defined($type);
@@ -1482,7 +1506,7 @@ sub header {
# need to fix it up a little.
foreach (@other) {
# Don't use \s because of perl bug 21951
- next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/;
+ next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/s;
($_ = $header) =~ s/^(\w)(.*)/"\u$1\L$2" . ': '.$self->unescapeHTML($value)/e;
}
@@ -5101,6 +5125,18 @@ In either case, the outgoing header will be formatted as:
P3P: policyref="/w3c/p3p.xml" cp="CAO DSP LAW CURa"
+Note that if a header value contains a carriage return, a leading space will be
+added to each new line that doesn't already have one as specified by RFC2616
+section 4.2. For example:
+
+ print header( -ingredients => "ham\neggs\nbacon" );
+
+will generate
+
+ Ingredients: ham
+ eggs
+ bacon
+
=head2 GENERATING A REDIRECTION HEADER
print redirect('http://somewhere.else/in/movie/land');
diff --git a/t/headers.t b/t/headers.t
new file mode 100644
index 0000000..661b74b
--- /dev/null
+++ b/t/headers.t
@@ -0,0 +1,47 @@
+
+# Test that header generation is spec compliant.
+# References:
+# http://www.w3.org/Protocols/rfc2616/rfc2616.html
+# http://www.w3.org/Protocols/rfc822/3_Lexical.html
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use CGI;
+
+my $cgi = CGI->new;
+
+like $cgi->header( -type => "text/html" ),
+ qr#Type: text/html#, 'known header, basic case: type => "text/html"';
+
+eval { $cgi->header( -type => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'invalid header blows up');
+
+like $cgi->header( -type => "text/html".$CGI::CRLF." evil: stuff " ),
+ qr#Content-Type: text/html evil: stuff#, 'known header, with leading and trailing whitespace on the continuation line';
+
+eval { $cgi->header( -foobar => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'unknown header with CRLF embedded blows up');
+
+eval { $cgi->header( -foobar => $CGI::CRLF."Content-type: evil/header" ) };
+like($@,qr/contains a newline/, 'unknown header with leading newlines blows up');
+
+eval { $cgi->redirect( -type => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'redirect with known header with CRLF embedded blows up');
+
+eval { $cgi->redirect( -foobar => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'redirect with unknown header with CRLF embedded blows up');
+
+eval { $cgi->redirect( $CGI::CRLF.$CGI::CRLF."Content-Type: text/html") };
+like($@,qr/contains a newline/,'redirect with leading newlines blows up');
+
+{
+ my $cgi = CGI->new('t=bogus%0A%0A<html>');
+ my $out;
+ eval { $out = $cgi->redirect( $cgi->param('t') ) };
+ like($@,qr/contains a newline/, "redirect does not allow double-newline injection");
+}
+
+
diff --git a/t/multipart_init.t b/t/multipart_init.t
new file mode 100644
index 0000000..f0a05e0
--- /dev/null
+++ b/t/multipart_init.t
@@ -0,0 +1,20 @@
+use Test::More 'no_plan';
+
+use CGI;
+
+my $q = CGI->new;
+
+my $sv = $q->multipart_init;
+like( $sv, qr|Content-Type: multipart/x-mixed-replace;boundary="------- =|, 'multipart_init(), basic');
+
+like( $sv, qr/$CGI::CRLF$/, 'multipart_init(), ends in CRLF' );
+
+$sv = $q->multipart_init( 'this_is_the_boundary' );
+like( $sv, qr/boundary="this_is_the_boundary"/, 'multipart_init("simple_boundary")' );
+$sv = $q->multipart_init( -boundary => 'this_is_another_boundary' );
+like($sv,
+ qr/boundary="this_is_another_boundary"/, "multipart_init( -boundary => 'this_is_another_boundary')");
+
+$sv = $q->multipart_init;
+my $sv2 = $q->multipart_init;
+isnt($sv,$sv2,"due to random boundaries, multiple calls produce different results");
diff --git a/lib/CGI.pm b/lib/CGI.pm
index 008bc7b..0bb1b91 100644
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -1382,7 +1382,14 @@ END_OF_FUNC
sub multipart_init {
my($self,@p) = self_or_default(@_);
my($boundary,@other) = rearrange_header([BOUNDARY],@p);
- $boundary = $boundary || '------- =_aaaaaaaaaa0';
+ if (!$boundary) {
+ $boundary = '------- =_';
+ my @chrs = ('0'..'9', 'A'..'Z', 'a'..'z');
+ for (1..17) {
+ $boundary .= $chrs[rand(scalar @chrs)];
+ }
+ }
+
$self->{'separator'} = "$CRLF--$boundary$CRLF";
$self->{'final_separator'} = "$CRLF--$boundary--$CRLF";
$type = SERVER_PUSH($boundary);
@@ -1467,6 +1474,23 @@ sub header {
'EXPIRES','NPH','CHARSET',
'ATTACHMENT','P3P'],@p);
+ # CR escaping for values, per RFC 822
+ for my $header ($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) {
+ if (defined $header) {
+ # From RFC 822:
+ # Unfolding is accomplished by regarding CRLF immediately
+ # followed by a LWSP-char as equivalent to the LWSP-char.
+ $header =~ s/$CRLF(\s)/$1/g;
+
+ # All other uses of newlines are invalid input.
+ if ($header =~ m/$CRLF|\015|\012/) {
+ # shorten very long values in the diagnostic
+ $header = substr($header,0,72).'...' if (length $header > 72);
+ die "Invalid header value contains a newline not followed by whitespace: $header";
+ }
+ }
+ }
+
$nph ||= $NPH;
$type ||= 'text/html' unless defined($type);
@@ -1482,7 +1506,7 @@ sub header {
# need to fix it up a little.
for (@other) {
# Don't use \s because of perl bug 21951
- next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/;
+ next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/s;
($_ = $header) =~ s/^(\w)(.*)/"\u$1\L$2" . ': '.$self->unescapeHTML($value)/e;
}
@@ -5133,6 +5157,18 @@ In either case, the outgoing header will be formatted as:
P3P: policyref="/w3c/p3p.xml" cp="CAO DSP LAW CURa"
+Note that if a header value contains a carriage return, a leading space will be
+added to each new line that doesn't already have one as specified by RFC2616
+section 4.2. For example:
+
+ print header( -ingredients => "ham\neggs\nbacon" );
+
+will generate
+
+ Ingredients: ham
+ eggs
+ bacon
+
=head2 GENERATING A REDIRECTION HEADER
print redirect('http://somewhere.else/in/movie/land');
diff --git a/lib/CGI/t/headers.t b/lib/CGI/t/headers.t
new file mode 100644
index 0000000..661b74b
--- /dev/null
+++ b/lib/CGI/t/headers.t
@@ -0,0 +1,47 @@
+
+# Test that header generation is spec compliant.
+# References:
+# http://www.w3.org/Protocols/rfc2616/rfc2616.html
+# http://www.w3.org/Protocols/rfc822/3_Lexical.html
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use CGI;
+
+my $cgi = CGI->new;
+
+like $cgi->header( -type => "text/html" ),
+ qr#Type: text/html#, 'known header, basic case: type => "text/html"';
+
+eval { $cgi->header( -type => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'invalid header blows up');
+
+like $cgi->header( -type => "text/html".$CGI::CRLF." evil: stuff " ),
+ qr#Content-Type: text/html evil: stuff#, 'known header, with leading and trailing whitespace on the continuation line';
+
+eval { $cgi->header( -foobar => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'unknown header with CRLF embedded blows up');
+
+eval { $cgi->header( -foobar => $CGI::CRLF."Content-type: evil/header" ) };
+like($@,qr/contains a newline/, 'unknown header with leading newlines blows up');
+
+eval { $cgi->redirect( -type => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'redirect with known header with CRLF embedded blows up');
+
+eval { $cgi->redirect( -foobar => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'redirect with unknown header with CRLF embedded blows up');
+
+eval { $cgi->redirect( $CGI::CRLF.$CGI::CRLF."Content-Type: text/html") };
+like($@,qr/contains a newline/,'redirect with leading newlines blows up');
+
+{
+ my $cgi = CGI->new('t=bogus%0A%0A<html>');
+ my $out;
+ eval { $out = $cgi->redirect( $cgi->param('t') ) };
+ like($@,qr/contains a newline/, "redirect does not allow double-newline injection");
+}
+
+
diff --git a/lib/CGI/t/multipart_init.t b/lib/CGI/t/multipart_init.t
new file mode 100644
index 0000000..f0a05e0
--- /dev/null
+++ b/lib/CGI/t/multipart_init.t
@@ -0,0 +1,20 @@
+use Test::More 'no_plan';
+
+use CGI;
+
+my $q = CGI->new;
+
+my $sv = $q->multipart_init;
+like( $sv, qr|Content-Type: multipart/x-mixed-replace;boundary="------- =|, 'multipart_init(), basic');
+
+like( $sv, qr/$CGI::CRLF$/, 'multipart_init(), ends in CRLF' );
+
+$sv = $q->multipart_init( 'this_is_the_boundary' );
+like( $sv, qr/boundary="this_is_the_boundary"/, 'multipart_init("simple_boundary")' );
+$sv = $q->multipart_init( -boundary => 'this_is_another_boundary' );
+like($sv,
+ qr/boundary="this_is_another_boundary"/, "multipart_init( -boundary => 'this_is_another_boundary')");
+
+$sv = $q->multipart_init;
+my $sv2 = $q->multipart_init;
+isnt($sv,$sv2,"due to random boundaries, multiple calls produce different results");
diff --git a/lib/CGI.pm b/lib/CGI.pm
index 355b8d1..1f19560 100644
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -1457,7 +1457,14 @@ END_OF_FUNC
sub multipart_init {
my($self,@p) = self_or_default(@_);
my($boundary,@other) = rearrange_header([BOUNDARY],@p);
- $boundary = $boundary || '------- =_aaaaaaaaaa0';
+ if (!$boundary) {
+ $boundary = '------- =_';
+ my @chrs = ('0'..'9', 'A'..'Z', 'a'..'z');
+ for (1..17) {
+ $boundary .= $chrs[rand(scalar @chrs)];
+ }
+ }
+
$self->{'separator'} = "$CRLF--$boundary$CRLF";
$self->{'final_separator'} = "$CRLF--$boundary--$CRLF";
$type = SERVER_PUSH($boundary);
@@ -1545,12 +1552,19 @@ sub header {
# CR escaping for values, per RFC 822
for my $header ($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) {
if (defined $header) {
- $header =~ s/
- (?<=\n) # For any character proceeded by a newline
- (?=\S) # ... that is not whitespace
- / /xg; # ... inject a leading space in the new line
- }
- }
+ # From RFC 822:
+ # Unfolding is accomplished by regarding CRLF immediately
+ # followed by a LWSP-char as equivalent to the LWSP-char.
+ $header =~ s/$CRLF(\s)/$1/g;
+
+ # All other uses of newlines are invalid input.
+ if ($header =~ m/$CRLF|\015|\012/) {
+ # shorten very long values in the diagnostic
+ $header = substr($header,0,72).'...' if (length $header > 72);
+ die "Invalid header value contains a newline not followed by whitespace: $header";
+ }
+ }
+ }
$nph ||= $NPH;
diff --git a/t/headers.t b/t/headers.t
new file mode 100644
index 0000000..661b74b
--- /dev/null
+++ b/t/headers.t
@@ -0,0 +1,47 @@
+
+# Test that header generation is spec compliant.
+# References:
+# http://www.w3.org/Protocols/rfc2616/rfc2616.html
+# http://www.w3.org/Protocols/rfc822/3_Lexical.html
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use CGI;
+
+my $cgi = CGI->new;
+
+like $cgi->header( -type => "text/html" ),
+ qr#Type: text/html#, 'known header, basic case: type => "text/html"';
+
+eval { $cgi->header( -type => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'invalid header blows up');
+
+like $cgi->header( -type => "text/html".$CGI::CRLF." evil: stuff " ),
+ qr#Content-Type: text/html evil: stuff#, 'known header, with leading and trailing whitespace on the continuation line';
+
+eval { $cgi->header( -foobar => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'unknown header with CRLF embedded blows up');
+
+eval { $cgi->header( -foobar => $CGI::CRLF."Content-type: evil/header" ) };
+like($@,qr/contains a newline/, 'unknown header with leading newlines blows up');
+
+eval { $cgi->redirect( -type => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'redirect with known header with CRLF embedded blows up');
+
+eval { $cgi->redirect( -foobar => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'redirect with unknown header with CRLF embedded blows up');
+
+eval { $cgi->redirect( $CGI::CRLF.$CGI::CRLF."Content-Type: text/html") };
+like($@,qr/contains a newline/,'redirect with leading newlines blows up');
+
+{
+ my $cgi = CGI->new('t=bogus%0A%0A<html>');
+ my $out;
+ eval { $out = $cgi->redirect( $cgi->param('t') ) };
+ like($@,qr/contains a newline/, "redirect does not allow double-newline injection");
+}
+
+
diff --git a/t/multipart_init.t b/t/multipart_init.t
new file mode 100644
index 0000000..f0a05e0
--- /dev/null
+++ b/t/multipart_init.t
@@ -0,0 +1,20 @@
+use Test::More 'no_plan';
+
+use CGI;
+
+my $q = CGI->new;
+
+my $sv = $q->multipart_init;
+like( $sv, qr|Content-Type: multipart/x-mixed-replace;boundary="------- =|, 'multipart_init(), basic');
+
+like( $sv, qr/$CGI::CRLF$/, 'multipart_init(), ends in CRLF' );
+
+$sv = $q->multipart_init( 'this_is_the_boundary' );
+like( $sv, qr/boundary="this_is_the_boundary"/, 'multipart_init("simple_boundary")' );
+$sv = $q->multipart_init( -boundary => 'this_is_another_boundary' );
+like($sv,
+ qr/boundary="this_is_another_boundary"/, "multipart_init( -boundary => 'this_is_another_boundary')");
+
+$sv = $q->multipart_init;
+my $sv2 = $q->multipart_init;
+isnt($sv,$sv2,"due to random boundaries, multiple calls produce different results");
diff --git a/lib/CGI.pm b/lib/CGI.pm
index 9dd94d5..d6e1a80 100644
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -1559,7 +1559,7 @@ sub header {
$header =~ s/$CRLF(\s)/$1/g;
# All other uses of newlines are invalid input.
- if ($header =~ m/$CRLF/) {
+ if ($header =~ m/$CRLF|\015|\012/) {
# shorten very long values in the diagnostic
$header = substr($header,0,72).'...' if (length $header > 72);
die "Invalid header value contains a newline not followed by whitespace: $header";
diff --git a/t/headers.t b/t/headers.t
new file mode 100644
index 0000000..661b74b
--- /dev/null
+++ b/t/headers.t
@@ -0,0 +1,47 @@
+
+# Test that header generation is spec compliant.
+# References:
+# http://www.w3.org/Protocols/rfc2616/rfc2616.html
+# http://www.w3.org/Protocols/rfc822/3_Lexical.html
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use CGI;
+
+my $cgi = CGI->new;
+
+like $cgi->header( -type => "text/html" ),
+ qr#Type: text/html#, 'known header, basic case: type => "text/html"';
+
+eval { $cgi->header( -type => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'invalid header blows up');
+
+like $cgi->header( -type => "text/html".$CGI::CRLF." evil: stuff " ),
+ qr#Content-Type: text/html evil: stuff#, 'known header, with leading and trailing whitespace on the continuation line';
+
+eval { $cgi->header( -foobar => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'unknown header with CRLF embedded blows up');
+
+eval { $cgi->header( -foobar => $CGI::CRLF."Content-type: evil/header" ) };
+like($@,qr/contains a newline/, 'unknown header with leading newlines blows up');
+
+eval { $cgi->redirect( -type => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'redirect with known header with CRLF embedded blows up');
+
+eval { $cgi->redirect( -foobar => "text/html".$CGI::CRLF."evil: stuff" ) };
+like($@,qr/contains a newline/,'redirect with unknown header with CRLF embedded blows up');
+
+eval { $cgi->redirect( $CGI::CRLF.$CGI::CRLF."Content-Type: text/html") };
+like($@,qr/contains a newline/,'redirect with leading newlines blows up');
+
+{
+ my $cgi = CGI->new('t=bogus%0A%0A<html>');
+ my $out;
+ eval { $out = $cgi->redirect( $cgi->param('t') ) };
+ like($@,qr/contains a newline/, "redirect does not allow double-newline injection");
+}
+
+
diff --git a/t/multipart_init.t b/t/multipart_init.t
new file mode 100644
index 0000000..f0a05e0
--- /dev/null
+++ b/t/multipart_init.t
@@ -0,0 +1,20 @@
+use Test::More 'no_plan';
+
+use CGI;
+
+my $q = CGI->new;
+
+my $sv = $q->multipart_init;
+like( $sv, qr|Content-Type: multipart/x-mixed-replace;boundary="------- =|, 'multipart_init(), basic');
+
+like( $sv, qr/$CGI::CRLF$/, 'multipart_init(), ends in CRLF' );
+
+$sv = $q->multipart_init( 'this_is_the_boundary' );
+like( $sv, qr/boundary="this_is_the_boundary"/, 'multipart_init("simple_boundary")' );
+$sv = $q->multipart_init( -boundary => 'this_is_another_boundary' );
+like($sv,
+ qr/boundary="this_is_another_boundary"/, "multipart_init( -boundary => 'this_is_another_boundary')");
+
+$sv = $q->multipart_init;
+my $sv2 = $q->multipart_init;
+isnt($sv,$sv2,"due to random boundaries, multiple calls produce different results");
