[PATCH 0/6] waitpid-related cleanups

[PATCH 0/6] waitpid-related cleanups

[Eric Wong]

Mainly, much of our code was too noisy and guarding for waitpid
error cases which never happen.

Perl `waitpid' will always retry on EINTR (cf. perlipc(1)) and
it never returns `undef' on error, only -1.  I don't understand
why Perl does it this way, all other syscalls return `undef' on
error, but Perl only documents -1 for errors and my
understanding of the Perl sources says it can't return `undef'.

So start working on reducing waitpid call sites...

Eric Wong (6):
  ds: awaitpid: Perl waitpid retries on EINTR automatically
  auto_reap: waitpid never returns undef
  lei_blob: use ProcessPipe to eliminate a waitpid call
  fetch: fix missing chdir arg for error reporting
  spamcheck/spamc: rely on ProcessPipe instead of waitpid
  spawn: add run_wait to simplify spawn+waitpid use

 lib/PublicInbox/AutoReap.pm        |  7 +++----
 lib/PublicInbox/DS.pm              |  9 +++------
 lib/PublicInbox/Fetch.pm           | 10 +++++-----
 lib/PublicInbox/LEI.pm             |  5 ++---
 lib/PublicInbox/LeiBlob.pm         | 19 +++++++------------
 lib/PublicInbox/LeiMailDiff.pm     |  6 ++----
 lib/PublicInbox/LeiMirror.pm       |  8 +++-----
 lib/PublicInbox/LeiRediff.pm       |  7 +++----
 lib/PublicInbox/SearchIdx.pm       |  6 ++----
 lib/PublicInbox/Spamcheck/Spamc.pm | 11 ++++-------
 lib/PublicInbox/Spawn.pm           | 13 +++++++++----
 lib/PublicInbox/TestCommon.pm      |  6 +-----
 12 files changed, 44 insertions(+), 63 deletions(-)

More deletions than insertions is good.

[PATCH 1/6] ds: awaitpid: Perl waitpid retries on EINTR automatically

[Eric Wong]

perlipc(1) man page states both wait + waitpid will retry
on EINTR.  Thus there's no need to retry it ourselves.
---
 lib/PublicInbox/DS.pm | 9 +++------
 1 file changed, 3 insertions(+), 6 deletions(-)

diff --git a/lib/PublicInbox/DS.pm b/lib/PublicInbox/DS.pm
index 49550b2b..142122a8 100644
--- a/lib/PublicInbox/DS.pm
+++ b/lib/PublicInbox/DS.pm
@@ -32,7 +32,7 @@ use PublicInbox::Syscall qw(%SIGNUM
 	EPOLLIN EPOLLOUT EPOLLONESHOT EPOLLEXCLUSIVE);
 use PublicInbox::Tmpfile;
 use PublicInbox::Select;
-use Errno qw(EAGAIN EINVAL ECHILD EINTR);
+use Errno qw(EAGAIN EINVAL ECHILD);
 use Carp qw(carp croak);
 our @EXPORT_OK = qw(now msg_more awaitpid add_timer add_uniq_timer);
 
