From 364d2e95439b00a211d007d93c5ba263b56c1ddf Mon Sep 17 00:00:00 2001
From: Eric Wong <e@80x24.org>
Date: Mon, 8 Jul 2019 07:01:59 +0000
Subject: ds: use WNOHANG with waitpid if inside event loop

While we're usually not stuck waiting on waitpid after
seeing a pipe EOF or even triggering SIGPIPE in the process
(e.g. git-http-backend) we're reading from, it MAY happen
and we should be careful to never hang the daemon process
on waitpid calls.

v2: use "eq" for string comparison against 'DEFAULT'
---
 lib/PublicInbox/Qspawn.pm | 74 ++++++++++++++++++++++++++++++++++-------------
 1 file changed, 54 insertions(+), 20 deletions(-)

(limited to 'lib/PublicInbox/Qspawn.pm')

diff --git a/lib/PublicInbox/Qspawn.pm b/lib/PublicInbox/Qspawn.pm
index fb48585c..f2e91ab6 100644
--- a/lib/PublicInbox/Qspawn.pm
+++ b/lib/PublicInbox/Qspawn.pm
@@ -27,6 +27,7 @@ package PublicInbox::Qspawn;
 use strict;
 use warnings;
 use PublicInbox::Spawn qw(popen_rd);
+use POSIX qw(WNOHANG);
 require Plack::Util;
 
 # n.b.: we get EAGAIN with public-inbox-httpd, and EINTR on other PSGI servers
@@ -73,24 +74,66 @@ sub child_err ($) {
 	$msg;
 }
 
-sub finish ($) {
-	my ($self) = @_;
+# callback for dwaitpid
+sub waitpid_err ($$) {
+	my ($self, $pid) = @_;
+	my $xpid = delete $self->{pid};
+	my $err;
+	if ($pid > 0) { # success!
+		$err = child_err($?);
+	} elsif ($pid < 0) { # ??? does this happen in our case?
+		$err = "W: waitpid($xpid, 0) => $pid: $!";
+	} # else should not be called with pid == 0
+
+	# done, spawn whatever's in the queue
 	my $limiter = $self->{limiter};
-	my $running;
+	my $running = --$limiter->{running};
+
+	# limiter->{max} may change dynamically
+	if (($running || $limiter->{running}) < $limiter->{max}) {
+		if (my $next = shift @{$limiter->{run_queue}}) {
+			_do_spawn(@$next);
+		}
+	}
+
+	return unless $err;
+	$self->{err} = $err;
+	my $env = $self->{env} or return;
+	if (!$env->{'qspawn.quiet'}) {
+		$err = join(' ', @{$self->{args}->[0]}).": $err\n";
+		$env->{'psgi.errors'}->print($err);
+	}
+}
+
+sub do_waitpid ($;$) {
+	my ($self, $env) = @_;
+	my $pid = $self->{pid};
+	eval { # PublicInbox::DS may not be loaded
+		PublicInbox::DS::dwaitpid($pid, \&waitpid_err, $self);
+		$self->{env} = $env;
+	};
+	# done if we're running in PublicInbox::DS::EventLoop
+	if ($@) {
+		# non public-inbox-{httpd,nntpd} callers may block:
+		my $ret = waitpid($pid, 0);
+		waitpid_err($self, $ret);
+	}
+}
+
+sub finish ($;$) {
+	my ($self, $env) = @_;
 	if (delete $self->{rpipe}) {
-		my $pid = delete $self->{pid};
-		$self->{err} = $pid == waitpid($pid, 0) ? child_err($?) :
-				"PID:$pid still running?";
-		$running = --$limiter->{running};
+		do_waitpid($self, $env);
 	}
 
 	# limiter->{max} may change dynamically
-	if (($running || $limiter->{running}) < $limiter->{max}) {
+	my $limiter = $self->{limiter};
+	if ($limiter->{running} < $limiter->{max}) {
 		if (my $next = shift @{$limiter->{run_queue}}) {
 			_do_spawn(@$next);
 		}
 	}
-	$self->{err};
+	$self->{err}; # may be meaningless if non-blocking
 }
 
 sub start {
@@ -104,15 +147,6 @@ sub start {
 	}
 }
 
-sub _psgi_finish ($$) {
-	my ($self, $env) = @_;
-	my $err = $self->finish;
-	if ($err && !$env->{'qspawn.quiet'}) {
-		$err = join(' ', @{$self->{args}->[0]}).": $err\n";
-		$env->{'psgi.errors'}->print($err);
-	}
-}
-
 # Similar to `backtick` or "qx" ("perldoc -f qx"), it calls $qx_cb with
 # the stdout of the given command when done; but respects the given limiter
 # $env is the PSGI env.  As with ``/qx; only use this when output is small
@@ -121,7 +155,7 @@ sub psgi_qx {
 	my ($self, $env, $limiter, $qx_cb) = @_;
 	my $qx = PublicInbox::Qspawn::Qx->new;
 	my $end = sub {
-		_psgi_finish($self, $env);
+		finish($self, $env);
 		eval { $qx_cb->($qx) };
 		$qx = undef;
 	};
@@ -189,7 +223,7 @@ sub psgi_return {
 	my ($self, $env, $limiter, $parse_hdr) = @_;
 	my ($fh, $rpipe);
 	my $end = sub {
-		_psgi_finish($self, $env);
+		finish($self, $env);
 		$fh->close if $fh; # async-only
 	};
 
-- 
cgit v1.2.3-24-ge0c7