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 my $u1 = "$tmpdir/u1";
  22 my $conf_fh = write_file '>', $u_conf, <<EOM;
  23 early_hints true
  24 listen "$u1"
  25 EOM
  26 $conf_fh->autoflush(1);
  27 my $ar = unicorn(qw(-E none t/integration.ru -c), $u_conf, { 3 => $srv });
  28 my $curl = which('curl');
  29 local $ENV{NO_PROXY} = '*'; # for curl
  30 my $fifo = "$tmpdir/fifo";
  31 POSIX::mkfifo($fifo, 0600) or die "mkfifo: $!";
  32 my %PUT = (
  33         chunked_md5 => sub {
  34                 my ($in, $out, $path, %opt) = @_;
  35                 my $dig = Digest::MD5->new;
  36                 print $out <<EOM;
  37 PUT $path HTTP/1.1\r
  38 Transfer-Encoding: chunked\r
  39 Trailer: Content-MD5\r
  40 \r
  41 EOM
  42                 my ($buf, $r);
  43                 while (1) {
  44                         $r = read($in, $buf, 999 + int(rand(0xffff)));
  45                         last if $r == 0;
  46                         printf $out "%x\r\n", length($buf);
  47                         print $out $buf, "\r\n";
  48                         $dig->add($buf);
  49                 }
  50                 print $out "0\r\nContent-MD5: ", $dig->b64digest, "\r\n\r\n";
  51         },
  52         identity => sub {
  53                 my ($in, $out, $path, %opt) = @_;
  54                 my $clen = $opt{-s} // -s $in;
  55                 print $out <<EOM;
  56 PUT $path HTTP/1.0\r
  57 Content-Length: $clen\r
  58 \r
  59 EOM
  60                 my ($buf, $r, $len, $bs);
  61                 while ($clen) {
  62                         $bs = 999 + int(rand(0xffff));
  63                         $len = $clen > $bs ? $bs : $clen;
  64                         $r = read($in, $buf, $len);
  65                         die 'premature EOF' if $r == 0;
  66                         print $out $buf;
  67                         $clen -= $r;
  68                 }
  69         },
  70 );
  71
  72 my ($c, $status, $hdr, $bdy);
  73
  74 # response header tests
  75 ($status, $hdr) = do_req($srv, 'GET /rack-2-newline-headers HTTP/1.0');
  76 like($status, qr!\AHTTP/1\.[01] 200\b!, 'status line valid');
  77 my $orig_200_status = $status;
  78 is_deeply([ grep(/^X-R2: /, @$hdr) ],
  79         [ 'X-R2: a', 'X-R2: b', 'X-R2: c' ],
  80         'rack 2 LF-delimited headers supported') or diag(explain($hdr));
  81
  82 {
  83         my $val = getsockopt($srv, SOL_SOCKET, SO_KEEPALIVE);
  84         is(unpack('i', $val), 1, 'SO_KEEPALIVE set on inherited socket');
  85 }
  86
  87 SKIP: { # Date header check
  88         my @d = grep(/^Date: /i, @$hdr);
  89         is(scalar(@d), 1, 'got one date header') or diag(explain(\@d));
  90         eval { require HTTP::Date } or skip "HTTP::Date missing: $@", 1;
  91         $d[0] =~ s/^Date: //i or die 'BUG: did not strip date: prefix';
  92         my $t = HTTP::Date::str2time($d[0]);
  93         my $now = time;
  94         ok($t >= ($t0 - 1) && $t > 0 && $t <= ($now + 1), 'valid date') or
  95                 diag(explain(["t=$t t0=$t0 now=$now", $!, \@d]));
  96 };
  97
  98
  99 ($status, $hdr) = do_req($srv, 'GET /rack-3-array-headers HTTP/1.0');
 100 is_deeply([ grep(/^x-r3: /, @$hdr) ],
 101         [ 'x-r3: a', 'x-r3: b', 'x-r3: c' ],
 102         'rack 3 array headers supported') or diag(explain($hdr));
 103
 104 my $JSON_PP;
 105 SKIP: {
 106         eval { require JSON::PP } or skip "JSON::PP missing: $@", 1;
 107         $JSON_PP = JSON::PP->new;
 108         my $get_json = sub {
 109                 my (@req) = @_;
 110                 my @r = do_req $srv, @req;
 111                 my $env = eval { $JSON_PP->decode($r[2]) };
 112                 diag "$@ (r[2]=$r[2])" if $@;
 113                 is ref($env), 'HASH', "@req response body is JSON";
 114                 (@r, $env)
 115         };
 116         ($status, $hdr, my $json, my $env) = $get_json->('GET /env_dump');
 117         is($status, undef, 'no status for HTTP/0.9');
 118         is($hdr, undef, 'no header for HTTP/0.9');
 119         unlike($json, qr/^Connection: /smi, 'no connection header for 0.9');
 120         unlike($json, qr!\AHTTP/!s, 'no HTTP/1.x prefix for 0.9');
 121         is($env->{SERVER_PROTOCOL}, 'HTTP/0.9', 'SERVER_PROTOCOL is 0.9');
 122         is $env->{'rack.url_scheme'}, 'http', 'rack.url_scheme default';
 123         is $env->{'rack.input'}, 'StringIO', 'StringIO for no content';
 124
 125         my $req = 'OPTIONS *';
 126         ($status, $hdr, $json, $env) = $get_json->("$req HTTP/1.0");
 127         is $env->{REQUEST_PATH}, '', "$req => REQUEST_PATH";
 128         is $env->{PATH_INFO}, '', "$req => PATH_INFO";
 129         is $env->{REQUEST_URI}, '*', "$req => REQUEST_URI";
 130
 131         $req = 'GET http://e:3/env_dump?y=z';
 132         ($status, $hdr, $json, $env) = $get_json->("$req HTTP/1.0");
 133         is $env->{REQUEST_PATH}, '/env_dump', "$req => REQUEST_PATH";
 134         is $env->{PATH_INFO}, '/env_dump', "$req => PATH_INFO";
 135         is $env->{QUERY_STRING}, 'y=z', "$req => QUERY_STRING";
 136
 137         $req = 'GET http://e:3/env_dump#frag';
 138         ($status, $hdr, $json, $env) = $get_json->("$req HTTP/1.0");
 139         is $env->{REQUEST_PATH}, '/env_dump', "$req => REQUEST_PATH";
 140         is $env->{PATH_INFO}, '/env_dump', "$req => PATH_INFO";
 141         is $env->{QUERY_STRING}, '', "$req => QUERY_STRING";
 142         is $env->{FRAGMENT}, 'frag', "$req => FRAGMENT";
 143
 144         $req = 'GET http://e:3/env_dump?a=b#frag';
 145         ($status, $hdr, $json, $env) = $get_json->("$req HTTP/1.0");
 146         is $env->{REQUEST_PATH}, '/env_dump', "$req => REQUEST_PATH";
 147         is $env->{PATH_INFO}, '/env_dump', "$req => PATH_INFO";
 148         is $env->{QUERY_STRING}, 'a=b', "$req => QUERY_STRING";
 149         is $env->{FRAGMENT}, 'frag', "$req => FRAGMENT";
 150
 151         for my $proto (qw(https http)) {
 152                 $req = "X-Forwarded-Proto: $proto";
 153                 ($status, $hdr, $json, $env) = $get_json->(
 154                                                 "GET /env_dump HTTP/1.0\r\n".
 155                                                 "X-Forwarded-Proto: $proto");
 156                 is $env->{REQUEST_PATH}, '/env_dump', "$req => REQUEST_PATH";
 157                 is $env->{PATH_INFO}, '/env_dump', "$req => PATH_INFO";
 158                 is $env->{'rack.url_scheme'}, $proto, "$req => rack.url_scheme";
 159         }
 160
 161         $req = 'X-Forwarded-Proto: ftp'; # invalid proto
 162         ($status, $hdr, $json, $env) = $get_json->(
 163                                         "GET /env_dump HTTP/1.0\r\n".
 164                                         "X-Forwarded-Proto: ftp");
 165         is $env->{REQUEST_PATH}, '/env_dump', "$req => REQUEST_PATH";
 166         is $env->{PATH_INFO}, '/env_dump', "$req => PATH_INFO";
 167         is $env->{'rack.url_scheme'}, 'http', "$req => rack.url_scheme";
 168
 169         ($status, $hdr, $json, $env) = $get_json->("PUT /env_dump HTTP/1.0\r\n".
 170                                                 'Content-Length: 0');
 171         is $env->{'rack.input'}, 'StringIO', 'content-length: 0 uses StringIO';
 172
 173         ($status, $hdr, $json, $env) = $get_json->("PUT /env_dump HTTP/1.0\r\n".
 174                                                 'Content-Length: 1');
 175         is $env->{'rack.input'}, 'Unicorn::TeeInput',
 176                 'content-length: 1 uses TeeInput';
 177 }
 178
 179 # cf. <CAO47=rJa=zRcLn_Xm4v2cHPr6c0UswaFC_omYFEH+baSxHOWKQ@mail.gmail.com>
 180 ($status, $hdr) = do_req($srv, 'GET /nil-header-value HTTP/1.0');
 181 is_deeply([grep(/^X-Nil:/, @$hdr)], ['X-Nil: '],
 182         'nil header value accepted for broken apps') or diag(explain($hdr));
 183
 184 check_stderr;
 185 ($status, $hdr, $bdy) = do_req($srv, 'GET /broken_app HTTP/1.0');
 186 like($status, qr!\AHTTP/1\.[0-1] 500\b!, 'got 500 error on broken endpoint');
 187 is($bdy, undef, 'no response body after exception');
 188 seek $errfh, 0, SEEK_SET;
 189 {
 190         my $nxt;
 191         while (!defined($nxt) && defined($_ = <$errfh>)) {
 192                 $nxt = <$errfh> if /app error/;
 193         }
 194         ok $nxt, 'got app error' and
 195                 like $nxt, qr/\bintegration\.ru/, 'got backtrace';
 196 }
 197 seek $errfh, 0, SEEK_SET;
 198 truncate $errfh, 0;
 199
 200 ($status, $hdr, $bdy) = do_req($srv, 'GET /nil HTTP/1.0');
 201 like($status, qr!\AHTTP/1\.[0-1] 500\b!, 'got 500 error on nil endpoint');
 202 like slurp($err_log), qr/app error/, 'exception logged for nil';
 203 seek $errfh, 0, SEEK_SET;
 204 truncate $errfh, 0;
 205
 206 my $ck_early_hints = sub {
 207         my ($note) = @_;
 208         $c = unix_start($u1, 'GET /early_hints_rack2 HTTP/1.0');
 209         ($status, $hdr) = slurp_hdr($c);
 210         like($status, qr!\AHTTP/1\.[01] 103\b!, 'got 103 for rack 2 value');
 211         is_deeply(['link: r', 'link: 2'], $hdr, 'rack 2 hints match '.$note);
 212         ($status, $hdr) = slurp_hdr($c);
 213         like($status, qr!\AHTTP/1\.[01] 200\b!, 'got 200 afterwards');
 214         is(readline($c), 'String', 'early hints used a String for rack 2');
 215
 216         $c = unix_start($u1, 'GET /early_hints_rack3 HTTP/1.0');
 217         ($status, $hdr) = slurp_hdr($c);
 218         like($status, qr!\AHTTP/1\.[01] 103\b!, 'got 103 for rack 3');
 219         is_deeply(['link: r', 'link: 3'], $hdr, 'rack 3 hints match '.$note);
 220         ($status, $hdr) = slurp_hdr($c);
 221         like($status, qr!\AHTTP/1\.[01] 200\b!, 'got 200 afterwards');
 222         is(readline($c), 'Array', 'early hints used a String for rack 3');
 223 };
 224 $ck_early_hints->('ccc off'); # we'll retest later
 225
 226 if ('TODO: ensure Rack::Utils::HTTP_STATUS_CODES is available') {
 227         ($status, $hdr) = do_req $srv, 'POST /tweak-status-code HTTP/1.0';
 228         like($status, qr!\AHTTP/1\.[01] 200 HI\b!, 'status tweaked');
 229
 230         ($status, $hdr) = do_req $srv, 'POST /restore-status-code HTTP/1.0';
 231         is($status, $orig_200_status, 'original status restored');
 232 }
 233
 234 SKIP: {
 235         eval { require HTTP::Tiny } or skip "HTTP::Tiny missing: $@", 1;
 236         my $ht = HTTP::Tiny->new;
 237         my $res = $ht->get("http://$host_port/write_on_close");
 238         is($res->{content}, 'Goodbye', 'write-on-close body read');
 239 }
 240
 241 if ('bad requests') {
 242         ($status, $hdr) = do_req $srv, 'GET /env_dump HTTP/1/1';
 243         like($status, qr!\AHTTP/1\.[01] 400 \b!, 'got 400 on bad request');
 244
 245         for my $abs_uri (qw(ssh+http://e/ ftp://e/x http+ssh://e/x)) {
 246                 ($status, $hdr) = do_req $srv, "GET $abs_uri HTTP/1.0";
 247                 like $status, qr!\AHTTP/1\.[01] 400 \b!, "400 on $abs_uri";
 248         }
 249
 250         $c = tcp_start($srv);
 251         print $c 'GET /';
 252         my $buf = join('', (0..9), 'ab');
 253         for (0..1023) { print $c $buf }
 254         print $c " HTTP/1.0\r\n\r\n";
 255         ($status, $hdr) = slurp_hdr($c);
 256         like($status, qr!\AHTTP/1\.[01] 414 \b!,
 257                 '414 on REQUEST_PATH > (12 * 1024)');
 258
 259         $c = tcp_start($srv);
 260         print $c 'GET /hello-world?a';
 261         $buf = join('', (0..9));
 262         for (0..1023) { print $c $buf }
 263         print $c " HTTP/1.0\r\n\r\n";
 264         ($status, $hdr) = slurp_hdr($c);
 265         like($status, qr!\AHTTP/1\.[01] 414 \b!,
 266                 '414 on QUERY_STRING > (10 * 1024)');
 267
 268         $c = tcp_start($srv);
 269         print $c 'GET /hello-world#a';
 270         $buf = join('', (0..9), 'a'..'f');
 271         for (0..63) { print $c $buf }
 272         print $c " HTTP/1.0\r\n\r\n";
 273         ($status, $hdr) = slurp_hdr($c);
 274         like($status, qr!\AHTTP/1\.[01] 414 \b!, '414 on FRAGMENT > (1024)');
 275 }
 276
 277 # input tests
 278 my ($blob_size, $blob_hash);
 279 SKIP: {
 280         skip 'SKIP_EXPENSIVE on', 1 if $ENV{SKIP_EXPENSIVE};
 281         CORE::open(my $rh, '<', 't/random_blob') or
 282                 skip "t/random_blob not generated $!", 1;
 283         $blob_size = -s $rh;
 284         require Digest::MD5;
 285         $blob_hash = Digest::MD5->new->addfile($rh)->hexdigest;
 286
 287         my $ck_hash = sub {
 288                 my ($sub, $path, %opt) = @_;
 289                 seek($rh, 0, SEEK_SET);
 290                 $c = tcp_start($srv);
 291                 $c->autoflush($opt{sync} // 0);
 292                 $PUT{$sub}->($rh, $c, $path, %opt);
 293                 defined($opt{overwrite}) and
 294                         print { $c } ('x' x $opt{overwrite});
 295                 $c->flush or die $!;
 296                 shutdown($c, SHUT_WR);
 297                 ($status, $hdr) = slurp_hdr($c);
 298                 is(readline($c), $blob_hash, "$sub $path");
 299         };
 300         $ck_hash->('identity', '/rack_input', -s => $blob_size);
 301         $ck_hash->('chunked_md5', '/rack_input');
 302         $ck_hash->('identity', '/rack_input/size_first', -s => $blob_size);
 303         $ck_hash->('identity', '/rack_input/rewind_first', -s => $blob_size);
 304         $ck_hash->('chunked_md5', '/rack_input/size_first');
 305         $ck_hash->('chunked_md5', '/rack_input/rewind_first');
 306
 307         $ck_hash->('identity', '/rack_input', -s => $blob_size, sync => 1);
 308         $ck_hash->('chunked_md5', '/rack_input', sync => 1);
 309
 310         # ensure small overwrites don't get checksummed
 311         $ck_hash->('identity', '/rack_input', -s => $blob_size,
 312                         overwrite => 1); # one extra byte
 313         unlike(slurp($err_log), qr/ClientShutdown/,
 314                 'no overreads after client SHUT_WR');
 315
 316         # excessive overwrite truncated
 317         $c = tcp_start($srv);
 318         $c->autoflush(0);
 319         print $c "PUT /rack_input HTTP/1.0\r\nContent-Length: 1\r\n\r\n";
 320         if (1) {
 321                 local $SIG{PIPE} = 'IGNORE';
 322                 my $buf = "\0" x 8192;
 323                 my $n = 0;
 324                 my $end = time + 5;
 325                 $! = 0;
 326                 while (print $c $buf and time < $end) { ++$n }
 327                 ok($!, 'overwrite truncated') or diag "n=$n err=$! ".time;
 328                 undef $c;
 329         }
 330
 331         # client shutdown early
 332         $c = tcp_start($srv);
 333         $c->autoflush(0);
 334         print $c "PUT /rack_input HTTP/1.0\r\nContent-Length: 16384\r\n\r\n";
 335         if (1) {
 336                 local $SIG{PIPE} = 'IGNORE';
 337                 print $c 'too short body';
 338                 shutdown($c, SHUT_WR);
 339                 vec(my $rvec = '', fileno($c), 1) = 1;
 340                 select($rvec, undef, undef, 10) or BAIL_OUT "timed out";
 341                 my $buf = <$c>;
 342                 is($buf, undef, 'server aborted after client SHUT_WR');
 343                 undef $c;
 344         }
 345
 346         $curl // skip 'no curl found in PATH', 1;
 347
 348         my ($copt, $cout);
 349         my $url = "http://$host_port/rack_input";
 350         my $do_curl = sub {
 351                 my (@arg) = @_;
 352                 pipe(my $cout, $copt->{1});
 353                 open $copt->{2}, '>', "$tmpdir/curl.err";
 354                 my $cpid = spawn($curl, '-sSf', @arg, $url, $copt);
 355                 close(delete $copt->{1});
 356                 is(readline($cout), $blob_hash, "curl @arg response");
 357                 is(waitpid($cpid, 0), $cpid, "curl @arg exited");
 358                 is($?, 0, "no error from curl @arg");
 359                 is(slurp("$tmpdir/curl.err"), '', "no stderr from curl @arg");
 360         };
 361
 362         $do_curl->(qw(-T t/random_blob));
 363
 364         seek($rh, 0, SEEK_SET);
 365         $copt->{0} = $rh;
 366         $do_curl->('-T-');
 367
 368         diag 'testing Unicorn::PrereadInput...';
 369         local $srv = tcp_server();
 370         local $host_port = tcp_host_port($srv);
 371         check_stderr;
 372         truncate($errfh, 0);
 373
 374         my $pri = unicorn(qw(-E none t/preread_input.ru), { 3 => $srv });
 375         $url = "http://$host_port/";
 376
 377         $do_curl->(qw(-T t/random_blob));
 378         seek($rh, 0, SEEK_SET);
 379         $copt->{0} = $rh;
 380         $do_curl->('-T-');
 381
 382         my @pr_err = slurp("$tmpdir/err.log");
 383         is(scalar(grep(/app dispatch:/, @pr_err)), 2, 'app dispatched twice');
 384
 385         # abort a chunked request by blocking curl on a FIFO:
 386         $c = tcp_start($srv, "PUT / HTTP/1.1\r\nTransfer-Encoding: chunked");
 387         close $c;
 388         @pr_err = slurp("$tmpdir/err.log");
 389         is(scalar(grep(/app dispatch:/, @pr_err)), 2,
 390                         'app did not dispatch on aborted request');
 391         undef $pri;
 392         check_stderr;
 393         diag 'Unicorn::PrereadInput middleware tests done';
 394 }
 395
 396 # disallow /content_length/i and /transfer_encoding/i due to confusion+
 397 # smuggling attacks
 398 # cf. <CAB6pCSb=vE1My6pHcwO672JNeeDaOYNJ4ykkB_vq9LCqR7pYFw@mail.gmail.com>
 399 SKIP: {
 400         $JSON_PP or skip "JSON::PP missing: $@", 1;
 401         my $body = "1\r\nZ\r\n0\r\n\r\n";
 402         my $blen = length $body;
 403         my $post = "POST /env_dump HTTP/1.0\r\n";
 404
 405         for my $x (["Content-Length: $blen", $body],
 406                         [ "Transfer-Encoding: chunked", 'Z']) {
 407                 ($status, $hdr, $bdy) = do_req $srv, $post,
 408                                         $x->[0], "\r\n\r\n", $body;
 409                 like $status, qr!\AHTTP/1\.[01] 200!, 'Content-Length POST';
 410                 my $env = $JSON_PP->decode($bdy);
 411                 is $env->{'unicorn_test.body'}, $x->[1], "$x->[0]-only";
 412         }
 413
 414         for my $cl (qw(Content-Length Content_Length)) {
 415                 for my $te (qw(Transfer-Encoding Transfer_Encoding)) {
 416                         ($status, $hdr, $bdy) = do_req $srv, $post,
 417                                 "$te: chunked\r\n",
 418                                 "$cl: $blen\r\n", "\r\n", $body;
 419                         if ("$cl$te" =~ /_/) {
 420                                 like $status, qr!\AHTTP/1\.[01] 400 \b!,
 421                                         "got 400 on bad request w/ $cl + $te";
 422                         } else { # RFC 7230 favors Transfer-Encoding :<
 423                                 like $status, qr!\AHTTP/1\.[01] 200 \b!,
 424                                         "got 200 w/ both $cl + $te";
 425                                 my $env = $JSON_PP->decode($bdy);
 426                                 is $env->{'unicorn_test.body'}, 'Z',
 427 'Transfer-Encoding favored over Content-Length (RFC 7230 3.3.3#3)';
 428                         }
 429                 }
 430         }
 431 }
 432
 433 # ... more stuff here
 434
 435 # SIGHUP-able stuff goes here
 436
 437 if ('check_client_connection') {
 438         print $conf_fh <<EOM; # appending to existing
 439 check_client_connection true
 440 after_fork { |_,_| File.open('$fifo', 'w') { |fp| fp.write "pid=#\$\$" } }
 441 EOM
 442         $ar->do_kill('HUP');
 443         open my $fifo_fh, '<', $fifo;
 444         my $wpid = readline($fifo_fh);
 445         like($wpid, qr/\Apid=\d+\z/a , 'new worker ready');
 446         $ck_early_hints->('ccc on');
 447
 448         $c = tcp_start $srv, 'GET /env_dump HTTP/1.0';
 449         vec(my $rvec = '', fileno($c), 1) = 1;
 450         select($rvec, undef, undef, 10) or BAIL_OUT 'timed out env_dump';
 451         ($status, $hdr) = slurp_hdr($c);
 452         like $status, qr!\AHTTP/1\.[01] 200!, 'got part of first response';
 453         ok $hdr, 'got all headers';
 454
 455         # start a slow TCP request
 456         my $rfifo = "$tmpdir/rfifo";
 457         mkfifo_die $rfifo;
 458         $c = tcp_start $srv, "GET /read_fifo HTTP/1.0\r\nRead-FIFO: $rfifo";
 459         tcp_start $srv, 'GET /aborted HTTP/1.0' for (1..100);
 460         write_file '>', $rfifo, 'TFIN';
 461         ($status, $hdr) = slurp_hdr($c);
 462         like $status, qr!\AHTTP/1\.[01] 200!, 'got part of first response';
 463         $bdy = <$c>;
 464         is $bdy, 'TFIN', 'got slow response from TCP socket';
 465
 466         # slow Unix socket request
 467         $c = unix_start $u1, "GET /read_fifo HTTP/1.0\r\nRead-FIFO: $rfifo";
 468         vec($rvec = '', fileno($c), 1) = 1;
 469         select($rvec, undef, undef, 10) or BAIL_OUT 'timed out Unix CCC';
 470         unix_start $u1, 'GET /aborted HTTP/1.0' for (1..100);
 471         write_file '>', $rfifo, 'UFIN';
 472         ($status, $hdr) = slurp_hdr($c);
 473         like $status, qr!\AHTTP/1\.[01] 200!, 'got part of first response';
 474         $bdy = <$c>;
 475         is $bdy, 'UFIN', 'got slow response from Unix socket';
 476
 477         ($status, $hdr, $bdy) = do_req $srv, 'GET /nr_aborts HTTP/1.0';
 478         like "@$hdr", qr/nr-aborts: 0\b/,
 479                 'aborted connections unseen by Rack app';
 480 }
 481
 482 if ('max_header_len internal API') {
 483         undef $c;
 484         my $req = 'GET / HTTP/1.0';
 485         my $len = length($req."\r\n\r\n");
 486         print $conf_fh <<EOM; # appending to existing
 487 Unicorn::HttpParser.max_header_len = $len
 488 EOM
 489         $ar->do_kill('HUP');
 490         open my $fifo_fh, '<', $fifo;
 491         my $wpid = readline($fifo_fh);
 492         like($wpid, qr/\Apid=\d+\z/a , 'new worker ready');
 493         close $fifo_fh;
 494         $wpid =~ s/\Apid=// or die;
 495         ok(CORE::kill(0, $wpid), 'worker PID retrieved');
 496
 497         ($status, $hdr) = do_req($srv, $req);
 498         like($status, qr!\AHTTP/1\.[01] 200\b!, 'minimal request succeeds');
 499
 500         ($status, $hdr) = do_req($srv, 'GET /xxxxxx HTTP/1.0');
 501         like($status, qr!\AHTTP/1\.[01] 413\b!, 'big request fails');
 502 }
 503
 504
 505 undef $ar;
 506
 507 check_stderr;
 508
 509 undef $tmpdir;
 510 done_testing;