]> Sergey Matveev's repositories - public-inbox.git/blobdiff - t/httpd-corner.t
www: drop --subject from "git send-email" instructions
[public-inbox.git] / t / httpd-corner.t
index 21b5c560db1901989d58a98a2f9ab2c165f628d5..0a613a9e095565a5b4fa75fda023436532e200b6 100644 (file)
@@ -1,21 +1,18 @@
-# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org>
+# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 # note: our HTTP server should be standalone and capable of running
 # generic PSGI/Plack apps.
-use strict;
-use warnings;
-use Test::More;
+use strict; use v5.10.1; use PublicInbox::TestCommon;
 use Time::HiRes qw(gettimeofday tv_interval);
-use PublicInbox::Spawn qw(which spawn);
-use PublicInbox::TestCommon;
+use PublicInbox::Spawn qw(spawn popen_rd);
 require_mods(qw(Plack::Util Plack::Builder HTTP::Date HTTP::Status));
 use Digest::SHA qw(sha1_hex);
 use IO::Handle ();
-use IO::Socket;
 use IO::Socket::UNIX;
 use Fcntl qw(:seek);
 use Socket qw(IPPROTO_TCP TCP_NODELAY SOL_SOCKET);
 use POSIX qw(mkfifo);
+use Carp ();
 my ($tmpdir, $for_destroy) = tmpdir();
 my $fifo = "$tmpdir/fifo";
 ok(defined mkfifo($fifo, 0777), 'created FIFO');
@@ -25,9 +22,6 @@ 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);
@@ -42,7 +36,7 @@ if ($^O eq 'linux') {
        }
 } elsif ($^O eq 'freebsd' && system('kldstat -m accf_data >/dev/null') == 0) {
        require PublicInbox::Daemon;
-       my $var = PublicInbox::Daemon::SO_ACCEPTFILTER();
+       my $var = $PublicInbox::Daemon::SO_ACCEPTFILTER;
        $accf_arg = pack('a16a240', 'dataready', '');
        setsockopt($sock, SOL_SOCKET, $var, $accf_arg) or die "setsockopt: $!";
 }
@@ -52,14 +46,13 @@ sub unix_server ($) {
                Listen => 1024,
                Type => Socket::SOCK_STREAM(),
                Local => $_[0],
-       );
+       ) or BAIL_OUT "bind + listen $_[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) = @_;
@@ -89,7 +82,12 @@ if ('test worker death') {
        like($body, qr/\A[0-9]+\z/, '/pid response');
        isnt($body, $pid, 'respawned worker');
 }
