+my $psgi = "./t/httpd-corner.psgi";
+my $sock = tcp_server() or die;
+my @zmods = qw(PublicInbox::GzipFilter IO::Uncompress::Gunzip);
+
+# make sure stdin is not a pipe for lsof test to check for leaking pipes
+open(STDIN, '<', '/dev/null') or die 'no /dev/null: $!';
+
+# Make sure we don't clobber socket options set by systemd or similar
+# using socket activation:
+my ($defer_accept_val, $accf_arg, $TCP_DEFER_ACCEPT);
+if ($^O eq 'linux') {
+ $TCP_DEFER_ACCEPT = eval { Socket::TCP_DEFER_ACCEPT() } // 9;
+ setsockopt($sock, IPPROTO_TCP, $TCP_DEFER_ACCEPT, 5) or die;
+ my $x = getsockopt($sock, IPPROTO_TCP, $TCP_DEFER_ACCEPT);
+ defined $x or die "getsockopt: $!";
+ $defer_accept_val = unpack('i', $x);
+ if ($defer_accept_val <= 0) {
+ die "unexpected TCP_DEFER_ACCEPT value: $defer_accept_val";
+ }
+} elsif ($^O eq 'freebsd' && system('kldstat -m accf_data >/dev/null') == 0) {
+ require PublicInbox::Daemon;
+ my $var = PublicInbox::Daemon::SO_ACCEPTFILTER();
+ $accf_arg = pack('a16a240', 'dataready', '');
+ setsockopt($sock, SOL_SOCKET, $var, $accf_arg) or die "setsockopt: $!";
+}
+
+sub unix_server ($) {
+ my $s = IO::Socket::UNIX->new(
+ Listen => 1024,
+ Type => Socket::SOCK_STREAM(),
+ Local => $_[0],
+ );
+ $s->blocking(0);
+ $s;
+}
+
+my $upath = "$tmpdir/s";
+my $unix = unix_server($upath);
+ok($unix, 'UNIX socket created');
+my $td;
+my $spawn_httpd = sub {
+ my (@args) = @_;
+ my $cmd = [ '-httpd', @args, "--stdout=$out", "--stderr=$err", $psgi ];
+ $td = start_script($cmd, undef, { 3 => $sock, 4 => $unix });
+};
+
+$spawn_httpd->();
+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');
+}
+
+{
+ 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');
+}
+
+SKIP: {
+ my $conn = conn_for($sock, 'excessive header');
+ $SIG{PIPE} = 'IGNORE';
+ $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');
+ ok($conn->read(my $buf, 8192), 'read response');
+ my ($head, $body) = split(/\r\n\r\n/, $buf);
+ like($head, qr/\b400\b/, 'got 400 response');
+}
+
+{
+ my $conn = conn_for($sock, 'excessive body Content-Length');
+ $SIG{PIPE} = 'IGNORE';
+ my $n = (10 * 1024 * 1024) + 1;
+ $conn->write("PUT /sha1 HTTP/1.0\r\nContent-Length: $n\r\n\r\n");
+ ok($conn->read(my $buf, 8192), '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');
+ $SIG{PIPE} = 'IGNORE';
+ 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));
+ ok($conn->read(my $buf, 8192), 'read response');
+ my ($head, $body) = split(/\r\n\r\n/, $buf);
+ like($head, qr/\b413\b/, 'got 413 response');
+}
+