From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on dcvr.yhbt.net X-Spam-Level: X-Spam-ASN: X-Spam-Status: No, score=-4.0 required=3.0 tests=ALL_TRUSTED,BAYES_00 shortcircuit=no autolearn=ham autolearn_force=no version=3.4.2 Received: from localhost (dcvr.yhbt.net [127.0.0.1]) by dcvr.yhbt.net (Postfix) with ESMTP id 3E58E1F5C7 for ; Fri, 15 Nov 2019 09:51:06 +0000 (UTC) From: Eric Wong To: meta@public-inbox.org Subject: [PATCH 29/29] t/common: start_script replaces spawn_listener Date: Fri, 15 Nov 2019 09:51:00 +0000 Message-Id: <20191115095100.25633-30-e@80x24.org> In-Reply-To: <20191115095100.25633-1-e@80x24.org> References: <20191115095100.25633-1-e@80x24.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit List-Id: We can shave several hundred milliseconds off tests which spawn daemons by preloading and avoiding startup time for common modules which are already loaded in the parent process. This also gives ENV{TAIL} support to all tests which support daemons which log to stdout/stderr. --- t/common.perl | 173 +++++++++++++++++++++++++++++++------------ t/git-http-backend.t | 14 ++-- t/httpd-corner.t | 48 +++++++----- t/httpd-https.t | 28 ++----- t/httpd-unix.t | 47 ++++++------ t/httpd.t | 13 ++-- t/nntpd-tls.t | 29 ++------ t/nntpd-validate.t | 27 +++---- t/nntpd.t | 17 ++--- t/perf-nntpd.t | 22 +++--- t/v2mirror.t | 21 ++---- t/v2writable.t | 8 +- t/www_listing.t | 8 +- 13 files changed, 234 insertions(+), 221 deletions(-) diff --git a/t/common.perl b/t/common.perl index c5693080..29254fef 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,98 @@ 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; + } + 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 b063d9fa..5efa6ab2 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->(); @@ -208,16 +205,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'); } @@ -239,15 +234,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'); } @@ -341,9 +334,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') { @@ -351,7 +342,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'); } @@ -548,12 +539,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 d0c70a72..81626497 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,22 +16,15 @@ 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) = @_; - $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); }; { @@ -64,15 +59,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>; @@ -81,10 +79,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'); } @@ -95,9 +91,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'); diff --git a/t/httpd.t b/t/httpd.t index e7527ed6..ce8063b2 100644 --- a/t/httpd.t +++ b/t/httpd.t @@ -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 0b6afcef..9f2173ce 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', @@ -205,21 +192,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; diff --git a/t/nntpd.t b/t/nntpd.t index b516ffd1..eb9be9b7 100644 --- a/t/nntpd.t +++ b/t/nntpd.t @@ -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, "--stdout=$out", "--stderr=$err" ]; - $pid = spawn_listener(undef, $cmd, [ $sock ]); - ok(defined $pid, 'forked nntpd process successfully'); + my $cmd = [ '-nntpd', "--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,8 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000 unlike($eout, qr/wide/i, 'no Wide character warnings'); } +diag "$td"; +$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);