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 our $srv = tcp_server();
  11 our $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 $u1 = "$tmpdir/u1";
  17 print $conf_fh <<EOM;
  18 early_hints true
  19 listen "$u1"
  20 EOM
  21 my $ar = unicorn(qw(-E none t/integration.ru -c), $conf, { 3 => $srv });
  22 my $curl = which('curl');
  23 my $fifo = "$tmpdir/fifo";
  24 POSIX::mkfifo($fifo, 0600) or die "mkfifo: $!";
  25 my %PUT = (
  26         chunked_md5 => sub {
  27                 my ($in, $out, $path, %opt) = @_;
  28                 my $dig = Digest::MD5->new;
  29                 print $out <<EOM;
  30 PUT $path HTTP/1.1\r
  31 Transfer-Encoding: chunked\r
  32 Trailer: Content-MD5\r
  33 \r
  34 EOM
  35                 my ($buf, $r);
  36                 while (1) {
  37                         $r = read($in, $buf, 999 + int(rand(0xffff)));
  38                         last if $r == 0;
  39                         printf $out "%x\r\n", length($buf);
  40                         print $out $buf, "\r\n";
  41                         $dig->add($buf);
  42                 }
  43                 print $out "0\r\nContent-MD5: ", $dig->b64digest, "\r\n\r\n";
  44         },
  45         identity => sub {
  46                 my ($in, $out, $path, %opt) = @_;
  47                 my $clen = $opt{-s} // -s $in;
  48                 print $out <<EOM;
  49 PUT $path HTTP/1.0\r
  50 Content-Length: $clen\r
  51 \r
  52 EOM
  53                 my ($buf, $r, $len, $bs);
  54                 while ($clen) {
  55                         $bs = 999 + int(rand(0xffff));
  56                         $len = $clen > $bs ? $bs : $clen;
  57                         $r = read($in, $buf, $len);
  58                         die 'premature EOF' if $r == 0;
  59                         print $out $buf;
  60                         $clen -= $r;
  61                 }
  62         },
  63 );
  64
  65 my ($c, $status, $hdr);
  66
  67 # response header tests
  68 $c = tcp_start($srv, 'GET /rack-2-newline-headers HTTP/1.0');
  69 ($status, $hdr) = slurp_hdr($c);
  70 like($status, qr!\AHTTP/1\.[01] 200\b!, 'status line valid');
  71 my $orig_200_status = $status;
  72 is_deeply([ grep(/^X-R2: /, @$hdr) ],
  73         [ 'X-R2: a', 'X-R2: b', 'X-R2: c' ],
  74         'rack 2 LF-delimited headers supported') or diag(explain($hdr));
  75
  76 SKIP: { # Date header check
  77         my @d = grep(/^Date: /i, @$hdr);
  78         is(scalar(@d), 1, 'got one date header') or diag(explain(\@d));
  79         eval { require HTTP::Date } or skip "HTTP::Date missing: $@", 1;
  80         $d[0] =~ s/^Date: //i or die 'BUG: did not strip date: prefix';
  81         my $t = HTTP::Date::str2time($d[0]);
  82         ok($t >= $t0 && $t > 0 && $t <= time, 'valid date') or
  83                 diag(explain([$t, $!, \@d]));
  84 };
  85
  86
  87 $c = tcp_start($srv, 'GET /rack-3-array-headers HTTP/1.0');
  88 ($status, $hdr) = slurp_hdr($c);
  89 is_deeply([ grep(/^x-r3: /, @$hdr) ],
  90         [ 'x-r3: a', 'x-r3: b', 'x-r3: c' ],
  91         'rack 3 array headers supported') or diag(explain($hdr));
  92
  93 SKIP: {
  94         eval { require JSON::PP } or skip "JSON::PP missing: $@", 1;
  95         my $c = tcp_start($srv, 'GET /env_dump');
  96         my $json = do { local $/; readline($c) };
  97         unlike($json, qr/^Connection: /smi, 'no connection header for 0.9');
  98         unlike($json, qr!\AHTTP/!s, 'no HTTP/1.x prefix for 0.9');
  99         my $env = JSON::PP->new->decode($json);
 100         is(ref($env), 'HASH', 'JSON decoded body to hashref');
 101         is($env->{SERVER_PROTOCOL}, 'HTTP/0.9', 'SERVER_PROTOCOL is 0.9');
 102 }
 103
 104 # cf. <CAO47=rJa=zRcLn_Xm4v2cHPr6c0UswaFC_omYFEH+baSxHOWKQ@mail.gmail.com>
 105 $c = tcp_start($srv, 'GET /nil-header-value HTTP/1.0');
 106 ($status, $hdr) = slurp_hdr($c);
 107 is_deeply([grep(/^X-Nil:/, @$hdr)], ['X-Nil: '],
 108         'nil header value accepted for broken apps') or diag(explain($hdr));
 109
 110 my $ck_early_hints = sub {
 111         my ($note) = @_;
 112         $c = unix_start($u1, 'GET /early_hints_rack2 HTTP/1.0');
 113         ($status, $hdr) = slurp_hdr($c);
 114         like($status, qr!\AHTTP/1\.[01] 103\b!, 'got 103 for rack 2 value');
 115         is_deeply(['link: r', 'link: 2'], $hdr, 'rack 2 hints match '.$note);
 116         ($status, $hdr) = slurp_hdr($c);
 117         like($status, qr!\AHTTP/1\.[01] 200\b!, 'got 200 afterwards');
 118         is(readline($c), 'String', 'early hints used a String for rack 2');
 119
 120         $c = unix_start($u1, 'GET /early_hints_rack3 HTTP/1.0');
 121         ($status, $hdr) = slurp_hdr($c);
 122         like($status, qr!\AHTTP/1\.[01] 103\b!, 'got 103 for rack 3');
 123         is_deeply(['link: r', 'link: 3'], $hdr, 'rack 3 hints match '.$note);
 124         ($status, $hdr) = slurp_hdr($c);
 125         like($status, qr!\AHTTP/1\.[01] 200\b!, 'got 200 afterwards');
 126         is(readline($c), 'Array', 'early hints used a String for rack 3');
 127 };
 128 $ck_early_hints->('ccc off'); # we'll retest later
 129
 130 if ('TODO: ensure Rack::Utils::HTTP_STATUS_CODES is available') {
 131         $c = tcp_start($srv, 'POST /tweak-status-code HTTP/1.0');
 132         ($status, $hdr) = slurp_hdr($c);
 133         like($status, qr!\AHTTP/1\.[01] 200 HI\b!, 'status tweaked');
 134
 135         $c = tcp_start($srv, 'POST /restore-status-code HTTP/1.0');
 136         ($status, $hdr) = slurp_hdr($c);
 137         is($status, $orig_200_status, 'original status restored');
 138 }
 139
 140 SKIP: {
 141         eval { require HTTP::Tiny } or skip "HTTP::Tiny missing: $@", 1;
 142         my $ht = HTTP::Tiny->new;
 143         my $res = $ht->get("http://$host_port/write_on_close");
 144         is($res->{content}, 'Goodbye', 'write-on-close body read');
 145 }
 146
 147 if ('bad requests') {
 148         $c = tcp_start($srv, 'GET /env_dump HTTP/1/1');
 149         ($status, $hdr) = slurp_hdr($c);
 150         like($status, qr!\AHTTP/1\.[01] 400 \b!, 'got 400 on bad request');
 151
 152         $c = tcp_start($srv);
 153         print $c 'GET /';;
 154         my $buf = join('', (0..9), 'ab');
 155         for (0..1023) { print $c $buf }
 156         print $c " HTTP/1.0\r\n\r\n";
 157         ($status, $hdr) = slurp_hdr($c);
 158         like($status, qr!\AHTTP/1\.[01] 414 \b!,
 159                 '414 on REQUEST_PATH > (12 * 1024)');
 160
 161         $c = tcp_start($srv);
 162         print $c 'GET /hello-world?a';
 163         $buf = join('', (0..9));
 164         for (0..1023) { print $c $buf }
 165         print $c " HTTP/1.0\r\n\r\n";
 166         ($status, $hdr) = slurp_hdr($c);
 167         like($status, qr!\AHTTP/1\.[01] 414 \b!,
 168                 '414 on QUERY_STRING > (10 * 1024)');
 169
 170         $c = tcp_start($srv);
 171         print $c 'GET /hello-world#a';
 172         $buf = join('', (0..9), 'a'..'f');
 173         for (0..63) { print $c $buf }
 174         print $c " HTTP/1.0\r\n\r\n";
 175         ($status, $hdr) = slurp_hdr($c);
 176         like($status, qr!\AHTTP/1\.[01] 414 \b!, '414 on FRAGMENT > (1024)');
 177 }
 178
 179 # input tests
 180 my ($blob_size, $blob_hash);
 181 SKIP: {
 182         skip 'SKIP_EXPENSIVE on', 1 if $ENV{SKIP_EXPENSIVE};
 183         CORE::open(my $rh, '<', 't/random_blob') or
 184                 skip "t/random_blob not generated $!", 1;
 185         $blob_size = -s $rh;
 186         require Digest::MD5;
 187         $blob_hash = Digest::MD5->new->addfile($rh)->hexdigest;
 188
 189         my $ck_hash = sub {
 190                 my ($sub, $path, %opt) = @_;
 191                 seek($rh, 0, SEEK_SET);
 192                 $c = tcp_start($srv);
 193                 $c->autoflush($opt{sync} // 0);
 194                 $PUT{$sub}->($rh, $c, $path, %opt);
 195                 defined($opt{overwrite}) and
 196                         print { $c } ('x' x $opt{overwrite});
 197                 $c->flush or die $!;
 198                 ($status, $hdr) = slurp_hdr($c);
 199                 is(readline($c), $blob_hash, "$sub $path");
 200         };
 201         $ck_hash->('identity', '/rack_input', -s => $blob_size);
 202         $ck_hash->('chunked_md5', '/rack_input');
 203         $ck_hash->('identity', '/rack_input/size_first', -s => $blob_size);
 204         $ck_hash->('identity', '/rack_input/rewind_first', -s => $blob_size);
 205         $ck_hash->('chunked_md5', '/rack_input/size_first');
 206         $ck_hash->('chunked_md5', '/rack_input/rewind_first');
 207
 208         $ck_hash->('identity', '/rack_input', -s => $blob_size, sync => 1);
 209         $ck_hash->('chunked_md5', '/rack_input', sync => 1);
 210
 211         # ensure small overwrites don't get checksummed
 212         $ck_hash->('identity', '/rack_input', -s => $blob_size,
 213                         overwrite => 1); # one extra byte
 214
 215         # excessive overwrite truncated
 216         $c = tcp_start($srv);
 217         $c->autoflush(0);
 218         print $c "PUT /rack_input HTTP/1.0\r\nContent-Length: 1\r\n\r\n";
 219         if (1) {
 220                 local $SIG{PIPE} = 'IGNORE';
 221                 my $buf = "\0" x 8192;
 222                 my $n = 0;
 223                 my $end = time + 5;
 224                 $! = 0;
 225                 while (print $c $buf and time < $end) { ++$n }
 226                 ok($!, 'overwrite truncated') or diag "n=$n err=$! ".time;
 227         }
 228         undef $c;
 229
 230         $curl // skip 'no curl found in PATH', 1;
 231
 232         my ($copt, $cout);
 233         my $url = "http://$host_port/rack_input";
 234         my $do_curl = sub {
 235                 my (@arg) = @_;
 236                 pipe(my $cout, $copt->{1});
 237                 open $copt->{2}, '>', "$tmpdir/curl.err";
 238                 my $cpid = spawn($curl, '-sSf', @arg, $url, $copt);
 239                 close(delete $copt->{1});
 240                 is(readline($cout), $blob_hash, "curl @arg response");
 241                 is(waitpid($cpid, 0), $cpid, "curl @arg exited");
 242                 is($?, 0, "no error from curl @arg");
 243                 is(slurp("$tmpdir/curl.err"), '', "no stderr from curl @arg");
 244         };
 245
 246         $do_curl->(qw(-T t/random_blob));
 247
 248         seek($rh, 0, SEEK_SET);
 249         $copt->{0} = $rh;
 250         $do_curl->('-T-');
 251
 252         diag 'testing Unicorn::PrereadInput...';
 253         local $srv = tcp_server();
 254         local $host_port = tcp_host_port($srv);
 255         check_stderr;
 256         truncate($errfh, 0);
 257
 258         my $pri = unicorn(qw(-E none t/preread_input.ru), { 3 => $srv });
 259         $url = "http://$host_port/";
 260
 261         $do_curl->(qw(-T t/random_blob));
 262         seek($rh, 0, SEEK_SET);
 263         $copt->{0} = $rh;
 264         $do_curl->('-T-');
 265
 266         my @pr_err = slurp("$tmpdir/err.log");
 267         is(scalar(grep(/app dispatch:/, @pr_err)), 2, 'app dispatched twice');
 268
 269         # abort a chunked request by blocking curl on a FIFO:
 270         $c = tcp_start($srv, "PUT / HTTP/1.1\r\nTransfer-Encoding: chunked");
 271         close $c;
 272         @pr_err = slurp("$tmpdir/err.log");
 273         is(scalar(grep(/app dispatch:/, @pr_err)), 2,
 274                         'app did not dispatch on aborted request');
 275         undef $pri;
 276         check_stderr;
 277         diag 'Unicorn::PrereadInput middleware tests done';
 278 }
 279
 280 # ... more stuff here
 281
 282 # SIGHUP-able stuff goes here
 283
 284 if ('check_client_connection') {
 285         print $conf_fh <<EOM; # appending to existing
 286 check_client_connection true
 287 after_fork { |_,_| File.open('$fifo', 'w') { |fp| fp.write "pid=#\$\$" } }
 288 EOM
 289         $ar->do_kill('HUP');
 290         open my $fifo_fh, '<', $fifo;
 291         my $wpid = readline($fifo_fh);
 292         like($wpid, qr/\Apid=\d+\z/a , 'new worker ready');
 293         $ck_early_hints->('ccc on');
 294 }
 295
 296 if ('max_header_len internal API') {
 297         undef $c;
 298         my $req = 'GET / HTTP/1.0';
 299         my $len = length($req."\r\n\r\n");
 300         print $conf_fh <<EOM; # appending to existing
 301 Unicorn::HttpParser.max_header_len = $len
 302 EOM
 303         $ar->do_kill('HUP');
 304         open my $fifo_fh, '<', $fifo;
 305         my $wpid = readline($fifo_fh);
 306         like($wpid, qr/\Apid=\d+\z/a , 'new worker ready');
 307         close $fifo_fh;
 308         $wpid =~ s/\Apid=// or die;
 309         ok(CORE::kill(0, $wpid), 'worker PID retrieved');
 310
 311         $c = tcp_start($srv, $req);
 312         ($status, $hdr) = slurp_hdr($c);
 313         like($status, qr!\AHTTP/1\.[01] 200\b!, 'minimal request succeeds');
 314
 315         $c = tcp_start($srv, 'GET /xxxxxx HTTP/1.0');
 316         ($status, $hdr) = slurp_hdr($c);
 317         like($status, qr!\AHTTP/1\.[01] 413\b!, 'big request fails');
 318 }
 319
 320
 321 undef $ar;
 322
 323 check_stderr;
 324
 325 undef $tmpdir;
 326 done_testing;