-
+{
+       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");
@@ -221,7 +219,7 @@ sub check_400 {
        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!,
+       like($buf, qr!\r\n\r\n127\.0\.0\.1 0\z!,
                'set REMOTE_ADDR and REMOTE_PORT for Unix socket');
 }
 
@@ -238,8 +236,8 @@ sub conn_for {
        $conn->write("GET /host-port HTTP/1.0\r\n\r\n");
        $conn->read(my $buf, 4096);
        my ($head, $body) = split(/\r\n\r\n/, $buf);
-       my ($addr, $port) = split(/:/, $body);
-       is($addr, $conn->sockhost, 'host matches addr');
+       my ($addr, $port) = split(/ /, $body);
+       is($addr, (tcp_host_port($conn))[0], 'host matches addr');
        is($port, $conn->sockport, 'port matches');
 }
 
@@ -298,6 +296,8 @@ my $len = length $str;
 is($len, 26, 'got the alphabet');
 my $check_self = sub {
        my ($conn) = @_;
+       vec(my $rbits = '', fileno($conn), 1) = 1;
+       select($rbits, undef, undef, 30) or Carp::confess('timed out');
        $conn->read(my $buf, 4096);
        my ($head, $body) = split(/\r\n\r\n/, $buf, 2);
        like($head, qr/\r\nContent-Length: 40\r\n/s, 'got expected length');
@@ -305,12 +305,12 @@ my $check_self = sub {
 };
 
 SKIP: {
-       which('curl') or skip('curl(1) missing', 4);
-       my $base = 'http://' . $sock->sockhost . ':' . $sock->sockport;
+       my $curl = require_cmd('curl', 1) or skip('curl(1) missing', 4);
+       my $base = 'http://'.tcp_host_port($sock);
        my $url = "$base/sha1";
        my ($r, $w);
        pipe($r, $w) or die "pipe: $!";
-       my $cmd = [qw(curl --tcp-nodelay --no-buffer -T- -HExpect: -sS), $url];
+       my $cmd = [$curl, qw(--tcp-nodelay -T- -HExpect: -sSN), $url];
        open my $cout, '+>', undef or die;
        open my $cerr, '>', undef or die;
        my $rdr = { 0 => $r, 1 => $cout, 2 => $cerr };
@@ -327,7 +327,7 @@ SKIP: {
        seek($cout, 0, SEEK_SET);
        is(<$cout>, sha1_hex($str), 'read expected body');
 
-       open my $fh, '-|', qw(curl -sS), "$base/async-big" or die $!;
+       my $fh = popen_rd([$curl, '-sS', "$base/async-big"]);
        my $n = 0;
        my $non_zero = 0;
        while (1) {
@@ -335,17 +335,23 @@ SKIP: {
                $n += $r;
                $buf =~ /\A\0+\z/ or $non_zero++;
        }
-       close $fh or die "curl errored out \$?=$?";
+       close $fh or die "close curl pipe: $!";
+       is($?, 0, 'curl succesful');
        is($n, 30 * 1024 * 1024, 'got expected output from curl');
        is($non_zero, 0, 'read all zeros');
 
-       require_mods(@zmods, 1);
-       open $fh, '-|', qw(curl -sS), "$base/psgi-return-gzip" or die;
-       binmode $fh;
-       my $buf = do { local $/; <$fh> };
-       close $fh or die "curl errored out \$?=$?";
+       require_mods(@zmods, 4);
+       my $buf = xqx([$curl, '-sS', "$base/psgi-return-gzip"]);
+       is($?, 0, 'curl succesful');
        IO::Uncompress::Gunzip::gunzip(\$buf => \(my $out));
        is($out, "hello world\n");
+       my $curl_rdr = { 2 => \(my $curl_err = '') };
+       $buf = xqx([$curl, qw(-sSv --compressed),
+                       "$base/psgi-return-compressible"], undef, $curl_rdr);
+       is($?, 0, 'curl --compressed successful');
+       is($buf, "goodbye world\n", 'gzipped response as expected');
+       like($curl_err, qr/\bContent-Encoding: gzip\b/,
+               'curl got gzipped response');
 }
 
 {
@@ -391,17 +397,20 @@ SKIP: {
 
 {
        my $conn = conn_for($sock, 'graceful termination during slow request');
-       $conn->write("PUT /sha1 HTTP/1.0\r\n");
-       delay();
-       $conn->write("Content-Length: $len\r\n");
-       delay();
-       $conn->write("\r\n");
-       is($td->kill, 1, 'started graceful shutdown');
-       delay();
+       $conn->write("PUT /sha1 HTTP/1.0\r\nContent-Length: $len\r\n\r\n");
+
+       # XXX ugh, want a reliable and non-intrusive way to detect
+       # that the server has started buffering our partial request so we
+       # can reliably test graceful termination.  Maybe making this and
+       # similar tests dependent on Linux strace is a possibility?
+       delay(0.1);
+
+       is($td->kill, 1, 'start graceful shutdown');
        my $n = 0;
        foreach my $c ('a'..'z') {
                $n += $conn->write($c);
        }
+       ok(kill(0, $td->{pid}), 'graceful shutdown did not kill httpd');
        is($n, $len, 'wrote alphabet');
        $check_self->($conn);
        $td->join;
@@ -592,19 +601,22 @@ SKIP: {
 SKIP: {
        skip 'SO_ACCEPTFILTER is FreeBSD-only', 1 if $^O ne 'freebsd';
        skip 'accf_data not loaded: kldload accf_data' if !defined $accf_arg;
-       my $var = PublicInbox::Daemon::SO_ACCEPTFILTER();
+       my $var = $PublicInbox::Daemon::SO_ACCEPTFILTER;
        defined(my $x = getsockopt($sock, SOL_SOCKET, $var)) or die;
        is($x, $accf_arg, 'SO_ACCEPTFILTER unchanged if previously set');
 };
 
 SKIP: {
        skip 'only testing lsof(8) output on Linux', 1 if $^O ne 'linux';
-       skip 'no lsof in PATH', 1 unless which('lsof');
-       my @lsof = `lsof -p $td->{pid}`;
-       is_deeply([grep(/\bdeleted\b/, @lsof)], [], 'no lingering deleted inputs');
+       my $lsof = require_cmd('lsof', 1) or skip 'no lsof in PATH', 1;
+       my $null_in = '';
+       my $rdr = { 2 => \(my $null_err), 0 => \$null_in };
+       my @lsof = xqx([$lsof, '-p', $td->{pid}], undef, $rdr);
+       my $d = [ grep(/\(deleted\)/, @lsof) ];
+       is_deeply($d, [], 'no lingering deleted inputs') or diag explain($d);
 
        # filter out pipes inherited from the parent
-       my @this = `lsof -p $$`;
+       my @this = xqx([$lsof, '-p', $$], undef, $rdr);
        my $bad;
        my $extract_inodes = sub {
                map {;