@@ -713,16 +713,13 @@ sub awaitpid {
 	$AWAIT_PIDS->{$pid} = \@cb_args if @cb_args;
 	# provide synchronous API
 	if (defined(wantarray) || (!$in_loop && !@cb_args)) {
-		my $ret;
-again:
-		$ret = waitpid($pid, 0) // -2;
+		my $ret = waitpid($pid, 0);
 		if ($ret == $pid) {
 			my $cb_args = delete $AWAIT_PIDS->{$pid};
 			@cb_args = @$cb_args if !@cb_args && $cb_args;
 			await_cb($pid, @cb_args);
 		} else {
-			goto again if $! == EINTR;
-			carp "waitpid($pid): $!";
+			carp "waitpid($pid) => $ret ($!)";
 			delete $AWAIT_PIDS->{$pid};
 		}
 		return $ret;

[PATCH 2/6] auto_reap: waitpid never returns undef

[Eric Wong]

Reading the Perl source, it seems impossible to for waitpid
to return undef.  perlipc(1) man page also documents waitpid
(and `wait') as functions which always restart on EINTR.
---
 lib/PublicInbox/AutoReap.pm | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/lib/PublicInbox/AutoReap.pm b/lib/PublicInbox/AutoReap.pm
index 23ecce77..ae4984b8 100644
--- a/lib/PublicInbox/AutoReap.pm
+++ b/lib/PublicInbox/AutoReap.pm
@@ -3,8 +3,7 @@
 
 # automatically kill + reap children when this goes out-of-scope
 package PublicInbox::AutoReap;
-use v5.10.1;
-use strict;
+use v5.12;
 
 sub new {
 	my (undef, $pid, $cb) = @_;
@@ -21,8 +20,8 @@ sub join {
 	my $pid = delete $self->{pid} or return;
 	$self->{cb}->() if defined $self->{cb};
 	CORE::kill($sig, $pid) if defined $sig;
-	my $ret = waitpid($pid, 0) // die "waitpid($pid): $!";
-	$ret == $pid or die "BUG: waitpid($pid) != $ret";
+	my $r = waitpid($pid, 0);
+	$r == $pid or die "BUG? waitpid($pid) => $r (\$?=$? \$!=$!)";
 }
 
 sub DESTROY {

[PATCH 3/6] lei_blob: use ProcessPipe to eliminate a waitpid call

[Eric Wong]

waitpid with a positive PID isn't going to return anything
else unless we set ($SIG{CHLD} = 'IGNORE').
---
 lib/PublicInbox/LeiBlob.pm | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/lib/PublicInbox/LeiBlob.pm b/lib/PublicInbox/LeiBlob.pm
index 5fc6d902..1d8267c8 100644
--- a/lib/PublicInbox/LeiBlob.pm
+++ b/lib/PublicInbox/LeiBlob.pm
@@ -21,10 +21,9 @@ sub get_git_dir ($$) {
 	} else { # implicit --cwd, quiet errors
 		open $opt->{2}, '>', '/dev/null' or die "open /dev/null: $!";
 	}
-	my ($r, $pid) = popen_rd($cmd, {GIT_DIR => undef}, $opt);
+	my $r = popen_rd($cmd, {GIT_DIR => undef}, $opt);
 	chomp(my $gd = do { local $/; <$r> });
-	waitpid($pid, 0) == $pid or die "BUG: waitpid @$cmd ($!)";
-	$? == 0 ? $gd : undef;
+	close($r) ? $gd : undef;
 }
 
 sub solver_user_cb { # called by solver when done

[PATCH 4/6] fetch: fix missing chdir arg for error reporting

[Eric Wong]

We need to run `git config -l' in the epoch directory which
failed to get the proper config listing.  This went unnoticed
because it doesn't affect any known users and was only found
during code inspection for waitpid usage cleanups.
---
 lib/PublicInbox/Fetch.pm | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/lib/PublicInbox/Fetch.pm b/lib/PublicInbox/Fetch.pm
index f93eeebe..8f3a87e2 100644
--- a/lib/PublicInbox/Fetch.pm
+++ b/lib/PublicInbox/Fetch.pm
@@ -131,8 +131,9 @@ sub do_fetch { # main entry point
 				$epoch = $nr;
 			} else {
 				warn "W: $edir missing remote.*.url\n";
-				my $pid = spawn([qw(git config -l)], undef,
-					{ 1 => $lei->{2}, 2 => $lei->{2} });
+				my $o = { -C => $edir };
+				$o->{1} = $o->{2} = $lei->{2};
+				my $pid = spawn([qw(git config -l)], undef, $o);
 				waitpid($pid, 0);
 				$lei->child_error($?) if $?;
 			}

[PATCH 5/6] spamcheck/spamc: rely on ProcessPipe instead of waitpid

[Eric Wong]

We lose error information on CORE::close call, but the
underlying close(2) syscall won't EIO nor ENOSPC on a read-only
side of a pipe.  Perl is already shielding us from EINTR and
EBADF would be a bug in Perl itself.
---
 lib/PublicInbox/Spamcheck/Spamc.pm | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/lib/PublicInbox/Spamcheck/Spamc.pm b/lib/PublicInbox/Spamcheck/Spamc.pm
index 2f821532..67278917 100644
--- a/lib/PublicInbox/Spamcheck/Spamc.pm
+++ b/lib/PublicInbox/Spamcheck/Spamc.pm
@@ -21,14 +21,13 @@ sub spamcheck {
 	my ($self, $msg, $out) = @_;
 
 	my $rdr = { 0 => _msg_to_fh($self, $msg) };
-	my ($fh, $pid) = popen_rd($self->{checkcmd}, undef, $rdr);
+	my $fh = popen_rd($self->{checkcmd}, undef, $rdr);
 	unless (ref $out) {
 		my $buf = '';
 		$out = \$buf;
 	}
 	$$out = do { local $/; <$fh> };
-	close $fh or die "close failed: $!";
-	waitpid($pid, 0);
+	close $fh; # PublicInbox::ProcessPipe::CLOSE
 	($? || $$out eq '') ? 0 : 1;
 }
 

[PATCH 6/6] spawn: add run_wait to simplify spawn+waitpid use

[Eric Wong]

It's basically the `system' perlop with support for env overrides,
redirects, chdir, rlimits, and setpgid support.
---
 lib/PublicInbox/Fetch.pm           |  7 +++----
 lib/PublicInbox/LEI.pm             |  5 ++---
 lib/PublicInbox/LeiBlob.pm         | 14 +++++---------
 lib/PublicInbox/LeiMailDiff.pm     |  6 ++----
 lib/PublicInbox/LeiMirror.pm       |  8 +++-----
 lib/PublicInbox/LeiRediff.pm       |  7 +++----
 lib/PublicInbox/SearchIdx.pm       |  6 ++----
 lib/PublicInbox/Spamcheck/Spamc.pm |  6 ++----
 lib/PublicInbox/Spawn.pm           | 13 +++++++++----
 lib/PublicInbox/TestCommon.pm      |  6 +-----
 10 files changed, 32 insertions(+), 46 deletions(-)

diff --git a/lib/PublicInbox/Fetch.pm b/lib/PublicInbox/Fetch.pm
index 8f3a87e2..6e9b1e94 100644
--- a/lib/PublicInbox/Fetch.pm
+++ b/lib/PublicInbox/Fetch.pm
@@ -5,7 +5,7 @@ package PublicInbox::Fetch;
 use v5.12;
 use parent qw(PublicInbox::IPC);
 use URI ();
-use PublicInbox::Spawn qw(popen_rd run_die spawn);
+use PublicInbox::Spawn qw(popen_rd run_wait);
 use PublicInbox::Admin;
 use PublicInbox::LEI;
 use PublicInbox::LeiCurl;
@@ -133,9 +133,8 @@ sub do_fetch { # main entry point
 				warn "W: $edir missing remote.*.url\n";
 				my $o = { -C => $edir };
 				$o->{1} = $o->{2} = $lei->{2};
-				my $pid = spawn([qw(git config -l)], undef, $o);
-				waitpid($pid, 0);
-				$lei->child_error($?) if $?;
+				run_wait([qw(git config -l)], undef, $o) and
+					$lei->child_error($?);
 			}
 		}
 		@epochs = grep { !$skip->{$_} } @epochs if $skip;
diff --git a/lib/PublicInbox/LEI.pm b/lib/PublicInbox/LEI.pm
index 432ae61e..2f8d7a96 100644
--- a/lib/PublicInbox/LEI.pm
+++ b/lib/PublicInbox/LEI.pm
@@ -18,7 +18,7 @@ use IO::Handle ();
 use Fcntl qw(SEEK_SET);
 use PublicInbox::Config;
 use PublicInbox::Syscall qw(EPOLLIN);
-use PublicInbox::Spawn qw(spawn popen_rd);
+use PublicInbox::Spawn qw(run_wait popen_rd);
 use PublicInbox::Lock;
 use PublicInbox::Eml;
 use PublicInbox::Import;
@@ -905,8 +905,7 @@ sub _config {
 	}
 	my $cmd = $cfg->config_cmd(\%env, \%opt);
 	push @$cmd, @file_arg, @argv;
-	waitpid(spawn($cmd, \%env, \%opt), 0);
-	$? == 0 ? 1 : ($err_ok ? undef : fail($self, $?));
+	run_wait($cmd, \%env, \%opt) ? ($err_ok ? undef : fail($self, $?)) : 1;
 }
 
 sub lei_daemon_pid { puts shift, $$ }
diff --git a/lib/PublicInbox/LeiBlob.pm b/lib/PublicInbox/LeiBlob.pm
index 1d8267c8..8df83b1d 100644
--- a/lib/PublicInbox/LeiBlob.pm
+++ b/lib/PublicInbox/LeiBlob.pm
@@ -7,7 +7,7 @@ package PublicInbox::LeiBlob;
 use strict;
 use v5.10.1;
 use parent qw(PublicInbox::IPC);
-use PublicInbox::Spawn qw(spawn popen_rd which);
+use PublicInbox::Spawn qw(run_wait popen_rd which);
 use PublicInbox::DS;
 
 sub get_git_dir ($$) {
@@ -43,8 +43,7 @@ sub solver_user_cb { # called by solver when done
 
 	my $cmd = [ 'git', "--git-dir=$gd", 'show', $oid ];
 	my $rdr = { 1 => $lei->{1}, 2 => $lei->{2} };
-	waitpid(spawn($cmd, $lei->{env}, $rdr), 0);
-	$lei->child_error($?) if $?;
+	run_wait($cmd, $lei->{env}, $rdr) and $lei->child_error($?);
 }
 
 sub do_solve_blob { # via wq_do
@@ -125,12 +124,9 @@ sub lei_blob {
 			require PublicInbox::Eml;
 			my $buf = do { local $/; <$fh> };
 			return extract_attach($lei, $blob, \$buf) if close($fh);
-		} else {
-			$rdr->{1} = $lei->{1};
-			waitpid(spawn($cmd, $lei->{env}, $rdr), 0);
 		}
-		my $ce = $?;
-		return if $ce == 0;
+		$rdr->{1} = $lei->{1};
+		my $cerr = run_wait($cmd, $lei->{env}, $rdr) or return;
 		my $lms = $lei->lms;
 		if (my $bref = $lms ? $lms->local_blob($blob, 1) : undef) {
 			defined($lei->{-attach_idx}) and
@@ -139,7 +135,7 @@ sub lei_blob {
 		} elsif ($opt->{mail}) {
 			my $eh = $rdr->{2};
 			seek($eh, 0, 0);
-			return $lei->child_error($ce, do { local $/; <$eh> });
+			return $lei->child_error($cerr, do { local $/; <$eh> });
 		} # else: fall through to solver below
 	}
 
diff --git a/lib/PublicInbox/LeiMailDiff.pm b/lib/PublicInbox/LeiMailDiff.pm
index c813144f..5e2e4b0b 100644
--- a/lib/PublicInbox/LeiMailDiff.pm
+++ b/lib/PublicInbox/LeiMailDiff.pm
@@ -6,7 +6,7 @@
 package PublicInbox::LeiMailDiff;
 use v5.12;
 use parent qw(PublicInbox::IPC PublicInbox::LeiInput PublicInbox::MailDiff);
-use PublicInbox::Spawn qw(spawn which);
+use PublicInbox::Spawn qw(run_wait);
 use File::Path ();
 require PublicInbox::LeiRediff;
 
@@ -20,9 +20,7 @@ sub diff_a ($$) {
 	push @$cmd, qw(-- a), "N$self->{nr}";
 	my $rdr = { -C => "$self->{tmp}" };
 	@$rdr{1, 2} = @$lei{1, 2};
-	my $pid = spawn($cmd, $lei->{env}, $rdr);
-	waitpid($pid, 0);
-	$lei->child_error($?) if $?; # for git diff --exit-code
+	run_wait($cmd, $lei->{env}, $rdr) and $lei->child_error($?);
 	File::Path::remove_tree($self->{curdir});
 }
 
diff --git a/lib/PublicInbox/LeiMirror.pm b/lib/PublicInbox/LeiMirror.pm
index fed6b668..c99bafc3 100644
--- a/lib/PublicInbox/LeiMirror.pm
+++ b/lib/PublicInbox/LeiMirror.pm
@@ -7,7 +7,7 @@ use v5.12;
 use parent qw(PublicInbox::IPC);
 use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
 use IO::Compress::Gzip qw(gzip $GzipError);
-use PublicInbox::Spawn qw(popen_rd spawn run_die);
+use PublicInbox::Spawn qw(popen_rd spawn run_wait run_die);
 use File::Path ();
 use File::Temp ();
 use File::Spec ();
@@ -251,8 +251,7 @@ sub index_cloned_inbox {
 sub run_reap {
 	my ($lei, $cmd, $opt) = @_;
 	$lei->qerr("# @$cmd");
-	waitpid(spawn($cmd, undef, $opt), 0) // die "waitpid: $!";
-	my $ret = $?;
+	my $ret = run_wait($cmd, undef, $opt);
 	$? = 0; # don't let it influence normal exit
 	$ret;
 }
@@ -424,8 +423,7 @@ sub fgrp_fetch_all {
 			my $c = [ @$cmd, '--unset-all', $_ ];
 			$self->{lei}->qerr("# @$c");
 			next if $self->{dry_run};
-			my $pid = spawn($c, undef, $opt);
-			waitpid($pid, 0) // die "waitpid: $!";
+			run_wait($c, undef, $opt);
 			die "E: @$c \$?=$?" if ($? && ($? >> 8) != 5);
 		}
 
diff --git a/lib/PublicInbox/LeiRediff.pm b/lib/PublicInbox/LeiRediff.pm
index 9cf95c08..824289d6 100644
--- a/lib/PublicInbox/LeiRediff.pm
+++ b/lib/PublicInbox/LeiRediff.pm
@@ -7,7 +7,7 @@ use strict;
 use v5.10.1;
 use parent qw(PublicInbox::IPC PublicInbox::LeiInput);
 use File::Temp 0.19 (); # 0.19 for ->newdir
-use PublicInbox::Spawn qw(spawn which);
+use PublicInbox::Spawn qw(run_wait spawn which);
 use PublicInbox::MsgIter qw(msg_part_text);
 use PublicInbox::ViewDiff;
 use PublicInbox::LeiBlob;
@@ -136,9 +136,8 @@ EOM
 	$lei->qerr("# git @$cmd");
 	push @$cmd, qw(A B);
 	unshift @$cmd, 'git', "--git-dir=$rw->{git_dir}";
-	$pid = spawn($cmd, $lei->{env}, { 2 => $lei->{2}, 1 => $lei->{1} });
-	waitpid($pid, 0);
-	$lei->child_error($?) if $?; # for git diff --exit-code
+	run_wait($cmd, $lei->{env}, { 2 => $lei->{2}, 1 => $lei->{1} }) and
+		$lei->child_error($?); # for git diff --exit-code
 	undef;
 }
 
diff --git a/lib/PublicInbox/SearchIdx.pm b/lib/PublicInbox/SearchIdx.pm
index 61dc7ce3..2a0e06d1 100644
--- a/lib/PublicInbox/SearchIdx.pm
+++ b/lib/PublicInbox/SearchIdx.pm
@@ -22,7 +22,7 @@ use POSIX qw(strftime);
 use Fcntl qw(SEEK_SET);
 use Time::Local qw(timegm);
 use PublicInbox::OverIdx;
-use PublicInbox::Spawn qw(spawn);
+use PublicInbox::Spawn qw(run_wait);
 use PublicInbox::Git qw(git_unquote);
 use PublicInbox::MsgTime qw(msg_timestamp msg_datestamp);
 use PublicInbox::Address;
@@ -1010,9 +1010,7 @@ sub is_ancestor ($$$) {
 	return 0 unless $git->check($cur);
 	my $cmd = [ 'git', "--git-dir=$git->{git_dir}",
 		qw(merge-base --is-ancestor), $cur, $tip ];
-	my $pid = spawn($cmd);
-	waitpid($pid, 0) == $pid or die join(' ', @$cmd) .' did not finish';
-	$? == 0;
+	run_wait($cmd) == 0;
 }
 
 sub need_update ($$$$) {
diff --git a/lib/PublicInbox/Spamcheck/Spamc.pm b/lib/PublicInbox/Spamcheck/Spamc.pm
index 67278917..726866c8 100644
--- a/lib/PublicInbox/Spamcheck/Spamc.pm
+++ b/lib/PublicInbox/Spamcheck/Spamc.pm
@@ -4,7 +4,7 @@
 # Default spam filter class for wrapping spamc(1)
 package PublicInbox::Spamcheck::Spamc;
 use v5.12;
-use PublicInbox::Spawn qw(popen_rd spawn);
+use PublicInbox::Spawn qw(popen_rd run_wait);
 use IO::Handle;
 use Fcntl qw(SEEK_SET);
 
@@ -47,9 +47,7 @@ sub _learn {
 	$rdr->{0} = _msg_to_fh($self, $msg);
 	$rdr->{1} ||= $self->_devnull;
 	$rdr->{2} ||= $self->_devnull;
-	my $pid = spawn($self->{$field}, undef, $rdr);
-	waitpid($pid, 0);
-	!$?;
+	0 == run_wait($self->{$field}, undef, $rdr);
 }
 
 sub _devnull {
diff --git a/lib/PublicInbox/Spawn.pm b/lib/PublicInbox/Spawn.pm
index 2b84e2d5..38619fc2 100644
--- a/lib/PublicInbox/Spawn.pm
+++ b/lib/PublicInbox/Spawn.pm
@@ -20,8 +20,9 @@ use parent qw(Exporter);
 use Symbol qw(gensym);
 use Fcntl qw(LOCK_EX SEEK_SET);
 use IO::Handle ();
+use Carp qw(croak);
 use PublicInbox::ProcessPipe;
-our @EXPORT_OK = qw(which spawn popen_rd run_die);
+our @EXPORT_OK = qw(which spawn popen_rd run_die run_wait);
 our @RLIMITS = qw(RLIMIT_CPU RLIMIT_CORE RLIMIT_DATA);
 
 BEGIN {
@@ -375,11 +376,15 @@ sub popen_rd {
 	$s;
 }
 
+sub run_wait ($;$$) {
+	my ($cmd, $env, $opt) = @_;
+	waitpid(spawn($cmd, $env, $opt), 0);
+	$?
+}
+
 sub run_die ($;$$) {
 	my ($cmd, $env, $rdr) = @_;
-	my $pid = spawn($cmd, $env, $rdr);
-	waitpid($pid, 0) == $pid or die "@$cmd did not finish";
-	$? == 0 or die "@$cmd failed: \$?=$?\n";
+	run_wait($cmd, $env, $rdr) and croak "E: @$cmd failed: \$?=$?";
 }
 
 1;
diff --git a/lib/PublicInbox/TestCommon.pm b/lib/PublicInbox/TestCommon.pm
index 7b628769..2c38500c 100644
--- a/lib/PublicInbox/TestCommon.pm
+++ b/lib/PublicInbox/TestCommon.pm
@@ -367,11 +367,7 @@ sub run_script ($;$$) {
 			$cmd->[0] = File::Spec->rel2abs($cmd->[0]);
 			$spawn_opt->{'-C'} = $d;
 		}
-		my $pid = PublicInbox::Spawn::spawn($cmd, $env, $spawn_opt);
-		if (defined $pid) {
-			my $r = waitpid($pid, 0) // die "waitpid: $!";
-			$r == $pid or die "waitpid: expected $pid, got $r";
-		}
+		PublicInbox::Spawn::run_wait($cmd, $env, $spawn_opt);
 	} else { # localize and run everything in the same process:
 		# note: "local *STDIN = *STDIN;" and so forth did not work in
 		# old versions of perl