+ my $conn = conn_for($alt, 'alt PSGI path');
+ $conn->write("GET / HTTP/1.0\r\n\r\n");
+ $conn->read(my $buf, 4096);
+ like($buf, qr!^/path/to/alt\z!sm,
+ 'alt.psgi loaded on alt socket with correct env');
+
+ $conn = conn_for($sock, 'default PSGI path');
+ $conn->write("GET /PI_CONFIG HTTP/1.0\r\n\r\n");
+ $conn->read($buf, 4096);
+ like($buf, qr!^/dev/null\z!sm,
+ 'default PSGI on original socket');
+ my $log = capture("$tmpdir/alt.err");
+ ok(grep(/ALT/, @$log), 'alt psgi.errors written to');
+ $log = capture($err);
+ ok(!grep(/ALT/, @$log), 'STDERR not written to');
+ is(unlink($err, "$tmpdir/alt.err"), 2, 'unlinked stderr and alt.err');
+
+ $td->kill('USR1'); # trigger reopen_logs
+}
+
+if ('test worker death') {
+ my $conn = conn_for($sock, 'killed worker');
+ $conn->write("GET /pid HTTP/1.1\r\nHost:example.com\r\n\r\n");
+ my $pid;
+ while (defined(my $line = $conn->getline)) {
+ next unless $line eq "\r\n";
+ chomp($pid = $conn->getline);
+ last;
+ }
+ like($pid, qr/\A[0-9]+\z/, '/pid response');
+ is(kill('KILL', $pid), 1, 'killed worker');
+ is($conn->getline, undef, 'worker died and EOF-ed client');
+
+ $conn = conn_for($sock, 'respawned worker');
+ $conn->write("GET /pid HTTP/1.0\r\n\r\n");
+ ok($conn->read(my $buf, 8192), 'read response');
+ my ($head, $body) = split(/\r\n\r\n/, $buf);
+ chomp($body);
+ like($body, qr/\A[0-9]+\z/, '/pid response');
+ isnt($body, $pid, 'respawned worker');
+}
+{ # check on prior USR1 signal
+ ok(-e $err, 'stderr recreated after USR1');
+ ok(-e "$tmpdir/alt.err", 'alt.err recreated after USR1');
+}
+{
+ my $conn = conn_for($sock, 'Header spaces bogus');
+ $conn->write("GET /empty HTTP/1.1\r\nSpaced-Out : 3\r\n\r\n");
+ $conn->read(my $buf, 4096);
+ like($buf, qr!\AHTTP/1\.[0-9] 400 !, 'got 400 response on bad request');
+}
+{
+ my $conn = conn_for($sock, 'streaming callback');
+ $conn->write("GET /callback HTTP/1.0\r\n\r\n");
+ ok($conn->read(my $buf, 8192), 'read response');
+ my ($head, $body) = split(/\r\n\r\n/, $buf);
+ is($body, "hello world\n", 'callback body matches expected');
+}
+
+{
+ my $conn = conn_for($sock, 'getline-die');
+ $conn->write("GET /getline-die HTTP/1.1\r\nHost: example.com\r\n\r\n");
+ ok($conn->read(my $buf, 8192), 'read some response');
+ like($buf, qr!HTTP/1\.1 200\b[^\r]*\r\n!, 'got some sort of header');
+ is($conn->read(my $nil, 8192), 0, 'read EOF');
+ $conn = undef;
+ my $after = capture($err);
+ is(scalar(grep(/GETLINE FAIL/, @$after)), 1, 'failure logged');
+ is(scalar(grep(/CLOSE FAIL/, @$after)), 1, 'body->close not called');
+}
+
+{
+ my $conn = conn_for($sock, 'close-die');
+ $conn->write("GET /close-die HTTP/1.1\r\nHost: example.com\r\n\r\n");
+ ok($conn->read(my $buf, 8192), 'read some response');
+ like($buf, qr!HTTP/1\.1 200\b[^\r]*\r\n!, 'got some sort of header');
+ is($conn->read(my $nil, 8192), 0, 'read EOF');
+ $conn = undef;
+ my $after = capture($err);
+ is(scalar(grep(/GETLINE FAIL/, @$after)), 0, 'getline not failed');
+ is(scalar(grep(/CLOSE FAIL/, @$after)), 1, 'body->close not called');
+}
+
+sub check_400 {
+ my ($conn) = @_;
+ my $r = $conn->read(my $buf, 8192);
+ # ECONNRESET and $r==0 are both observed on FreeBSD 11.2
+ if (!defined($r)) {
+ ok($!{ECONNRESET}, 'ECONNRESET on read (BSD sometimes)');
+ } elsif ($r > 0) {
+ like($buf, qr!\AHTTP/1\.\d 400 !, 'got 400 response');
+ } else {
+ is($r, 0, 'got EOF (BSD sometimes)');
+ }
+ close($conn); # ensure we don't get SIGPIPE later
+}
+
+{
+ local $SIG{PIPE} = 'IGNORE';
+ my $conn = conn_for($sock, 'excessive header');
+ $conn->write("GET /callback HTTP/1.0\r\n");
+ foreach my $i (1..500000) {
+ last unless $conn->write("X-xxxxxJunk-$i: omg\r\n");
+ }
+ ok(!$conn->write("\r\n"), 'broken request');
+ check_400($conn);
+}
+
+{
+ my $conn = conn_for($sock, 'excessive body Content-Length');
+ my $n = (10 * 1024 * 1024) + 1;
+ $conn->write("PUT /sha1 HTTP/1.0\r\nContent-Length: $n\r\n\r\n");
+ my $r = $conn->read(my $buf, 8192);
+ ok($r > 0, 'read response');
+ my ($head, $body) = split(/\r\n\r\n/, $buf);
+ like($head, qr/\b413\b/, 'got 413 response');
+}
+
+{
+ my $conn = conn_for($sock, 'excessive body chunked');
+ my $n = (10 * 1024 * 1024) + 1;
+ $conn->write("PUT /sha1 HTTP/1.1\r\nTransfer-Encoding: chunked\r\n");
+ $conn->write("\r\n".sprintf("%x\r\n", $n));
+ my $r = $conn->read(my $buf, 8192);
+ ok($r > 0, 'read response');
+ my ($head, $body) = split(/\r\n\r\n/, $buf);
+ like($head, qr/\b413\b/, 'got 413 response');
+}
+
+{
+ my $conn = conn_for($sock, '1.1 Transfer-Encoding bogus');
+ $conn->write("PUT /sha1 HTTP/1.1\r\nTransfer-Encoding: bogus\r\n\r\n");
+ $conn->read(my $buf, 4096);
+ like($buf, qr!\AHTTP/1\.[0-9] 400 !, 'got 400 response on bogus TE');
+}
+{
+ my $conn = conn_for($sock, '1.1 Content-Length bogus');
+ $conn->write("PUT /sha1 HTTP/1.1\r\nContent-Length: 3.3\r\n\r\n");
+ $conn->read(my $buf, 4096);
+ like($buf, qr!\AHTTP/1\.[0-9] 400 !, 'got 400 response on bad length');
+}
+
+{
+ my $req = "PUT /sha1 HTTP/1.1\r\nContent-Length: 3\r\n" .
+ "Content-Length: 3\r\n\r\n";
+ # this is stricter than it needs to be. Due to the way
+ # Plack::HTTPParser, PSGI specs, and how hash tables work in common
+ # languages; it's not possible to tell the difference between folded
+ # and intentionally bad commas (e.g. "Content-Length: 3, 3")
+ if (0) {
+ require Plack::HTTPParser; # XS or pure Perl
+ require Data::Dumper;
+ Plack::HTTPParser::parse_http_request($req, my $env = {});
+ diag Data::Dumper::Dumper($env); # "Content-Length: 3, 3"
+ }
+ my $conn = conn_for($sock, '1.1 Content-Length dupe');
+ $conn->write($req);
+ $conn->read(my $buf, 4096);
+ like($buf, qr!\AHTTP/1\.[0-9] 400 !, 'got 400 response on dupe length');
+}
+
+{
+ my $conn = conn_for($sock, 'chunk with pipeline');
+ my $n = 10;
+ my $payload = 'b'x$n;
+ $conn->write("PUT /sha1 HTTP/1.1\r\nTransfer-Encoding: chunked\r\n");
+ $conn->write("\r\n".sprintf("%x\r\n", $n));
+ $conn->write($payload . "\r\n0\r\n\r\nGET /empty HTTP/1.0\r\n\r\n");
+ $conn->read(my $buf, 4096);
+ my $lim = 0;
+ $lim++ while ($conn->read($buf, 4096, length($buf)) && $lim < 9);
+ my $exp = sha1_hex($payload);
+ like($buf, qr!\r\n\r\n${exp}HTTP/1\.0 200 OK\r\n!s,
+ 'chunk parser can handled pipelined requests');
+}
+
+# Unix domain sockets
+{
+ my $u = IO::Socket::UNIX->new(Type => SOCK_STREAM, Peer => $upath);
+ ok($u, 'unix socket connected');
+ $u->write("GET /host-port HTTP/1.0\r\n\r\n");
+ $u->read(my $buf, 4096);
+ like($buf, qr!\r\n\r\n127\.0\.0\.1 0\z!,
+ 'set REMOTE_ADDR and REMOTE_PORT for Unix socket');