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 <j...@debian.org> 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 nt...@debian.org
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");