Michael Schröder
0d08f6dda3
OBS-URL: https://build.opensuse.org/package/show/devel:languages:perl/perl?expand=0&rev=53
40 lines
1.7 KiB
Diff
40 lines
1.7 KiB
Diff
--- ./cpan/CGI/lib/CGI.pm.orig 2010-05-07 13:34:10.000000000 +0000
|
|
+++ ./cpan/CGI/lib/CGI.pm 2011-01-12 11:35:33.000000000 +0000
|
|
@@ -1457,7 +1457,13 @@ 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,10 +1551,17 @@ 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";
|
|
+ }
|
|
}
|
|
}
|
|
|