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