diff options
author | Eric Wong <e@80x24.org> | 2021-02-06 12:18:39 +0000 |
---|---|---|
committer | Eric Wong <e@80x24.org> | 2021-02-07 03:34:32 +0000 |
commit | d9bc0993fde567c9098020b8f79995e8ab3b4f0d (patch) | |
tree | 6dd35a61c541f9c1b74b9c5cde71bcb1ac426fec /script | |
parent | a2bae6437eeb8147736812eca95e85e5642c97cc (diff) | |
download | public-inbox-d9bc0993fde567c9098020b8f79995e8ab3b4f0d.tar.gz |
We only spawn one process to be reaped at the moment. tests will run the contents of script/* in the same process if possible, so any test scripts which spawn -httpd or other read-only can cause us to stall with waitpid(-1, ...)
Diffstat (limited to 'script')
-rwxr-xr-x | script/lei | 28 |
1 files changed, 16 insertions, 12 deletions
@@ -14,13 +14,15 @@ my $send_cmd = PublicInbox::CmdIPC4->can('send_cmd4') // do { PublicInbox::Spawn->can('send_cmd4'); }; -sub sigchld { - my ($sig) = @_; - my $flags = $sig ? POSIX::WNOHANG() : 0; - while (waitpid(-1, $flags) > 0) {} -} +my %pids; +my $sigchld = sub { + my $flags = scalar(@_) ? POSIX::WNOHANG() : 0; + for my $pid (keys %pids) { + delete($pids{$pid}) if waitpid($pid, $flags) == $pid; + } +}; -sub exec_cmd { +my $exec_cmd = sub { my ($fds, $argc, @argv) = @_; my @old = (*STDIN{IO}, *STDOUT{IO}, *STDERR{IO}); my @rdr; @@ -29,7 +31,7 @@ sub exec_cmd { push @rdr, shift(@old), $tmpfh; } require POSIX; # WNOHANG - $SIG{CHLD} = \&sigchld; + $SIG{CHLD} = $sigchld; my $pid = fork // die "fork: $!"; if ($pid == 0) { my %env = map { split(/=/, $_, 2) } splice(@argv, $argc); @@ -38,9 +40,11 @@ sub exec_cmd { } %ENV = (%ENV, %env); exec(@argv); - die "exec: @argv: $!"; + warn "exec: @argv: $!\n"; + POSIX::_exit(1); } -} + $pids{$pid} = 1; +}; if ($send_cmd && eval { my $path = do { @@ -107,13 +111,13 @@ Falling back to (slow) one-shot mode } elsif ($buf =~ /\Achild_error ([0-9]+)\z/) { $x_it_code = $1 + 0; } elsif ($buf =~ /\Aexec (.+)\z/) { - exec_cmd(\@fds, split(/\0/, $1)); + $exec_cmd->(\@fds, split(/\0/, $1)); } else { - sigchld(); + $sigchld->(); die $buf; } } - sigchld(); + $sigchld->(); if (my $sig = ($x_it_code & 127)) { kill $sig, $$; sleep(1) while 1; |