spawn: pi_fork_exec: support "pgid"

[public-inbox.git] / lib / PublicInbox / SpawnPP.pm

diff --git a/lib/PublicInbox/SpawnPP.pm b/lib/PublicInbox/SpawnPP.pm
index f64b95dcdefc5feb12d17676c04764e9e61c6140..401cb78de083ebf294ddec7847294d849d1c1142 100644 (file)
--- 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}) {