user/dev discussion of public-inbox itself
 help / color / mirror / code / Atom feed
From: Eric Wong <e@80x24.org>
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	[thread overview]
Message-ID: <20191115095100.25633-30-e@80x24.org> (raw)
In-Reply-To: <20191115095100.25633-1-e@80x24.org>

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

  parent reply	other threads:[~2019-11-15  9:51 UTC|newest]

Thread overview: 54+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2019-11-15  9:50 [PATCH 00/29] speed up tests by preloading Eric Wong
2019-11-15  9:50 ` [PATCH 01/29] edit: pass global variables into subs Eric Wong
2019-11-15  9:50 ` [PATCH 02/29] edit: use OO API of File::Temp to shorten lifetime Eric Wong
2019-11-15  9:50 ` [PATCH 03/29] admin: get rid of singleton $CFG var Eric Wong
2019-11-15  9:50 ` [PATCH 04/29] index: pass global variables into subs Eric Wong
2019-11-15  9:50 ` [PATCH 05/29] init: " Eric Wong
2019-11-15  9:50 ` [PATCH 06/29] mda: " Eric Wong
2019-11-15  9:50 ` [PATCH 07/29] learn: " Eric Wong
2019-11-15  9:50 ` [PATCH 08/29] inboxwritable: add ->cleanup method Eric Wong
2019-11-15  9:50 ` [PATCH 09/29] import: only pass Inbox object to SearchIdx->new Eric Wong
2019-11-15  9:50 ` [PATCH 10/29] xapcmd: do not fire END and DESTROY handlers in child Eric Wong
2019-11-15  9:50 ` [PATCH 11/29] spawn: which: allow embedded slash for relative path Eric Wong
2019-11-15  9:50 ` [PATCH 12/29] t/common: introduce run_script wrapper for t/cgi.t Eric Wong
2019-11-15  9:50 ` [PATCH 13/29] t/edit: switch to use run_script Eric Wong
2019-11-15  9:50 ` [PATCH 14/29] t/init: convert to using run_script Eric Wong
2019-11-15  9:50 ` [PATCH 15/29] t/purge: convert to run_script Eric Wong
2019-11-15  9:50 ` [PATCH 16/29] t/v2mirror: get rid of IPC::Run dependency Eric Wong
2019-11-15  9:50 ` [PATCH 17/29] t/mda: switch to run_script for testing Eric Wong
2019-11-15  9:50 ` [PATCH 18/29] t/mda_filter_rubylang: drop IPC::Run dependency Eric Wong
2019-11-15  9:50 ` [PATCH 19/29] doc: remove IPC::Run as a dev and test dependency Eric Wong
2019-11-15  9:50 ` [PATCH 20/29] t/v2mirror: switch to default run_mode for speedup Eric Wong
2019-11-15  9:50 ` [PATCH 21/29] t/convert-compact: convert to run_script Eric Wong
2019-11-15  9:50 ` [PATCH 22/29] t/httpd: use run_script for -init Eric Wong
2019-11-15  9:50 ` [PATCH 23/29] t/watch_maildir_v2: " Eric Wong
2019-11-15  9:50 ` [PATCH 24/29] t/nntpd: " Eric Wong
2019-11-15  9:50 ` [PATCH 25/29] t/watch_filter_rubylang: run_script for -init and -index Eric Wong
2019-11-15  9:50 ` [PATCH 26/29] t/v2mda: switch to run_script in many places Eric Wong
2019-11-15  9:50 ` [PATCH 27/29] t/indexlevels-mirror*: switch to run_script Eric Wong
2019-11-15  9:50 ` [PATCH 28/29] t/xcpdb-reshard: use run_script for -xcpdb Eric Wong
2019-11-15  9:51 ` Eric Wong [this message]
2019-11-16  6:52   ` [PATCH 29/29] t/common: start_script replaces spawn_listener Eric Wong
2019-11-16 11:43     ` Eric Wong
2019-11-24  0:22       ` [PATCH 00/17] test fixes and cleanups Eric Wong
2019-11-24  0:22         ` [PATCH 01/17] tests: disable daemon workers in a few more places Eric Wong
2019-11-24  0:22         ` [PATCH 02/17] tests: use strict everywhere Eric Wong
2019-11-24  0:22         ` [PATCH 03/17] t/v1-add-remove-add: quiet down "git init" Eric Wong
2019-11-24  0:22         ` [PATCH 04/17] t/xcpdb-reshard: test xcpdb --compact Eric Wong
2019-11-24  0:22         ` [PATCH 05/17] t/httpd-corner: wait for worker process death Eric Wong
2019-11-24  0:22         ` [PATCH 06/17] t/nntpd-tls: sometimes SSL_connect succeeds quickly Eric Wong
2019-11-24  0:22         ` [PATCH 07/17] .gitignore: ignore local prove(1) files Eric Wong
2019-11-24  0:22         ` [PATCH 08/17] daemon: use sigprocmask to block signals at startup Eric Wong
2019-11-24  0:22         ` [PATCH 09/17] daemon: use sigprocmask when respawning workers Eric Wong
2019-11-24  0:22         ` [PATCH 10/17] daemon: avoid race when quitting workers Eric Wong
2019-11-25  8:59           ` Eric Wong
2019-11-27  1:33             ` [PATCH 0/2] fix kqueue support and missed signal wakeups Eric Wong
2019-11-27  1:33               ` [PATCH 1/2] dskqxs: fix missing EV_DISPATCH define Eric Wong
2019-11-27  1:33               ` [PATCH 2/2] httpd|nntpd: avoid missed signal wakeups Eric Wong
2019-11-24  0:22         ` [PATCH 11/17] t/common: start_script replaces spawn_listener Eric Wong
2019-11-24  0:22         ` [PATCH 12/17] t/nntpd-validate: get rid of threads dependency Eric Wong
2019-11-24  0:22         ` [PATCH 13/17] xapcmd: replace Xtmpdirs with File::Temp->newdir Eric Wong
2019-11-24  0:22         ` [PATCH 14/17] tests: use File::Temp->newdir instead of tempdir() Eric Wong
2019-11-24  0:22         ` [PATCH 15/17] tests: quiet down commit graph Eric Wong
2019-11-24  0:22         ` [PATCH 16/17] t/perf-*.t: use $ENV{GIANT_INBOX_DIR} consistently Eric Wong
2019-11-24  0:22         ` [PATCH 17/17] tests: move giant inbox/git dependent tests to xt/ Eric Wong

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://public-inbox.org/README

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20191115095100.25633-30-e@80x24.org \
    --to=e@80x24.org \
    --cc=meta@public-inbox.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
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).