diff options
Diffstat (limited to 't')
| -rw-r--r-- | t/common.perl | 174 | ||||
| -rw-r--r-- | t/git-http-backend.t | 14 | ||||
| -rw-r--r-- | t/httpd-corner.t | 48 | ||||
| -rw-r--r-- | t/httpd-https.t | 28 | ||||
| -rw-r--r-- | t/httpd-unix.t | 47 | ||||
| -rw-r--r-- | t/httpd.t | 13 | ||||
| -rw-r--r-- | t/nntpd-tls.t | 29 | ||||
| -rw-r--r-- | t/nntpd-validate.t | 27 | ||||
| -rw-r--r-- | t/nntpd.t | 16 | ||||
| -rw-r--r-- | t/perf-nntpd.t | 22 | ||||
| -rw-r--r-- | t/v2mirror.t | 21 | ||||
| -rw-r--r-- | t/v2writable.t | 8 | ||||
| -rw-r--r-- | t/www_listing.t | 8 |
13 files changed, 234 insertions, 221 deletions
diff --git a/t/common.perl b/t/common.perl index c5693080..2126a761 100644 --- a/t/common.perl +++ b/t/common.perl @@ -30,30 +30,6 @@ sub tcp_connect { $s; } -sub spawn_listener { - my ($env, $cmd, $socks) = @_; - my $pid = fork; - defined $pid or die "fork failed: $!\n"; - if ($pid == 0) { - # pretend to be systemd (cf. sd_listen_fds(3)) - my $fd = 3; # 3 == SD_LISTEN_FDS_START - foreach my $s (@$socks) { - my $fl = fcntl($s, F_GETFD, 0); - if (($fl & FD_CLOEXEC) != FD_CLOEXEC) { - warn "got FD:".fileno($s)." w/o CLOEXEC\n"; - } - fcntl($s, F_SETFD, $fl &= ~FD_CLOEXEC); - dup2(fileno($s), $fd++) or die "dup2 failed: $!\n"; - } - $ENV{LISTEN_PID} = $$; - $ENV{LISTEN_FDS} = scalar @$socks; - %ENV = (%ENV, %$env) if $env; - exec @$cmd; - die "FAIL: ",join(' ', @$cmd), ": $!\n"; - } - $pid; -} - sub require_git ($;$) { my ($req, $maybe) = @_; my ($req_maj, $req_min) = split(/\./, $req); @@ -68,7 +44,6 @@ sub require_git ($;$) { 1; } -my %cached_scripts; sub key2script ($) { my ($key) = @_; return $key if $key =~ m!\A/!; @@ -105,11 +80,10 @@ sub run_script_exit (;$) { die RUN_SCRIPT_EXIT; } -sub run_script ($;$$) { - my ($cmd, $env, $opt) = @_; - my ($key, @argv) = @$cmd; - my $run_mode = $ENV{TEST_RUN_MODE} // $opt->{run_mode} // 1; - my $sub = $run_mode == 0 ? undef : ($cached_scripts{$key} //= do { +my %cached_scripts; +sub key2sub ($) { + my ($key) = @_; + $cached_scripts{$key} //= do { my $f = key2script($key); open my $fh, '<', $f or die "open $f: $!"; my $str = do { local $/; <$fh> }; @@ -129,8 +103,34 @@ $str 1; EOF $pkg->can('main'); - }); # do + } +} +sub _run_sub ($$$) { + my ($sub, $key, $argv) = @_; + local @ARGV = @$argv; + $run_script_exit_code = undef; + my $exit_code = eval { $sub->(@$argv) }; + if ($@ eq RUN_SCRIPT_EXIT) { + $@ = ''; + $exit_code = $run_script_exit_code; + $? = ($exit_code << 8); + } elsif (defined($exit_code)) { + $? = ($exit_code << 8); + } elsif ($@) { # mimic die() behavior when uncaught + warn "E: eval-ed $key: $@\n"; + $? = ($! << 8) if $!; + $? = (255 << 8) if $? == 0; + } else { + die "BUG: eval-ed $key: no exit code or \$@\n"; + } +} + +sub run_script ($;$$) { + my ($cmd, $env, $opt) = @_; + my ($key, @argv) = @$cmd; + my $run_mode = $ENV{TEST_RUN_MODE} // $opt->{run_mode} // 1; + my $sub = $run_mode == 0 ? undef : key2sub($key); my $fhref = []; my $spawn_opt = {}; for my $fd (0..2) { @@ -162,22 +162,7 @@ EOF local %ENV = $env ? (%ENV, %$env) : %ENV; local %SIG = %SIG; _prepare_redirects($fhref); - local @ARGV = @argv; - $run_script_exit_code = undef; - my $exit_code = eval { $sub->(@argv) }; - if ($@ eq RUN_SCRIPT_EXIT) { - $@ = ''; - $exit_code = $run_script_exit_code; - $? = ($exit_code << 8); - } elsif (defined($exit_code)) { - $? = ($exit_code << 8); - } elsif ($@) { # mimic die() behavior when uncaught - warn "E: eval-ed $key: $@\n"; - $? = ($! << 8) if $!; - $? = (255 << 8) if $? == 0; - } else { - die "BUG: eval-ed $key: no exit code or \$@\n"; - } + _run_sub($sub, $key, \@argv); } # slurp the redirects back into user-supplied strings @@ -191,4 +176,99 @@ EOF $? == 0; } +sub wait_for_tail () { sleep(2) } + +sub start_script { + my ($cmd, $env, $opt) = @_; + my ($key, @argv) = @$cmd; + my $run_mode = $ENV{TEST_RUN_MODE} // $opt->{run_mode} // 1; + my $sub = $run_mode == 0 ? undef : key2sub($key); + my $tail_pid; + if (my $tail_cmd = $ENV{TAIL}) { + my @paths; + for (@argv) { + next unless /\A--std(?:err|out)=(.+)\z/; + push @paths, $1; + } + if (@paths) { + defined($tail_pid = fork) or die "fork: $!\n"; + if ($tail_pid == 0) { + # make sure files exist, first + open my $fh, '>>', $_ for @paths; + open(STDOUT, '>&STDERR') or die "1>&2: $!"; + exec(split(' ', $tail_cmd), @paths); + die "$tail_cmd failed: $!"; + } + wait_for_tail(); + } + } + defined(my $pid = fork) or die "fork: $!\n"; + if ($pid == 0) { + # pretend to be systemd (cf. sd_listen_fds(3)) + # 3 == SD_LISTEN_FDS_START + my $fd; + for ($fd = 0; 1; $fd++) { + my $s = $opt->{$fd}; + last if $fd >= 3 && !defined($s); + next unless $s; + my $fl = fcntl($s, F_GETFD, 0); + if (($fl & FD_CLOEXEC) != FD_CLOEXEC) { + warn "got FD:".fileno($s)." w/o CLOEXEC\n"; + } + fcntl($s, F_SETFD, $fl &= ~FD_CLOEXEC); + dup2(fileno($s), $fd) or die "dup2 failed: $!\n"; + } + %ENV = (%ENV, %$env) if $env; + my $fds = $fd - 3; + if ($fds > 0) { + $ENV{LISTEN_PID} = $$; + $ENV{LISTEN_FDS} = $fds; + } + $0 = join(' ', @$cmd); + if ($sub) { + _run_sub($sub, $key, \@argv); + POSIX::_exit($? >> 8); + } else { + exec(key2script($key), @argv); + die "FAIL: ",join(' ', $key, @argv), ": $!\n"; + } + } + TestProcess->new($pid, $tail_pid); +} + +package TestProcess; +use strict; + +# prevent new threads from inheriting these objects +sub CLONE_SKIP { 1 } + +sub new { + my ($klass, $pid, $tail_pid) = @_; + bless { pid => $pid, tail_pid => $tail_pid, owner => $$ }, $klass; +} + +sub kill { + my ($self, $sig) = @_; + CORE::kill($sig // 'TERM', $self->{pid}); +} + +sub join { + my ($self) = @_; + my $pid = delete $self->{pid} or return; + my $ret = waitpid($pid, 0); + defined($ret) or die "waitpid($pid): $!"; + $ret == $pid or die "waitpid($pid) != $ret"; +} + +sub DESTROY { + my ($self) = @_; + return if $self->{owner} != $$; + if (my $tail = delete $self->{tail_pid}) { + ::wait_for_tail(); + CORE::kill('TERM', $tail); + } + my $pid = delete $self->{pid} or return; + CORE::kill('TERM', $pid); +} + 1; diff --git a/t/git-http-backend.t b/t/git-http-backend.t index c2a04653..c4dc09a1 100644 --- a/t/git-http-backend.t +++ b/t/git-http-backend.t @@ -22,12 +22,10 @@ my $psgi = "./t/git-http-backend.psgi"; my $tmpdir = tempdir('pi-git-http-backend-XXXXXX', TMPDIR => 1, CLEANUP => 1); my $err = "$tmpdir/stderr.log"; my $out = "$tmpdir/stdout.log"; -my $httpd = 'blib/script/public-inbox-httpd'; my $sock = tcp_server(); my $host = $sock->sockhost; my $port = $sock->sockport; -my $pid; -END { kill 'TERM', $pid if defined $pid }; +my $td; my $get_maxrss = sub { my $http = Net::HTTP->new(Host => "$host:$port"); @@ -44,9 +42,8 @@ my $get_maxrss = sub { { ok($sock, 'sock created'); - my $cmd = [ $httpd, '-W0', "--stdout=$out", "--stderr=$err", $psgi ]; - ok(defined($pid = spawn_listener(undef, $cmd, [$sock])), - 'forked httpd process successfully'); + my $cmd = [ '-httpd', '-W0', "--stdout=$out", "--stderr=$err", $psgi ]; + $td = start_script($cmd, undef, { 3 => $sock }); } my $mem_a = $get_maxrss->(); @@ -113,9 +110,8 @@ SKIP: { } { - ok(kill('TERM', $pid), 'killed httpd'); - $pid = undef; - waitpid(-1, 0); + ok($td->kill, 'killed httpd'); + $td->join; } done_testing(); diff --git a/t/httpd-corner.t b/t/httpd-corner.t index cc36c7e1..eca77d7f 100644 --- a/t/httpd-corner.t +++ b/t/httpd-corner.t @@ -26,7 +26,6 @@ my $fifo = "$tmpdir/fifo"; ok(defined mkfifo($fifo, 0777), 'created FIFO'); my $err = "$tmpdir/stderr.log"; my $out = "$tmpdir/stdout.log"; -my $httpd = 'blib/script/public-inbox-httpd'; my $psgi = "./t/httpd-corner.psgi"; my $sock = tcp_server() or die; @@ -64,13 +63,11 @@ sub unix_server ($) { my $upath = "$tmpdir/s"; my $unix = unix_server($upath); ok($unix, 'UNIX socket created'); -my $pid; -END { kill 'TERM', $pid if defined $pid }; +my $td; my $spawn_httpd = sub { my (@args) = @_; - my $cmd = [ $httpd, @args, "--stdout=$out", "--stderr=$err", $psgi ]; - $pid = spawn_listener(undef, $cmd, [ $sock, $unix ]); - ok(defined $pid, 'forked httpd process successfully'); + my $cmd = [ '-httpd', @args, "--stdout=$out", "--stderr=$err", $psgi ]; + $td = start_script($cmd, undef, { 3 => $sock, 4 => $unix }); }; $spawn_httpd->(); @@ -213,16 +210,14 @@ sub conn_for { open my $f, '>', $fifo or die "open $fifo: $!\n"; $f->autoflush(1); ok(print($f "hello\n"), 'wrote something to fifo'); - my $kpid = $pid; - $pid = undef; - is(kill('TERM', $kpid), 1, 'started graceful shutdown'); + is($td->kill, 1, 'started graceful shutdown'); ok(print($f "world\n"), 'wrote else to fifo'); close $f or die "close fifo: $!\n"; $conn->read(my $buf, 8192); my ($head, $body) = split(/\r\n\r\n/, $buf, 2); like($head, qr!\AHTTP/1\.[01] 200 OK!, 'got 200 for slow-header'); is($body, "hello\nworld\n", 'read expected body'); - is(waitpid($kpid, 0), $kpid, 'reaped httpd'); + $td->join; is($?, 0, 'no error'); $spawn_httpd->('-W0'); } @@ -244,15 +239,13 @@ sub conn_for { $conn->sysread($buf, 8192); is($buf, $c, 'got trickle for reading'); } - my $kpid = $pid; - $pid = undef; - is(kill('TERM', $kpid), 1, 'started graceful shutdown'); + is($td->kill, 1, 'started graceful shutdown'); ok(print($f "world\n"), 'wrote else to fifo'); close $f or die "close fifo: $!\n"; $conn->sysread($buf, 8192); is($buf, "world\n", 'read expected body'); is($conn->sysread($buf, 8192), 0, 'got EOF from server'); - is(waitpid($kpid, 0), $kpid, 'reaped httpd'); + $td->join; is($?, 0, 'no error'); $spawn_httpd->('-W0'); } @@ -346,9 +339,7 @@ SKIP: { $conn->write("Content-Length: $len\r\n"); delay(); $conn->write("\r\n"); - my $kpid = $pid; - $pid = undef; - is(kill('TERM', $kpid), 1, 'started graceful shutdown'); + is($td->kill, 1, 'started graceful shutdown'); delay(); my $n = 0; foreach my $c ('a'..'z') { @@ -356,7 +347,7 @@ SKIP: { } is($n, $len, 'wrote alphabet'); $check_self->($conn); - is(waitpid($kpid, 0), $kpid, 'reaped httpd'); + $td->join; is($?, 0, 'no error'); $spawn_httpd->('-W0'); } @@ -553,12 +544,29 @@ SKIP: { 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 $pid`; + my @lsof = `lsof -p $td->{pid}`; is_deeply([grep(/\bdeleted\b/, @lsof)], [], 'no lingering deleted inputs'); - is_deeply([grep(/\bpipe\b/, @lsof)], [], 'no extra pipes with -W0'); + + # filter out pipes inherited from the parent + my @this = `lsof -p $$`; + my $bad; + sub extract_inodes { + map {; + my @f = split(' ', $_); + my $inode = $f[-2]; + $bad = $_ if $inode !~ /\A[0-9]+\z/; + $inode => 1; + } grep (/\bpipe\b/, @_); + } + my %child = extract_inodes(@lsof); + my %parent = extract_inodes(@this); + skip("inode not in expected format: $bad", 1) if defined($bad); + delete @child{(keys %parent)}; + is_deeply([], [keys %child], 'no extra pipes with -W0'); }; done_testing(); diff --git a/t/httpd-https.t b/t/httpd-https.t index 22c62bf4..81a11108 100644 --- a/t/httpd-https.t +++ b/t/httpd-https.t @@ -23,14 +23,8 @@ my $psgi = "./t/httpd-corner.psgi"; my $tmpdir = tempdir('pi-httpd-https-XXXXXX', TMPDIR => 1, CLEANUP => 1); my $err = "$tmpdir/stderr.log"; my $out = "$tmpdir/stdout.log"; -my $httpd = 'blib/script/public-inbox-httpd'; my $https = tcp_server(); -my ($pid, $tail_pid); -END { - foreach ($pid, $tail_pid) { - kill 'TERM', $_ if defined $_; - } -}; +my $td; my $https_addr = $https->sockhost . ':' . $https->sockport; for my $args ( @@ -39,15 +33,9 @@ for my $args ( for ($out, $err) { open my $fh, '>', $_ or die "truncate: $!"; } - if (my $tail_cmd = $ENV{TAIL}) { # don't assume GNU tail - $tail_pid = fork; - if (defined $tail_pid && $tail_pid == 0) { - exec(split(' ', $tail_cmd), $out, $err); - } - } - my $cmd = [ $httpd, '-W0', @$args, + my $cmd = [ '-httpd', '-W0', @$args, "--stdout=$out", "--stderr=$err", $psgi ]; - $pid = spawn_listener(undef, $cmd, [ $https ]); + $td = start_script($cmd, undef, { 3 => $https }); my %o = ( SSL_hostname => 'server.local', SSL_verifycn_name => 'server.local', @@ -119,15 +107,9 @@ for my $args ( }; $c = undef; - kill('TERM', $pid); - is($pid, waitpid($pid, 0), 'httpd exited successfully'); + $td->kill; + $td->join; is($?, 0, 'no error in exited process'); - $pid = undef; - if (defined $tail_pid) { - kill 'TERM', $tail_pid; - waitpid($tail_pid, 0); - $tail_pid = undef; - } } done_testing(); 1; diff --git a/t/httpd-unix.t b/t/httpd-unix.t index 2c918281..5ec70fd8 100644 --- a/t/httpd-unix.t +++ b/t/httpd-unix.t @@ -4,6 +4,8 @@ use strict; use warnings; use Test::More; +require './t/common.perl'; +use Errno qw(EADDRINUSE); foreach my $mod (qw(Plack::Util Plack::Builder HTTP::Date HTTP::Status)) { eval "require $mod"; @@ -14,23 +16,16 @@ use File::Temp qw/tempdir/; use IO::Socket::UNIX; my $tmpdir = tempdir('httpd-unix-XXXXXX', TMPDIR => 1, CLEANUP => 1); my $unix = "$tmpdir/unix.sock"; -my $httpd = 'blib/script/public-inbox-httpd'; my $psgi = './t/httpd-corner.psgi'; my $out = "$tmpdir/out.log"; my $err = "$tmpdir/err.log"; - -my $pid; -END { kill 'TERM', $pid if defined $pid }; +my $td; my $spawn_httpd = sub { my (@args) = @_; push @args, '-W0'; - $pid = fork; - if ($pid == 0) { - exec $httpd, @args, "--stdout=$out", "--stderr=$err", $psgi; - die "FAIL: $!\n"; - } - ok(defined $pid, 'forked httpd process successfully'); + my $cmd = [ '-httpd', @args, "--stdout=$out", "--stderr=$err", $psgi ]; + $td = start_script($cmd); }; { @@ -65,15 +60,18 @@ sub check_sock ($) { check_sock($unix); { # do not clobber existing socket - my $fpid = fork; - if ($fpid == 0) { - open STDOUT, '>>', "$tmpdir/1" or die "redirect failed: $!"; - open STDERR, '>>', "$tmpdir/2" or die "redirect failed: $!"; - exec $httpd, '-l', $unix, '-W0', $psgi; - die "FAIL: $!\n"; - } - is($fpid, waitpid($fpid, 0), 'second httpd exits'); - isnt($?, 0, 'httpd failed with failure to bind'); + my %err = ( 'linux' => EADDRINUSE ); + open my $out, '>>', "$tmpdir/1" or die "redirect failed: $!"; + open my $err, '>>', "$tmpdir/2" or die "redirect failed: $!"; + my $cmd = ['-httpd', '-l', $unix, '-W0', $psgi]; + my $ftd = start_script($cmd, undef, { 1 => $out, 2 => $err }); + $ftd->join; + isnt($?, 0, 'httpd failure set $?'); + SKIP: { + my $ec = $err{$^O} or + skip("not sure if $^O fails with EADDRINUSE", 1); + is($? >> 8, $ec, 'httpd failed with EADDRINUSE'); + }; open my $fh, "$tmpdir/2" or die "failed to open $tmpdir/2: $!"; local $/; my $e = <$fh>; @@ -82,10 +80,8 @@ check_sock($unix); } { - my $kpid = $pid; - $pid = undef; - is(kill('TERM', $kpid), 1, 'terminate existing process'); - is(waitpid($kpid, 0), $kpid, 'existing httpd terminated'); + is($td->kill, 1, 'terminate existing process'); + $td->join; is($?, 0, 'existing httpd exited successfully'); ok(-S $unix, 'unix socket still exists'); } @@ -96,9 +92,8 @@ SKIP: { # wait for daemonization $spawn_httpd->("-l$unix", '-D', '-P', "$tmpdir/pid"); - my $kpid = $pid; - $pid = undef; - is(waitpid($kpid, 0), $kpid, 'existing httpd terminated'); + $td->join; + is($?, 0, 'daemonized process OK'); check_sock($unix); ok(-f "$tmpdir/pid", 'pid file written'); @@ -21,13 +21,11 @@ my $maindir = "$tmpdir/main.git"; my $group = 'test-httpd'; my $addr = $group . '@example.com'; my $cfgpfx = "publicinbox.$group"; -my $httpd = 'blib/script/public-inbox-httpd'; my $sock = tcp_server(); -my $pid; +my $td; use_ok 'PublicInbox::Git'; use_ok 'PublicInbox::Import'; use_ok 'Email::MIME'; -END { kill 'TERM', $pid if defined $pid }; { local $ENV{HOME} = $home; my $cmd = [ '-init', $group, $maindir, 'http://example.com/', $addr ]; @@ -52,8 +50,8 @@ EOF $im->done($mime); } ok($sock, 'sock created'); - $cmd = [ $httpd, '-W0', "--stdout=$out", "--stderr=$err" ]; - $pid = spawn_listener(undef, $cmd, [$sock]); + $cmd = [ '-httpd', '-W0', "--stdout=$out", "--stderr=$err" ]; + $td = start_script($cmd, undef, { 3 => $sock }); my $host = $sock->sockhost; my $port = $sock->sockport; my $conn = tcp_connect($sock); @@ -78,9 +76,8 @@ EOF "http://$host:$port/$group", "$tmpdir/dumb.git"), 0, 'clone successful'); - ok(kill('TERM', $pid), 'killed httpd'); - $pid = undef; - waitpid(-1, 0); + ok($td->kill, 'killed httpd'); + $td->join; is(system('git', "--git-dir=$tmpdir/clone.git", qw(fsck --no-verbose)), 0, diff --git a/t/nntpd-tls.t b/t/nntpd-tls.t index 4e71e82d..5d170b78 100644 --- a/t/nntpd-tls.t +++ b/t/nntpd-tls.t @@ -41,16 +41,8 @@ my $inboxdir = "$tmpdir"; my $pi_config = "$tmpdir/pi_config"; my $group = 'test-nntpd-tls'; my $addr = $group . '@example.com'; -my $nntpd = 'blib/script/public-inbox-nntpd'; my $starttls = tcp_server(); my $nntps = tcp_server(); -my ($pid, $tail_pid); -END { - foreach ($pid, $tail_pid) { - kill 'TERM', $_ if defined $_; - } -}; - my $ibx = PublicInbox::Inbox->new({ inboxdir => $inboxdir, name => 'nntpd-tls', @@ -91,6 +83,7 @@ EOF my $nntps_addr = $nntps->sockhost . ':' . $nntps->sockport; my $starttls_addr = $starttls->sockhost . ':' . $starttls->sockport; my $env = { PI_CONFIG => $pi_config }; +my $td; for my $args ( [ "--cert=$cert", "--key=$key", @@ -100,14 +93,8 @@ for my $args ( for ($out, $err) { open my $fh, '>', $_ or die "truncate: $!"; } - if (my $tail_cmd = $ENV{TAIL}) { # don't assume GNU tail - $tail_pid = fork; - if (defined $tail_pid && $tail_pid == 0) { - exec(split(' ', $tail_cmd), $out, $err); - } - } - my $cmd = [ $nntpd, '-W0', @$args, "--stdout=$out", "--stderr=$err" ]; - $pid = spawn_listener($env, $cmd, [ $starttls, $nntps ]); + my $cmd = [ '-nntpd', '-W0', @$args, "--stdout=$out", "--stderr=$err" ]; + $td = start_script($cmd, $env, { 3 => $starttls, 4 => $nntps }); my %o = ( SSL_hostname => 'server.local', SSL_verifycn_name => 'server.local', @@ -211,21 +198,15 @@ for my $args ( }; $c = undef; - kill('TERM', $pid); - is($pid, waitpid($pid, 0), 'nntpd exited successfully'); + $td->kill; + $td->join; is($?, 0, 'no error in exited process'); - $pid = undef; my $eout = eval { open my $fh, '<', $err or die "open $err failed: $!"; local $/; <$fh>; }; unlike($eout, qr/wide/i, 'no Wide character warnings'); - if (defined $tail_pid) { - kill 'TERM', $tail_pid; - waitpid($tail_pid, 0); - $tail_pid = undef; - } } done_testing(); diff --git a/t/nntpd-validate.t b/t/nntpd-validate.t index de024394..e3c10d9c 100644 --- a/t/nntpd-validate.t +++ b/t/nntpd-validate.t @@ -10,9 +10,15 @@ use Symbol qw(gensym); use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC); my $inbox_dir = $ENV{GIANT_INBOX_DIR}; plan skip_all => "GIANT_INBOX_DIR not defined for $0" unless $inbox_dir; +if (my $m = $ENV{TEST_RUN_MODE}) { + plan skip_all => "threads conflict w/ TEST_RUN_MODE=$m"; +} my $mid = $ENV{TEST_MID}; # This test is also an excuse for me to experiment with Perl threads :P +# TODO: get rid of threads, I was reading an old threads(3perl) manpage +# and missed the WARNING in the newer ones about it being "discouraged" +# in perlpolicy(1). unless (eval 'use threads; 1') { plan skip_all => "$0 requires a threaded perl" if $@; } @@ -37,13 +43,8 @@ if ($test_tls && !-r $key || !-r $cert) { require './t/common.perl'; my $keep_tmp = !!$ENV{TEST_KEEP_TMP}; my $tmpdir = tempdir('nntpd-validate-XXXXXX',TMPDIR => 1,CLEANUP => $keep_tmp); -my (%OPT, $pid, $tail_pid, $host_port, $group); +my (%OPT, $td, $host_port, $group); my $batch = 1000; -END { - foreach ($pid, $tail_pid) { - kill 'TERM', $_ if defined $_; - } -}; if (($ENV{NNTP_TEST_URL} // '') =~ m!\Anntp://([^/]+)/([^/]+)\z!) { ($host_port, $group) = ($1, $2); $host_port .= ":119" unless index($host_port, ':') > 0; @@ -149,7 +150,6 @@ sub make_local_server { $group = 'inbox.test.perf.nntpd'; my $ibx = { inboxdir => $inbox_dir, newsgroup => $group }; $ibx = PublicInbox::Inbox->new($ibx); - my $nntpd = 'blib/script/public-inbox-nntpd'; my $pi_config = "$tmpdir/config"; { open my $fh, '>', $pi_config or die "open($pi_config): $!"; @@ -165,20 +165,13 @@ sub make_local_server { for ($out, $err) { open my $fh, '>', $_ or die "truncate: $!"; } - if (my $tail_cmd = $ENV{TAIL}) { # don't assume GNU tail - $tail_pid = fork; - if (defined $tail_pid && $tail_pid == 0) { - open STDOUT, '>&STDERR' or die ">&2 failed: $!"; - exec(split(' ', $tail_cmd), $out, $err); - } - } my $sock = tcp_server(); ok($sock, 'sock created'); $host_port = $sock->sockhost . ':' . $sock->sockport; # not using multiple workers, here, since we want to increase # the chance of tripping concurrency bugs within PublicInbox/NNTP*.pm - my $cmd = [ $nntpd, "--stdout=$out", "--stderr=$err", '-W0' ]; + my $cmd = [ '-nntpd', "--stdout=$out", "--stderr=$err", '-W0' ]; push @$cmd, "-lnntp://$host_port"; if ($test_tls) { push @$cmd, "--cert=$cert", "--key=$key"; @@ -190,7 +183,9 @@ sub make_local_server { ); } print STDERR "# CMD ". join(' ', @$cmd). "\n"; - $pid = spawn_listener({ PI_CONFIG => $pi_config }, $cmd, [$sock]); + my $env = { PI_CONFIG => $pi_config }; + # perl threads and run_mode != 0 don't get along + $td = start_script($cmd, $env, { run_mode => 0, 3 => $sock }); } package DigestPipe; @@ -29,7 +29,6 @@ my $out = "$tmpdir/stdout.log"; my $inboxdir = "$tmpdir/main.git"; my $group = 'test-nntpd'; my $addr = $group . '@example.com'; -my $nntpd = 'blib/script/public-inbox-nntpd'; SKIP: { skip "git 2.6+ required for V2Writable", 1 if $version == 1; use_ok 'PublicInbox::V2Writable'; @@ -37,9 +36,8 @@ SKIP: { my %opts; my $sock = tcp_server(); -my $pid; +my $td; my $len; -END { kill 'TERM', $pid if defined $pid }; my $ibx = { inboxdir => $inboxdir, @@ -90,9 +88,8 @@ EOF } ok($sock, 'sock created'); - my $cmd = [ $nntpd, '-W0', "--stdout=$out", "--stderr=$err" ]; - $pid = spawn_listener(undef, $cmd, [ $sock ]); - ok(defined $pid, 'forked nntpd process successfully'); + my $cmd = [ '-nntpd', '-W0', "--stdout=$out", "--stderr=$err" ]; + $td = start_script($cmd, undef, { 3 => $sock }); my $host_port = $sock->sockhost . ':' . $sock->sockport; my $n = Net::NNTP->new($host_port); my $list = $n->list; @@ -306,7 +303,7 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000 is($? >> 8, 0, 'no errors'); } SKIP: { - my @of = `lsof -p $pid 2>/dev/null`; + my @of = `lsof -p $td->{pid} 2>/dev/null`; skip('lsof broken', 1) if (!scalar(@of) || $?); my @xap = grep m!Search/Xapian!, @of; is_deeply(\@xap, [], 'Xapian not loaded in nntpd'); @@ -315,7 +312,7 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000 setsockopt($s, IPPROTO_TCP, TCP_NODELAY, 1); syswrite($s, 'HDR List-id 1-'); select(undef, undef, undef, 0.15); - ok(kill('TERM', $pid), 'killed nntpd'); + ok($td->kill, 'killed nntpd'); select(undef, undef, undef, 0.15); syswrite($s, "\r\n"); $buf = ''; @@ -329,7 +326,7 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000 } $n = $s = undef; - is($pid, waitpid($pid, 0), 'nntpd exited successfully'); + $td->join; my $eout = eval { local $/; open my $fh, '<', $err or die "open $err failed: $!"; @@ -339,6 +336,7 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000 unlike($eout, qr/wide/i, 'no Wide character warnings'); } +$td = undef; done_testing(); sub read_til_dot { diff --git a/t/perf-nntpd.t b/t/perf-nntpd.t index 7abf2249..c7d2eaff 100644 --- a/t/perf-nntpd.t +++ b/t/perf-nntpd.t @@ -10,18 +10,9 @@ use Net::NNTP; my $pi_dir = $ENV{GIANT_PI_DIR}; plan skip_all => "GIANT_PI_DIR not defined for $0" unless $pi_dir; eval { require PublicInbox::Search }; -my ($host_port, $group, %opts, $s, $pid); +my ($host_port, $group, %opts, $s, $td); require './t/common.perl'; -END { - if ($s) { - $s->print("QUIT\r\n"); - $s->getline; - $s = undef; - } - kill 'TERM', $pid if defined $pid; -}; - if (($ENV{NNTP_TEST_URL} || '') =~ m!\Anntp://([^/]+)/([^/]+)\z!) { ($host_port, $group) = ($1, $2); $host_port .= ":119" unless index($host_port, ':') > 0; @@ -29,7 +20,6 @@ if (($ENV{NNTP_TEST_URL} || '') =~ m!\Anntp://([^/]+)/([^/]+)\z!) { $group = 'inbox.test.perf.nntpd'; my $ibx = { inboxdir => $pi_dir, newsgroup => $group }; $ibx = PublicInbox::Inbox->new($ibx); - my $nntpd = 'blib/script/public-inbox-nntpd'; my $tmpdir = tempdir('perf-nntpd-XXXXXX', TMPDIR => 1, CLEANUP => 1); my $pi_config = "$tmpdir/config"; @@ -46,8 +36,8 @@ if (($ENV{NNTP_TEST_URL} || '') =~ m!\Anntp://([^/]+)/([^/]+)\z!) { my $sock = tcp_server(); ok($sock, 'sock created'); - my $cmd = [ $nntpd, '-W0' ]; - $pid = spawn_listener({ PI_CONFIG => $pi_config }, $cmd, [$sock]); + my $cmd = [ '-nntpd', '-W0' ]; + $td = start_script($cmd, { PI_CONFIG => $pi_config }, { 3 => $sock }); $host_port = $sock->sockhost . ':' . $sock->sockport; } %opts = ( @@ -110,6 +100,12 @@ $t = timeit(1, sub { }); diag 'newnews took: ' . timestr($t) . " for $n"; +if ($s) { + $s->print("QUIT\r\n"); + $s->getline; +} + + done_testing(); 1; diff --git a/t/v2mirror.t b/t/v2mirror.t index 2c7f6a84..1a39ce49 100644 --- a/t/v2mirror.t +++ b/t/v2mirror.t @@ -21,7 +21,6 @@ use PublicInbox::MIME; use PublicInbox::Config; # FIXME: too much setup my $tmpdir = tempdir('pi-v2mirror-XXXXXX', TMPDIR => 1, CLEANUP => 1); -my $script = 'blib/script/public-inbox'; my $pi_config = "$tmpdir/config"; { open my $fh, '>', $pi_config or die "open($pi_config): $!"; @@ -60,19 +59,10 @@ ok($epoch_max > 0, "multiple epochs"); $v2w->done; $ibx->cleanup; -my ($sock, $pid); - -# TODO: replace this with ->DESTROY: -my $owner_pid = $$; -END { kill('TERM', $pid) if defined($pid) && $owner_pid == $$ }; - -$! = 0; -$sock = tcp_server(); +my $sock = tcp_server(); ok($sock, 'sock created'); -my $httpd = "$script-httpd"; -my $cmd = [ $httpd, '-W0', "--stdout=$tmpdir/out", "--stderr=$tmpdir/err" ]; -ok(defined($pid = spawn_listener(undef, $cmd, [ $sock ])), - 'spawned httpd process successfully'); +my $cmd = [ '-httpd', '-W0', "--stdout=$tmpdir/out", "--stderr=$tmpdir/err" ]; +my $td = start_script($cmd, undef, { 3 => $sock }); my ($host, $port) = ($sock->sockhost, $sock->sockport); $sock = undef; @@ -194,9 +184,8 @@ is($mibx->git->check($to_purge), undef, 'unindex+prune successful in mirror'); is(scalar($mset->items), 0, '1@example.com no longer visible in mirror'); } -ok(kill('TERM', $pid), 'killed httpd'); -$pid = undef; -waitpid(-1, 0); +ok($td->kill, 'killed httpd'); +$td->join; done_testing(); diff --git a/t/v2writable.t b/t/v2writable.t index 28420bb9..4bb6d733 100644 --- a/t/v2writable.t +++ b/t/v2writable.t @@ -163,12 +163,10 @@ EOF close $fh or die "close: $!\n"; my $sock = tcp_server(); ok($sock, 'sock created'); - my $pid; my $len; - END { kill 'TERM', $pid if defined $pid }; - my $nntpd = 'blib/script/public-inbox-nntpd'; - my $cmd = [ $nntpd, '-W0', "--stdout=$out", "--stderr=$err" ]; - $pid = spawn_listener({ PI_CONFIG => $pi_config }, $cmd, [ $sock ]); + my $cmd = [ '-nntpd', '-W0', "--stdout=$out", "--stderr=$err" ]; + my $env = { PI_CONFIG => $pi_config }; + my $td = start_script($cmd, $env, { 3 => $sock }); my $host_port = $sock->sockhost . ':' . $sock->sockport; my $n = Net::NNTP->new($host_port); $n->group($group); diff --git a/t/www_listing.t b/t/www_listing.t index 61a059e5..9cde3575 100644 --- a/t/www_listing.t +++ b/t/www_listing.t @@ -64,15 +64,13 @@ sub tiny_test { 'epoch 1 in description'); } -my $pid; -END { kill 'TERM', $pid if defined $pid }; +my $td; SKIP: { my $err = "$tmpdir/stderr.log"; my $out = "$tmpdir/stdout.log"; my $alt = "$tmpdir/alt.git"; my $cfgfile = "$tmpdir/config"; my $v2 = "$tmpdir/v2"; - my $httpd = 'blib/script/public-inbox-httpd'; my $sock = tcp_server(); ok($sock, 'sock created'); my ($host, $port) = ($sock->sockhost, $sock->sockport); @@ -106,8 +104,8 @@ SKIP: { close $fh or die; my $env = { PI_CONFIG => $cfgfile }; - my $cmd = [ $httpd, '-W0', "--stdout=$out", "--stderr=$err" ]; - $pid = spawn_listener($env, $cmd, [$sock]); + my $cmd = [ '-httpd', '-W0', "--stdout=$out", "--stderr=$err" ]; + $td = start_script($cmd, $env, { 3 => $sock }); $sock = undef; tiny_test($host, $port); |