view release on metacpan or  search on metacpan

lib/App/DubiousHTTP/Tests/Chunked.pm  view on Meta::CPAN

	if ( m{^(x|-|nl|lf|cr)*chunked(x|-|nl|lf|cr)*$}i ) {
	    s{-}{ }g;
	    s{nl}{\r\n}g;
	    s{lf}{\n}g;
	    s{cr}{\r}g;
	    $hdr .= "Transfer-Encoding: $_\r\nConnection: close\r\n";
	} elsif ( $_ eq 'huge-white-space-chunked') {
	    $hdr .= "Transfer-Encoding: ". ( ' ' x 10000 )."chunked\r\nConnection: close\r\n";
	} elsif ( m{^(space|tab|cr|colon)-colon-chunked$} ) {
	    my $c = $1;
	    $c =~s{space}{ }g;
	    $c =~s{colon}{:}g;
	    $c =~s{tab}{\t}g;
	    $c =~s{cr}{\r}g;
	    $te = 'chunked';
	    $hdr .= "Connection: close\r\nTransfer-Encoding$c: chunked\r\n"
	} elsif ( my ($crlf) = m {^((?:lf|cr|x)+)only-chunked$} ) {
	    $te = 'chunked';
	    $hdr = "X-Foo: bar" if $hdr !~s{\r\n\z}{};
	    $crlf =~s{lf}{\n}g;
	    $crlf =~s{cr}{\r}g;
	    $hdr .= $crlf . "Transfer-Encoding: chunked\r\nConnection: close\r\n";
	} elsif ( $_ eq '1chunk' ) {
	    $hdr .= "Transfer-Encoding: chunked\r\n";
	    @chunks = $data;
	} elsif ( $_ eq 'chu' ) {
	    $hdr .= "Transfer-Encoding: chu\r\nConnection: close\r\n"
	} elsif ( $_ eq 'ce-chunked' ) {
	    $hdr .= "Content-Encoding: chunked\r\nConnection: close\r\n"
	} elsif ( $_ eq 'clen-big') {
	    $clen = 1_000_000_000;
	} elsif ( $_ =~ m{^clen(\d+)?$} ) {
	    $clen = $1 || 100;
	} elsif ( $_ eq 'http10' ) {
	    $version = "HTTP/1.0";
	} elsif ( $_ =~m{^HTTP/\S+}i ) {
	    $version = $_;
	} elsif ( $_ eq 'do_clen' ) {
	    $te = 'clen'
	} elsif ( $_ eq 'do_chunked' ) {
	    $te = 'chunked'
	} elsif ( $_ eq 'chunked-semicolon' ) {
	    $hdr .= "Transfer-Encoding: chunked;\r\nConnection: close\r\n"
	} elsif ( $_ eq 'rfc2047' ) {
	    $hdr .= "Transfer-Encoding: =?UTF-8?B?Y2h1bmtlZAo=?=\r\nConnection: close\r\n";
	} elsif ( $_ eq 'emptyte' ) {
	    $hdr .= "Transfer-Encoding: \r\nConnection: close\r\n";
	} elsif ( $_ eq 'xte' ) {
	    $hdr .= "Transfer-Encoding: lalala\r\nConnection: close\r\n";
	} elsif ( m{^junk(\S*)-after-chunkdata$}) {
	    my $junk = $1 // 'x';
	    $junk =~ s{\\([0-7]{3})}{ chr(oct($1)) }eg;
	    $hdr .= "Transfer-Encoding: chunked\r\nConnection: close\r\n";
	    $chunkmod{'junk-after-chunk'} = $junk;
	} elsif ( m{^size([+-])(\d+)$}) {
	    $hdr .= "Transfer-Encoding: chunked\r\nConnection: close\r\n";
	    $chunkmod{'size-adjust'} = int("$1$2");
	} elsif ( m{^(chunk-ext-|nofinal$|eof-inchunk$)} ) {
	    $hdr .= "Transfer-Encoding: chunked\r\nConnection: close\r\n";
	    $chunkmod{$_} = 1;
	} elsif ( my ($eol) = m{^chunk-((?:lf|cr)+)$} ) {
	    $hdr .= "Transfer-Encoding: chunked\r\nConnection: close\r\n";
	    $eol =~s{cr}{\r}g;
	    $eol =~s{lf}{\n}g;
	    $chunkmod{lineend} = $eol;
	} elsif (m{^(32|64)-size\z}) {
	    my $o = ($1 == 64) ? 'ffffffff':'';
	    $sizefmt = sub { sprintf("-$o%08x", 1+(0xffffffff & ~shift())) };
	    $hdr .= "Transfer-Encoding: chunked\r\nConnection: close\r\n";
	} elsif ( m{^(-|space|cr|lf|tab|x|\\[0-7]{3})*(0*)(uc)?size(-|space|cr|lf|tab|x|\\[0-7]{3})*$}) {
	    $hdr .= "Transfer-Encoding: chunked\r\nConnection: close\r\n";
	    @chunks = ( $data =~m{(.{1,15})}smg,'') if ! @chunks;
	    s{ucsize}{%X};
	    s{size}{%x};
	    s{\\r}{\r}g;
	    s{\\n}{\n}g;
	    s{-}{}g;
	    s{space}{ }g;
	    s{tab}{\t}g;
	    s{cr}{\r}g;
	    s{lf}{\n}g;
	    s{\\([0-7]{3})}{ chr(oct($1)) }eg;
	    $sizefmt = $_;
	} elsif (m{((?:space|tab|cr|lf)*)-before-chunks}) {
	    $hdr .= "Transfer-Encoding: chunked\r\nConnection: close\r\n";
	    $before_chunks = $1;
	    $before_chunks =~ s{space}{ }g;
	    $before_chunks =~ s{tab}{\t}g;
	    $before_chunks =~ s{cr}{\r}g;
	    $before_chunks =~ s{lf}{\n}g;
	} elsif (m{^final=(.*)$}) {
	    $hdr .= "Transfer-Encoding: chunked\r\nConnection: close\r\n";
	    $final = $1;
	} elsif (m{^finalchunk=(.*)$}) {
	    $hdr .= "Transfer-Encoding: chunked\r\nConnection: close\r\n";
	    (my $d = $1 ) =~ s{\\([0-7]{3})}{ chr(oct($1)) }eg;
	    $finalchunk = $d;
	} elsif ( $_ eq 'addjunk' ) {
	    # fake PKZIP magic for confusion
	    my $junk = "PK\003\004" x int(length($data)/4+1);
	    $data .= substr($junk,0,length($data));
	} elsif ( $_ eq 'gzip' ) {
	    $data = _compress($data,'gzip');
	    $hdr .= "Content-Encoding: gzip\r\n";
	} else {
	    die $_
	}
    }
    $hdr .= "Content-length: ". int($clen/100*length($data)) ."\r\n" 
	if defined $clen;
    $hdr = "$version 200 ok\r\n$hdr";
    $te ||= $hdr =~m{^Transfer-Encoding:}im ? 'chunked':'clen';
    @chunks = ( $data =~m{(.{1,5})}smg,'') if $te eq 'chunked' && ! @chunks;
    if (@chunks) {
	@chunks = map { [ length($_), $_ ] } @chunks;
	my $nl = $chunkmod{lineend} || "\r\n";
	if ($chunkmod{'chunk-ext-chunk'}) {
	    $_->[2] = sprintf("; %s  %x","x" x $_->[0],$_->[0]) for @chunks;
	} elsif ($chunkmod{'chunk-ext-junk'}) {
	    $_->[2] = "; foobar" for @chunks;
	}
	pop @chunks if $chunkmod{nofinal} && ! $chunks[-1][0];

	my $end = '';
	if ($chunkmod{'eof-inchunk'}) {