From 5244475c94d9f80b0a76b6bfa9185bdff5a8a0d8 Mon Sep 17 00:00:00 2001 From: Eric Wong Date: Sun, 7 Feb 2021 08:51:44 +0000 Subject: spawn: pi_fork_exec: support "pgid" We'll be using this to allow the "git clone" process hierarchy to be killed via Ctrl-C. This also fixes a long-standing bug in error reporting for the Inline::C version, because we're actually testing for errors, now! n.b. strlen(3) is officially async-signal-safe as of POSIX.1-2016, but I can't think of a reason any previous implementation prior to that wouldn't be. --- lib/PublicInbox/SpawnPP.pm | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) (limited to 'lib/PublicInbox/SpawnPP.pm') diff --git a/lib/PublicInbox/SpawnPP.pm b/lib/PublicInbox/SpawnPP.pm index f64b95dc..401cb78d 100644 --- a/lib/PublicInbox/SpawnPP.pm +++ b/lib/PublicInbox/SpawnPP.pm @@ -5,12 +5,12 @@ # of vfork, so no speedups under Linux for spawning from large processes. package PublicInbox::SpawnPP; use strict; -use warnings; -use POSIX qw(dup2 :signal_h); +use v5.10.1; +use POSIX qw(dup2 _exit setpgid :signal_h); # Pure Perl implementation for folks that do not use Inline::C -sub pi_fork_exec ($$$$$$) { - my ($redir, $f, $cmd, $env, $rlim, $cd) = @_; +sub pi_fork_exec ($$$$$$$) { + my ($redir, $f, $cmd, $env, $rlim, $cd, $pgid) = @_; my $old = POSIX::SigSet->new(); my $set = POSIX::SigSet->new(); $set->fillset or die "fillset failed: $!"; @@ -22,21 +22,25 @@ sub pi_fork_exec ($$$$$$) { $pid = -1; } if ($pid == 0) { - while (@$rlim) { - my ($r, $soft, $hard) = splice(@$rlim, 0, 3); - BSD::Resource::setrlimit($r, $soft, $hard) or - warn "failed to set $r=[$soft,$hard]\n"; - } for my $child_fd (0..$#$redir) { my $parent_fd = $redir->[$child_fd]; next if $parent_fd == $child_fd; dup2($parent_fd, $child_fd) or die "dup2($parent_fd, $child_fd): $!\n"; } + if ($pgid >= 0 && !defined(setpgid(0, $pgid))) { + warn "setpgid: $!"; + _exit(1); + } + $SIG{$_} = 'DEFAULT' for keys %SIG; if ($cd ne '') { chdir $cd or die "chdir $cd: $!"; } - $SIG{$_} = 'DEFAULT' for keys %SIG; + while (@$rlim) { + my ($r, $soft, $hard) = splice(@$rlim, 0, 3); + BSD::Resource::setrlimit($r, $soft, $hard) or + warn "failed to set $r=[$soft,$hard]\n"; + } $old->delset(POSIX::SIGCHLD) or die "delset SIGCHLD: $!"; sigprocmask(SIG_SETMASK, $old) or die "SETMASK: ~SIGCHLD: $!"; if ($ENV{MOD_PERL}) { -- cgit v1.2.3-24-ge0c7