t/chunked.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Config;
   7 use HTTP::Daemon;
   8 use Test::More;
   9 # use Time::HiRes qw(sleep);
  10 our $CRLF;
  11 use Socket qw($CRLF);
  12
  13 our $LOGGING = 0;
  14
  15 our @TESTS = (
  16               {
  17                expect => 629,
  18                comment => "traditional, unchunked POST request",
  19                raw => "POST /cgi-bin/redir-TE.pl HTTP/1.1
  20 User-Agent: UNTRUSTED/1.0
  21 Content-Type: application/x-www-form-urlencoded
  22 Content-Length: 629
  23 Host: localhost
  24
  25 JSR-205=0;font_small=15;png=1;jpg=1;alpha_channel=256;JSR-82=0;JSR-135=1;mot-wt=0;JSR-75-pim=0;pointer_motion_event=0;camera=1;free_memory=455472;heap_size=524284;cldc=CLDC-1.1;canvas_size_y=176;canvas_size_x=176;double_buffered=1;color=65536;JSR-120=1;JSR-184=1;JSR-180=0;JSR-75-file=0;push_socket=0;pointer_event=0;nokia-ui=1;java_platform=xxxxxxxxxxxxxxxxx/xxxxxxx;gif=1;midp=MIDP-1.0 MIDP-2.0;font_large=22;sie-col-game=0;JSR-179=0;push_sms=1;JSR-172=0;font_medium=18;fullscreen_canvas_size_y=220;fullscreen_canvas_size_x=176;java_locale=de;video_encoding=encoding=JPEG&width=176&height=182encoding=JPEG&width=176&height=220;"
  26               },
  27               {
  28                expect => 8,
  29                comment => "chunked with illegal Content-Length header; tiny message",
  30                raw => "POST /cgi-bin/redir-TE.pl HTTP/1.1
  31 Host: localhost
  32 Content-Type: application/x-www-form-urlencoded
  33 Content-Length: 8
  34 Transfer-Encoding: chunked
  35
  36 8
  37 icm.x=u2
  38 0
  39
  40 ",
  41               },
  42               {
  43                expect => 868,
  44                comment => "chunked with illegal Content-Length header; medium sized",
  45                raw => "POST /cgi-bin/redir-TE.pl HTTP/1.1
  46 Host:dev05
  47 Connection:close
  48 Content-Type:application/x-www-form-urlencoded
  49 Content-Length:868
  50 transfer-encoding:chunked
  51
  52 364
  53 JSR-205=0;font_small=20;png=1;jpg=1;JSR-82=0;JSR-135=1;mot-wt=0;JSR-75-pim=0;http=1;pointer_motion_event=0;browser_launch=1;free_memory=733456;user_agent=xxxxxxxxx/xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx;heap_size=815080;cldc=CLDC-1.0;canvas_size_y=182;canvas_size_x=176;double_buffered=1;NAVIGATION PRESS=20;JSR-184=0;JSR-120=1;color=32768;JSR-180=0;JSR-75-file=0;RIGHT SOFT KEY=22;NAVIGATION RIGHT=5;KEY *=42;push_socket=0;pointer_event=0;KEY #=35;KEY NUM 9=57;nokia-ui=0;KEY NUM 8=56;KEY NUM 7=55;KEY NUM 6=54;KEY NUM 5=53;gif=1;KEY NUM 4=52;NAVIGATION UP=1;KEY NUM 3=51;KEY NUM 2=50;KEY NUM 1=49;midp=MIDP-2.0 VSCL-1.1.0;font_large=20;KEY NUM 0=48;sie-col-game=0;JSR-179=0;push_sms=1;JSR-172=0;NAVIGATION LEFT=2;LEFT SOFT KEY=21;font_medium=20;fullscreen_canvas_size_y=204;fullscreen_canvas_size_x=176;https=1;NAVIGATION DOWN=6;java_locale=en-DE;
  54 0
  55
  56 ",
  57               },
  58               {
  59                expect => 1104,
  60                comment => "chunked correctly, size ~1k; base for the big next test",
  61                raw => "POST /cgi-bin/redir-TE.pl HTTP/1.1
  62 User-Agent: UNTRUSTED/1.0
  63 Content-Type: application/x-www-form-urlencoded
  64 Host: localhost:80
  65 Transfer-Encoding: chunked
  66
  67 450
  68 JSR-205=0;font_small=15;png=1;jpg=1;jsr184_dithering=0;CLEAR/DELETE=-8;JSR-82=0;alpha_channel=32;JSR-135=1;mot-wt=0;JSR-75-pim=0;http=1;pointer_motion_event=0;browser_launch=1;BACK/RETURN=-11;camera=1;free_memory=456248;user_agent=xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx;heap_size=524284;cldc=CLDC-1.1;canvas_size_y=176;canvas_size_x=176;double_buffered=1;NAVIGATION PRESS=-5;JSR-184=1;JSR-120=1;color=65536;JSR-180=0;JSR-75-file=0;RIGHT SOFT KEY=-7;NAVIGATION RIGHT=-4;KEY *=42;push_socket=0;pointer_event=0;KEY #=35;KEY NUM 9=57;nokia-ui=1;KEY NUM 8=56;KEY NUM 7=55;KEY NUM 6=54;KEY NUM 5=53;java_platform=xxxxxxxxxxxxxxxxx/xxxxxxx;KEY NUM 4=52;gif=1;KEY NUM 3=51;NAVIGATION UP=-1;KEY NUM 2=50;KEY NUM 1=49;midp=MIDP-1.0 MIDP-2.0;font_large=22;KEY NUM 0=48;sie-col-game=0;JSR-179=0;push_sms=1;JSR-172=0;NAVIGATION LEFT=-3;LEFT SOFT KEY=-6;jsr184_antialiasing=0;font_medium=18;fullscreen_canvas_size_y=220;fullscreen_canvas_size_x=176;https=1;NAVIGATION DOWN=-2;java_locale=de;video_encoding=encoding=JPEG&width=176&height=182encoding=JPEG&width=176&height=220;
  69 0
  70
  71 "
  72               },
  73               {
  74                expect => 1104*1024,
  75                comment => "chunked with many chunks",
  76                raw => ("POST /cgi-bin/redir-TE.pl HTTP/1.1
  77 User-Agent: UNTRUSTED/1.0
  78 Content-Type: application/x-www-form-urlencoded
  79 Host: localhost:80
  80 Transfer-Encoding: chunked
  81
  82 ".("450
  83 JSR-205=0;font_small=15;png=1;jpg=1;jsr184_dithering=0;CLEAR/DELETE=-8;JSR-82=0;alpha_channel=32;JSR-135=1;mot-wt=0;JSR-75-pim=0;http=1;pointer_motion_event=0;browser_launch=1;BACK/RETURN=-11;camera=1;free_memory=456248;user_agent=xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx;heap_size=524284;cldc=CLDC-1.1;canvas_size_y=176;canvas_size_x=176;double_buffered=1;NAVIGATION PRESS=-5;JSR-184=1;JSR-120=1;color=65536;JSR-180=0;JSR-75-file=0;RIGHT SOFT KEY=-7;NAVIGATION RIGHT=-4;KEY *=42;push_socket=0;pointer_event=0;KEY #=35;KEY NUM 9=57;nokia-ui=1;KEY NUM 8=56;KEY NUM 7=55;KEY NUM 6=54;KEY NUM 5=53;java_platform=xxxxxxxxxxxxxxxxx/xxxxxxx;KEY NUM 4=52;gif=1;KEY NUM 3=51;NAVIGATION UP=-1;KEY NUM 2=50;KEY NUM 1=49;midp=MIDP-1.0 MIDP-2.0;font_large=22;KEY NUM 0=48;sie-col-game=0;JSR-179=0;push_sms=1;JSR-172=0;NAVIGATION LEFT=-3;LEFT SOFT KEY=-6;jsr184_antialiasing=0;font_medium=18;fullscreen_canvas_size_y=220;fullscreen_canvas_size_x=176;https=1;NAVIGATION DOWN=-2;java_locale=de;video_encoding=encoding=JPEG&width=176&height=182encoding=JPEG&width=176&height=220;
  84 "x1024)."0
  85
  86 ")
  87               },
  88              );
  89
  90
  91 my $can_fork = $Config{d_fork} ||
  92   (($^O eq 'MSWin32' || $^O eq 'NetWare') and
  93    $Config{useithreads} and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/);
  94
  95 my $tests = @TESTS;
  96 my $tport = 8333;
  97
  98 my $tsock = IO::Socket::INET->new(LocalAddr => '0.0.0.0',
  99                                   LocalPort => $tport,
 100                                   Listen    => 1,
 101                                   ReuseAddr => 1);
 102 if (!$can_fork) {
 103   plan skip_all => "This system cannot fork";
 104 }
 105 elsif (!$tsock) {
 106   plan skip_all => "Cannot listen on 0.0.0.0:$tport";
 107 }
 108 else {
 109   close $tsock;
 110   plan tests => $tests;
 111 }
 112
 113 sub mywarn ($) {
 114   return unless $LOGGING;
 115   my($mess) = @_;
 116   open my $fh, ">>", "http-daemon.out"
 117     or die $!;
 118   my $ts = localtime;
 119   print $fh "$ts: $mess\n";
 120   close $fh or die $!;
 121 }
 122
 123
 124 my $pid;
 125 if ($pid = fork) {
 126   sleep 4;
 127   for my $t (0..$#TESTS) {
 128     my $test = $TESTS[$t];
 129     my $raw = $test->{raw};
 130     $raw =~ s/\r?\n/$CRLF/mg;
 131     if (0) {
 132       open my $fh, "| socket localhost $tport" or die;
 133       print $fh $test;
 134     }
 135     use IO::Socket::INET;
 136     my $sock = IO::Socket::INET->new(
 137                                      PeerAddr => "127.0.0.1",
 138                                      PeerPort => $tport,
 139                                     ) or die;
 140     if (0) {
 141       for my $pos (0..length($raw)-1) {
 142         print $sock substr($raw,$pos,1);
 143         sleep 0.001;
 144       }
 145     } else {
 146       print $sock $raw;
 147     }
 148     local $/;
 149     my $resp = <$sock>;
 150     close $sock;
 151     my($got) = $resp =~ /\r?\n\r?\n(\d+)/s;
 152     is($got,
 153        $test->{expect},
 154        "[$test->{expect}] $test->{comment}",
 155       );
 156   }
 157   wait;
 158 } else {
 159   die "cannot fork: $!" unless defined $pid;
 160   my $d = HTTP::Daemon->new(
 161                             LocalAddr => '0.0.0.0',
 162                             LocalPort => $tport,
 163                             ReuseAddr => 1,
 164                            ) or die;
 165   mywarn "Starting new daemon as '$$'";
 166   my $i;
 167   LISTEN: while (my $c = $d->accept) {
 168     my $r = $c->get_request;
 169     mywarn sprintf "headers[%s] content[%s]", $r->headers->as_string, $r->content;
 170     my $res = HTTP::Response->new(200,undef,undef,length($r->content).$CRLF);
 171     $c->send_response($res);
 172     $c->force_last_request; # we're just not mature enough
 173     $c->close;
 174     undef($c);
 175     last if ++$i >= $tests;
 176   }
 177 }
 178
 179
 180
 181 # Local Variables:
 182 # mode: cperl
 183 # cperl-indent-level: 2
 184 # End: