user/dev discussion of public-inbox itself
 help / color / mirror / code / Atom feed
Search results ordered by [date|relevance]  view[summary|nested|Atom feed]
thread overview below | download mbox.gz: |
* [PATCH 11/17] t/common: start_script replaces spawn_listener
  2019-11-24  0:22  5%       ` [PATCH 00/17] test fixes and cleanups Eric Wong
@ 2019-11-24  0:22  1%         ` Eric Wong
  0 siblings, 0 replies; 6+ results
From: Eric Wong @ 2019-11-24  0:22 UTC (permalink / raw)
  To: meta

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        | 174 +++++++++++++++++++++++++++++++------------
 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            |  16 ++--
 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..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');
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 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;
diff --git a/t/nntpd.t b/t/nntpd.t
index 4795dc00..3c928610 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, '-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);

^ permalink raw reply related	[relevance 1%]

* [PATCH 29/29] t/common: start_script replaces spawn_listener
  2019-11-15  9:50  5% [PATCH 00/29] speed up tests by preloading Eric Wong
@ 2019-11-15  9:51  1% ` Eric Wong
  2019-11-16  6:52  7%   ` Eric Wong
  0 siblings, 1 reply; 6+ results
From: Eric Wong @ 2019-11-15  9:51 UTC (permalink / raw)
  To: meta

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);

^ permalink raw reply related	[relevance 1%]

* [PATCH 00/29] speed up tests by preloading
@ 2019-11-15  9:50  5% Eric Wong
  2019-11-15  9:51  1% ` [PATCH 29/29] t/common: start_script replaces spawn_listener Eric Wong
  0 siblings, 1 reply; 6+ results
From: Eric Wong @ 2019-11-15  9:50 UTC (permalink / raw)
  To: meta

On my fastest system, this brings "make check" time down from
~17s to ~10s.  This also improves consistency of our test suite,
adds ENV{TAIL} support to all daemons, and removes the test-time
dependency on the IPC::Run module.

Several cleanups were necessary to limit the scope of some
references and minor bugs were found (and fixed) in preparation
for this.  Most of the changes were to explicitly pass global
variables into subs to avoid warnings.

TEST_RUN_MODE=0 can be set in the environment to restore
real-world behavior with (v)fork && execve.

Eric Wong (29):
  edit: pass global variables into subs
  edit: use OO API of File::Temp to shorten lifetime
  admin: get rid of singleton $CFG var
  index: pass global variables into subs
  init: pass global variables into subs
  mda: pass global variables into subs
  learn: pass global variables into subs
  inboxwritable: add ->cleanup method
  import: only pass Inbox object to SearchIdx->new
  xapcmd: do not fire END and DESTROY handlers in child
  spawn: which: allow embedded slash for relative path
  t/common: introduce run_script wrapper for t/cgi.t
  t/edit: switch to use run_script
  t/init: convert to using run_script
  t/purge: convert to run_script
  t/v2mirror: get rid of IPC::Run dependency
  t/mda: switch to run_script for testing
  t/mda_filter_rubylang: drop IPC::Run dependency
  doc: remove IPC::Run as a dev and test dependency
  t/v2mirror: switch to default run_mode for speedup
  t/convert-compact: convert to run_script
  t/httpd: use run_script for -init
  t/watch_maildir_v2: use run_script for -init
  t/nntpd: use run_script for -init
  t/watch_filter_rubylang: run_script for -init and -index
  t/v2mda: switch to run_script in many places
  t/indexlevels-mirror*: switch to run_script
  t/xcpdb-reshard: use run_script for -xcpdb
  t/common: start_script replaces spawn_listener

 INSTALL                          |   4 -
 ci/deps.perl                     |   1 -
 lib/PublicInbox/Admin.pm         |   9 +-
 lib/PublicInbox/Import.pm        |   4 +-
 lib/PublicInbox/InboxWritable.pm |   4 +
 lib/PublicInbox/Spawn.pm         |   2 +-
 lib/PublicInbox/Xapcmd.pm        |   5 +-
 script/public-inbox-edit         |  40 ++---
 script/public-inbox-index        |   3 +-
 script/public-inbox-init         |  27 +++-
 script/public-inbox-learn        |   8 +-
 script/public-inbox-mda          |  12 +-
 t/cgi.t                          |  16 +-
 t/common.perl                    | 248 ++++++++++++++++++++++++++++---
 t/convert-compact.t              |  18 +--
 t/edit.t                         |  65 ++++----
 t/git-http-backend.t             |  14 +-
 t/httpd-corner.t                 |  48 +++---
 t/httpd-https.t                  |  28 +---
 t/httpd-unix.t                   |  47 +++---
 t/httpd.t                        |  18 +--
 t/indexlevels-mirror.t           |  24 +--
 t/init.t                         |  85 +++++------
 t/mda.t                          |  53 ++++---
 t/mda_filter_rubylang.t          |  17 +--
 t/nntpd-tls.t                    |  29 +---
 t/nntpd-validate.t               |  27 ++--
 t/nntpd.t                        |  22 ++-
 t/perf-nntpd.t                   |  22 ++-
 t/purge.t                        |  20 +--
 t/v2mda.t                        |  38 ++---
 t/v2mirror.t                     |  55 +++----
 t/v2writable.t                   |   8 +-
 t/watch_filter_rubylang.t        |   6 +-
 t/watch_maildir_v2.t             |   4 +-
 t/www_listing.t                  |   8 +-
 t/xcpdb-reshard.t                |   5 +-
 37 files changed, 584 insertions(+), 460 deletions(-)


^ permalink raw reply	[relevance 5%]

* [PATCH 00/17] test fixes and cleanups
  2019-11-16 11:43  7%     ` Eric Wong
