t/integration.t

   1 #!perl -w
   2 # Copyright (C) unicorn hackers <unicorn-public@yhbt.net>
   3 # License: GPL-3.0+ <https://www.gnu.org/licenses/gpl-3.0.txt>
   4
   5 # This is the main integration test for fast-ish things to minimize
   6 # Ruby startup time penalties.
   7
   8 use v5.14; BEGIN { require './t/lib.perl' };
   9 use autodie;
  10 my $srv = tcp_server();
  11 my $host_port = tcp_host_port($srv);
  12 my $t0 = time;
  13 my $conf = "$tmpdir/u.conf.rb";
  14 open my $conf_fh, '>', $conf;
  15 $conf_fh->autoflush(1);
  16 my $ar = unicorn(qw(-E none t/integration.ru -c), $conf, { 3 => $srv });
  17 my $curl = which('curl');
  18 END { diag slurp("$tmpdir/err.log") if $tmpdir };
  19 sub slurp_hdr {
  20         my ($c) = @_;
  21         local $/ = "\r\n\r\n"; # affects both readline+chomp
  22         chomp(my $hdr = readline($c));
  23         my ($status, @hdr) = split(/\r\n/, $hdr);
  24         diag explain([ $status, \@hdr ]) if $ENV{V};
  25         ($status, \@hdr);
  26 }
  27
  28 my %PUT = (
  29         chunked_md5 => sub {
  30                 my ($in, $out, $path, %opt) = @_;
  31                 my $bs = $opt{bs} // 16384;
  32                 require Digest::MD5;
  33                 my $dig = Digest::MD5->new;
  34                 print $out <<EOM;
  35 PUT $path HTTP/1.1\r
  36 Transfer-Encoding: chunked\r
  37 Trailer: Content-MD5\r
  38 \r
  39 EOM
  40                 my ($buf, $r);
  41                 while (1) {
  42                         $r = read($in, $buf, $bs);
  43                         last if $r == 0;
  44                         printf $out "%x\r\n", length($buf);
  45                         print $out $buf, "\r\n";
  46                         $dig->add($buf);
  47                 }
  48                 print $out "0\r\nContent-MD5: ", $dig->b64digest, "\r\n\r\n";
  49         },
  50         identity => sub {
  51                 my ($in, $out, $path, %opt) = @_;
  52                 my $bs = $opt{bs} // 16384;
  53                 my $clen = $opt{-s} // -s $in;
  54                 print $out <<EOM;
  55 PUT $path HTTP/1.0\r
  56 Content-Length: $clen\r
  57 \r
  58 EOM
  59                 my ($buf, $r, $len);
  60                 while ($clen) {
  61                         $len = $clen > $bs ? $bs : $clen;
  62                         $r = read($in, $buf, $len);
  63                         die 'premature EOF' if $r == 0;
  64                         print $out $buf;
  65                         $clen -= $r;
  66                 }
  67         },
  68 );
  69
  70 my ($c, $status, $hdr);
  71
  72 # response header tests
  73 $c = start_req($srv, 'GET /rack-2-newline-headers HTTP/1.0');
  74 ($status, $hdr) = slurp_hdr($c);
  75 like($status, qr!\AHTTP/1\.[01] 200\b!, 'status line valid');
  76 my $orig_200_status = $status;
  77 is_deeply([ grep(/^X-R2: /, @$hdr) ],
  78         [ 'X-R2: a', 'X-R2: b', 'X-R2: c' ],
  79         'rack 2 LF-delimited headers supported') or diag(explain($hdr));
  80
  81 SKIP: { # Date header check
  82         my @d = grep(/^Date: /i, @$hdr);
  83         is(scalar(@d), 1, 'got one date header') or diag(explain(\@d));
  84         eval { require HTTP::Date } or skip "HTTP::Date missing: $@", 1;
  85         $d[0] =~ s/^Date: //i or die 'BUG: did not strip date: prefix';
  86         my $t = HTTP::Date::str2time($d[0]);
  87         ok($t >= $t0 && $t > 0 && $t <= time, 'valid date') or
  88                 diag(explain([$t, $!, \@d]));
  89 };
  90
  91
  92 $c = start_req($srv, 'GET /rack-3-array-headers HTTP/1.0');
  93 ($status, $hdr) = slurp_hdr($c);
  94 is_deeply([ grep(/^x-r3: /, @$hdr) ],
  95         [ 'x-r3: a', 'x-r3: b', 'x-r3: c' ],
  96         'rack 3 array headers supported') or diag(explain($hdr));
  97
  98 SKIP: {
  99         eval { require JSON::PP } or skip "JSON::PP missing: $@", 1;
 100         my $c = start_req($srv, 'GET /env_dump');
 101         my $json = do { local $/; readline($c) };
 102         unlike($json, qr/^Connection: /smi, 'no connection header for 0.9');
 103         unlike($json, qr!\AHTTP/!s, 'no HTTP/1.x prefix for 0.9');
 104         my $env = JSON::PP->new->decode($json);
 105         is(ref($env), 'HASH', 'JSON decoded body to hashref');
 106         is($env->{SERVER_PROTOCOL}, 'HTTP/0.9', 'SERVER_PROTOCOL is 0.9');
 107 }
 108
 109 # cf. <CAO47=rJa=zRcLn_Xm4v2cHPr6c0UswaFC_omYFEH+baSxHOWKQ@mail.gmail.com>
 110 $c = start_req($srv, 'GET /nil-header-value HTTP/1.0');
 111 ($status, $hdr) = slurp_hdr($c);
 112 is_deeply([grep(/^X-Nil:/, @$hdr)], ['X-Nil: '],
 113         'nil header value accepted for broken apps') or diag(explain($hdr));
 114
 115 if ('TODO: ensure Rack::Utils::HTTP_STATUS_CODES is available') {
 116         $c = start_req($srv, 'POST /tweak-status-code HTTP/1.0');
 117         ($status, $hdr) = slurp_hdr($c);
 118         like($status, qr!\AHTTP/1\.[01] 200 HI\b!, 'status tweaked');
 119
 120         $c = start_req($srv, 'POST /restore-status-code HTTP/1.0');
 121         ($status, $hdr) = slurp_hdr($c);
 122         is($status, $orig_200_status, 'original status restored');
 123 }
 124
 125 SKIP: {
 126         eval { require HTTP::Tiny } or skip "HTTP::Tiny missing: $@", 1;
 127         my $ht = HTTP::Tiny->new;
 128         my $res = $ht->get("http://$host_port/write_on_close");
 129         is($res->{content}, 'Goodbye', 'write-on-close body read');
 130 }
 131
 132 if ('bad requests') {
 133         $c = start_req($srv, 'GET /env_dump HTTP/1/1');
 134         ($status, $hdr) = slurp_hdr($c);
 135         like($status, qr!\AHTTP/1\.[01] 400 \b!, 'got 400 on bad request');
 136
 137         $c = tcp_connect($srv);
 138         print $c 'GET /';
 139         my $buf = join('', (0..9), 'ab');
 140         for (0..1023) { print $c $buf }
 141         print $c " HTTP/1.0\r\n\r\n";
 142         ($status, $hdr) = slurp_hdr($c);
 143         like($status, qr!\AHTTP/1\.[01] 414 \b!,
 144                 '414 on REQUEST_PATH > (12 * 1024)');
 145
 146         $c = tcp_connect($srv);
 147         print $c 'GET /hello-world?a';
 148         $buf = join('', (0..9));
 149         for (0..1023) { print $c $buf }
 150         print $c " HTTP/1.0\r\n\r\n";
 151         ($status, $hdr) = slurp_hdr($c);
 152         like($status, qr!\AHTTP/1\.[01] 414 \b!,
 153                 '414 on QUERY_STRING > (10 * 1024)');
 154
 155         $c = tcp_connect($srv);
 156         print $c 'GET /hello-world#a';
 157         $buf = join('', (0..9), 'a'..'f');
 158         for (0..63) { print $c $buf }
 159         print $c " HTTP/1.0\r\n\r\n";
 160         ($status, $hdr) = slurp_hdr($c);
 161         like($status, qr!\AHTTP/1\.[01] 414 \b!, '414 on FRAGMENT > (1024)');
 162 }
 163
 164 # input tests
 165 my ($blob_size, $blob_hash);
 166 SKIP: {
 167         CORE::open(my $rh, '<', 't/random_blob') or
 168                 skip "t/random_blob not generated $!", 1;
 169         $blob_size = -s $rh;
 170         require Digest::SHA;
 171         $blob_hash = Digest::SHA->new(1)->addfile($rh)->hexdigest;
 172
 173         my $ck_hash = sub {
 174                 my ($sub, $path, %opt) = @_;
 175                 seek($rh, 0, SEEK_SET);
 176                 $c = tcp_connect($srv);
 177                 $c->autoflush(0);
 178                 $PUT{$sub}->($rh, $c, $path, %opt);
 179                 $c->flush or die $!;
 180                 ($status, $hdr) = slurp_hdr($c);
 181                 is(readline($c), $blob_hash, "$sub $path");
 182         };
 183         $ck_hash->('identity', '/rack_input', -s => $blob_size);
 184         $ck_hash->('chunked_md5', '/rack_input');
 185         $ck_hash->('identity', '/rack_input/size_first', -s => $blob_size);
 186         $ck_hash->('identity', '/rack_input/rewind_first', -s => $blob_size);
 187         $ck_hash->('chunked_md5', '/rack_input/size_first');
 188         $ck_hash->('chunked_md5', '/rack_input/rewind_first');
 189
 190
 191         $curl // skip 'no curl found in PATH', 1;
 192
 193         my ($copt, $cout);
 194         my $url = "http://$host_port/rack_input";
 195         my $do_curl = sub {
 196                 my (@arg) = @_;
 197                 pipe(my $cout, $copt->{1});
 198                 open $copt->{2}, '>', "$tmpdir/curl.err";
 199                 my $cpid = spawn($curl, '-sSf', @arg, $url, $copt);
 200                 close(delete $copt->{1});
 201                 is(readline($cout), $blob_hash, "curl @arg response");
 202                 is(waitpid($cpid, 0), $cpid, "curl @arg exited");
 203                 is($?, 0, "no error from curl @arg");
 204                 is(slurp("$tmpdir/curl.err"), '', "no stderr from curl @arg");
 205         };
 206
 207         $do_curl->(qw(-T t/random_blob));
 208
 209         seek($rh, 0, SEEK_SET);
 210         $copt->{0} = $rh;
 211         $do_curl->('-T-');
 212 }
 213
 214
 215 # ... more stuff here
 216
 217 # SIGHUP-able stuff goes here
 218
 219 if ('max_header_len internal API') {
 220         undef $c;
 221         my $req = 'GET / HTTP/1.0';
 222         my $len = length($req."\r\n\r\n");
 223         my $fifo = "$tmpdir/fifo";
 224         POSIX::mkfifo($fifo, 0600) or die "mkfifo: $!";
 225         print $conf_fh <<EOM;
 226 Unicorn::HttpParser.max_header_len = $len
 227 listen "$host_port" # TODO: remove this requirement for SIGHUP
 228 after_fork { |_,_| File.open('$fifo', 'w') { |fp| fp.write "pid=#\$\$" } }
 229 EOM
 230         $ar->do_kill('HUP');
 231         open my $fifo_fh, '<', $fifo;
 232         my $wpid = readline($fifo_fh);
 233         like($wpid, qr/\Apid=\d+\z/a , 'new worker ready');
 234         close $fifo_fh;
 235         $wpid =~ s/\Apid=// or die;
 236         ok(CORE::kill(0, $wpid), 'worker PID retrieved');
 237
 238         $c = start_req($srv, $req);
 239         ($status, $hdr) = slurp_hdr($c);
 240         like($status, qr!\AHTTP/1\.[01] 200\b!, 'minimal request succeeds');
 241
 242         $c = start_req($srv, 'GET /xxxxxx HTTP/1.0');
 243         ($status, $hdr) = slurp_hdr($c);
 244         like($status, qr!\AHTTP/1\.[01] 413\b!, 'big request fails');
 245 }
 246
 247
 248 undef $ar;
 249
 250 check_stderr;
 251
 252 undef $tmpdir;
 253 done_testing;