Sophie

Sophie

distrib > Mandriva > mes5 > x86_64 > by-pkgid > 18ad7f482863a20c39b5a8b8f9e6e20e > files > 2

perl-CGI-Simple-1.1-4.2mdvmes5.1.src.rpm


https://github.com/markstos/CGI--Simple/commit/11da64d9ba985e3307bc9f6a1fbe44b013a8777a

--- lib/CGI/Simple.pm	2010-12-14 06:09:03.000000000 -0500
+++ lib/CGI/Simple.pm.oden	2010-12-14 06:08:28.000000000 -0500
@@ -954,6 +954,29 @@ sub header {
         ],
         @params
       );
+
+  my $CRLF = $self->crlf;
+
+  # 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/) {
+                # 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 ||= $self->{'.globals'}->{'NPH'};
     $charset = $self->charset( $charset )
       ;    # get charset (and set new charset if supplied)
--- /dev/null	2010-11-18 11:14:13.401250884 -0500
+++ t/headers.t	2010-12-14 06:14:51.000000000 -0500
@@ -0,0 +1,44 @@
+
+# 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::Simple;
+
+my $cgi = CGI::Simple->new;
+
+like $cgi->header( -type => "text/html" ),
+    qr#Type: text/html#, 'known header, basic case: type => "text/html"';
+
+eval { like $cgi->header( -type => "text/html".$cgi->crlf."evil: stuff" ),
+    qr#Type: text/html evil: stuff#, 'known header'; };
+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 { like $cgi->header( -foobar => "text/html".$cgi->crlf."evil: stuff" ),
+    qr#Foobar: text/htmlevil: stuff#, 'unknown header'; };
+like($@,qr/contains a newline/,'unknown header with CRLF embedded blows up');
+
+like $cgi->header( -foobar => "Content-type: evil/header" ),
+    qr#^Foobar: Content-type: evil/header#m, 'unknown header with leading newlines';
+
+eval { like $cgi->redirect( -type => "text/html".$cgi->crlf."evil: stuff" ),
+    qr#Type: text/htmlevil: stuff#, 'redirect w/ known header'; };
+like($@,qr/contains a newline/,'redirect with known header with CRLF embedded blows up');
+
+eval { like $cgi->redirect( -foobar => "text/html".$cgi->crlf."evil: stuff" ),
+    qr#Foobar: text/htmlevil: stuff#, 'redirect w/ unknown header'; };
+like($@,qr/contains a newline/,'redirect with unknown header with CRLF embedded blows up');
+
+eval { like $cgi->redirect( $cgi->crlf.$cgi->crlf."Content-Type: text/html"),
+    qr#Location: Content-Type#, 'redirect w/ leading newline '; };
+like($@,qr/contains a newline/,'redirect with leading newlines blows up');
+