← Back to branch summary

~ubuntu-branches/ubuntu/precise/perl/precise

« back to all changes in this revision

Viewing changes to cpan/CGI/lib/CGI.pm

  • Committer: Bazaar Package Importer
  • Author(s): Niko Tyni
  • Date: 2011-02-06 11:31:38 UTC
  • mto: (8.2.12 experimental) (1.1.12)
  • mto: This revision was merged to the branch mainline in revision 46.
  • Revision ID: james.westby@ubuntu.com-20110206113138-lzpm3g6rur7i3eyp
Tags: upstream-5.12.3
Import upstream version 5.12.3

Show diffs side-by-side

added added

removed removed

Lines of Context:
cpan/CGI/lib/CGI.pm
1457
1457
sub multipart_init {
1458
1458
    my($self,@p) = self_or_default(@_);
1459
1459
    my($boundary,@other) = rearrange_header([BOUNDARY],@p);
1460
 
    $boundary = $boundary || '------- =_aaaaaaaaaa0';
 
1460
    if (!$boundary) {
 
1461
        $boundary = '------- =_';
 
1462
        my @chrs = ('0'..'9', 'A'..'Z', 'a'..'z');
 
1463
        for (1..17) {
 
1464
            $boundary .= $chrs[rand(scalar @chrs)];
 
1465
        }
 
1466
    }
 
1467
 
1461
1468
    $self->{'separator'} = "$CRLF--$boundary$CRLF";
1462
1469
    $self->{'final_separator'} = "$CRLF--$boundary--$CRLF";
1463
1470
    $type = SERVER_PUSH($boundary);
1545
1552
    # CR escaping for values, per RFC 822
1546
1553
    for my $header ($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) {
1547
1554
        if (defined $header) {
1548
 
            $header =~ s/
1549
 
                (?<=\n)    # For any character proceeded by a newline
1550
 
                (?=\S)     # ... that is not whitespace
1551
 
            / /xg;         # ... inject a leading space in the new line
1552
 
        }
1553
 
    }
 
1555
            # From RFC 822:
 
1556
            # Unfolding  is  accomplished  by regarding   CRLF   immediately
 
1557
            # followed  by  a  LWSP-char  as equivalent to the LWSP-char.
 
1558
            $header =~ s/$CRLF(\s)/$1/g;
 
1559
 
 
1560
            # All other uses of newlines are invalid input. 
 
1561
            if ($header =~ m/$CRLF|\015|\012/) {
 
1562
                # shorten very long values in the diagnostic
 
1563
                $header = substr($header,0,72).'...' if (length $header > 72);
 
1564
                die "Invalid header value contains a newline not followed by whitespace: $header";
 
1565
            }
 
1566
        } 
 
1567
   }
1554
1568
 
1555
1569
    $nph     ||= $NPH;
1556
1570