@ 2019-11-24  0:22  5%       ` Eric Wong
  2019-11-24  0:22  1%         ` [PATCH 11/17] t/common: start_script replaces spawn_listener Eric Wong
  0 siblings, 1 reply; 6+ results
From: Eric Wong @ 2019-11-24  0:22 UTC (permalink / raw)
  To: meta

There's some fixes for race conditions around daemon
startup and shutdown and resurrects start_script for
slightly improved test performance.

And slowly eliminating all END{} block usages

Eric Wong (17):
  tests: disable daemon workers in a few more places
  tests: use strict everywhere
  t/v1-add-remove-add: quiet down "git init"
  t/xcpdb-reshard: test xcpdb --compact
  t/httpd-corner: wait for worker process death
  t/nntpd-tls: sometimes SSL_connect succeeds quickly
  .gitignore: ignore local prove(1) files
  daemon: use sigprocmask to block signals at startup
  daemon: use sigprocmask when respawning workers
  daemon: avoid race when quitting workers
  t/common: start_script replaces spawn_listener
  t/nntpd-validate: get rid of threads dependency
  xapcmd: replace Xtmpdirs with File::Temp->newdir
  tests: use File::Temp->newdir instead of tempdir()
  tests: quiet down commit graph
  t/perf-*.t: use $ENV{GIANT_INBOX_DIR} consistently
  tests: move giant inbox/git dependent tests to xt/

 .gitignore                   |   2 +
 MANIFEST                     |  11 ++-
 lib/PublicInbox/Daemon.pm    |  35 +++++--
 lib/PublicInbox/Xapcmd.pm    |  73 +++++---------
 t/.gitconfig                 |   4 +
 t/admin.t                    |   4 +-
 t/altid.t                    |   4 +-
 t/altid_v2.t                 |   3 +-
 t/cgi.t                      |   3 +-
 t/common.perl                | 184 ++++++++++++++++++++++++++---------
 t/config.t                   |   4 +-
 t/convert-compact.t          |   3 +-
 t/edit.t                     |   3 +-
 t/emergency.t                |   4 +-
 t/feed.t                     |   3 +-
 t/filter_rubylang.t          |   5 +-
 t/git.t                      |   6 +-
 t/html_index.t               |   4 +-
 t/httpd-corner.psgi          |   2 +-
 t/httpd-corner.t             |  70 +++++++------
 t/httpd-https.t              |  31 ++----
 t/httpd-unix.t               |  51 +++++-----
 t/httpd.t                    |  16 ++-
 t/import.t                   |   4 +-
 t/indexlevels-mirror.t       |   3 +-
 t/init.t                     |   3 +-
 t/mda.t                      |   3 +-
 t/mda_filter_rubylang.t      |   3 +-
 t/mid.t                      |   1 +
 t/msgmap.t                   |   4 +-
 t/nntpd-tls.t                |  42 +++-----
 t/nntpd.t                    |  19 ++--
 t/nulsubject.t               |   4 +-
 t/over.t                     |   4 +-
 t/plack.t                    |   4 +-
 t/psgi_attach.t              |   4 +-
 t/psgi_bad_mids.t            |   4 +-
 t/psgi_mount.t               |   4 +-
 t/psgi_multipart_not.t       |   4 +-
 t/psgi_scan_all.t            |   4 +-
 t/psgi_search.t              |   4 +-
 t/psgi_text.t                |   4 +-
 t/psgi_v2.t                  |   3 +-
 t/purge.t                    |   4 +-
 t/qspawn.t                   |   1 +
 t/replace.t                  |   6 +-
 t/search-thr-index.t         |   4 +-
 t/search.t                   |   4 +-
 t/solver_git.t               |   3 +-
 t/spamcheck_spamc.t          |   4 +-
 t/v1-add-remove-add.t        |   6 +-
 t/v1reindex.t                |   3 +-
 t/v2-add-remove-add.t        |   3 +-
 t/v2mda.t                    |   3 +-
 t/v2mirror.t                 |  26 ++---
 t/v2reindex.t                |   3 +-
 t/v2writable.t               |  13 ++-
 t/watch_filter_rubylang.t    |   3 +-
 t/watch_maildir.t            |   5 +-
 t/watch_maildir_v2.t         |  10 +-
 t/www_listing.t              |  11 +--
 t/xcpdb-reshard.t            |   7 +-
 {t => xt}/git-http-backend.t |  19 ++--
 {t => xt}/nntpd-validate.t   |  57 +++++------
 {t => xt}/perf-msgview.t     |   6 +-
 {t => xt}/perf-nntpd.t       |  34 +++----
 {t => xt}/perf-threading.t   |   8 +-
 67 files changed, 462 insertions(+), 431 deletions(-)
 create mode 100644 t/.gitconfig
 rename {t => xt}/git-http-backend.t (87%)
 rename {t => xt}/nntpd-validate.t (85%)
 rename {t => xt}/perf-msgview.t (85%)
 rename {t => xt}/perf-nntpd.t (79%)
 rename {t => xt}/perf-threading.t (72%)


^ permalink raw reply	[relevance 5%]

* Re: [PATCH 29/29] t/common: start_script replaces spawn_listener
  2019-11-15  9:51  1% ` [PATCH 29/29] t/common: start_script replaces spawn_listener Eric Wong
@ 2019-11-16  6:52  7%   ` Eric Wong
  2019-11-16 11:43  7%     ` Eric Wong
  0 siblings, 1 reply; 6+ results
From: Eric Wong @ 2019-11-16  6:52 UTC (permalink / raw)
  To: meta

Eric Wong <e@80x24.org> wrote:
> diff --git a/t/nntpd.t b/t/nntpd.t
> index b516ffd1..eb9be9b7 100644
> --- a/t/nntpd.t
> +++ b/t/nntpd.t
> @@ -339,6 +336,8 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000
>  	unlike($eout, qr/wide/i, 'no Wide character warnings');
>  }
>  
> +diag "$td";

Oops, diag was leftover and should not be there.

> 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);

"$n" (Net::NNTP) and "$td" (TestDaemon) going out of scope at
the same time seems to trigger some strange ->DESTROY
interaction since both classes have a ->DESTROY method.

This causes t/v2writable to be stuck until the 60s
EvCleanup::later timer fires (well, I'm pretty sure
it's the EvCleanup::later timer, since it takes ~60s
to fail and not 180s).

Trying to strace the nntpd kicks it right away, so I'm
trhing to reproduce it and strace the Net::NNTP client
process...

^ permalink raw reply	[relevance 7%]

* Re: [PATCH 29/29] t/common: start_script replaces spawn_listener
  2019-11-16  6:52  7%   ` Eric Wong
@ 2019-11-16 11:43  7%     ` Eric Wong
  2019-11-24  0:22  5%       ` [PATCH 00/17] test fixes and cleanups Eric Wong
  0 siblings, 1 reply; 6+ results
From: Eric Wong @ 2019-11-16 11:43 UTC (permalink / raw)
  To: meta

Eric Wong <e@80x24.org> wrote:
> "$n" (Net::NNTP) and "$td" (TestDaemon) going out of scope at
> the same time seems to trigger some strange ->DESTROY
> interaction since both classes have a ->DESTROY method.

Nope, I was wrong about that :x

> This causes t/v2writable to be stuck until the 60s
> EvCleanup::later timer fires (well, I'm pretty sure
> it's the EvCleanup::later timer, since it takes ~60s
> to fail and not 180s).

Actual problem seems to be END {} not firing for EvCleanup.pm
because of POSIX::_exit use in the test.  But NNTP shutdown
seems to have some other problems, too.  Will try to sort out
sometime later.

Anyways, the other 28 patches in this series seem fine and
are in master.

^ permalink raw reply	[relevance 7%]

Results 1-6 of 6 | reverse | options above
-- pct% links below jump to the message on this page, permalinks otherwise --
2019-11-15  9:50  5% [PATCH 00/29] speed up tests by preloading Eric Wong
2019-11-15  9:51  1% ` [PATCH 29/29] t/common: start_script replaces spawn_listener Eric Wong
2019-11-16  6:52  7%   ` Eric Wong
2019-11-16 11:43  7%     ` Eric Wong
2019-11-24  0:22  5%       ` [PATCH 00/17] test fixes and cleanups Eric Wong
2019-11-24  0:22  1%         ` [PATCH 11/17] t/common: start_script replaces spawn_listener Eric Wong

Code repositories for project(s) associated with this public inbox

	https://80x24.org/public-inbox.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).