]> Sergey Matveev's repositories - public-inbox.git/blob - lib/PublicInbox/SpawnPP.pm
ds: support greeting protocols
[public-inbox.git] / lib / PublicInbox / SpawnPP.pm
1 # Copyright (C) 2016-2021 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
3
4 # Pure-Perl implementation of "spawn".  This can't take advantage
5 # of vfork, so no speedups under Linux for spawning from large processes.
6 package PublicInbox::SpawnPP;
7 use strict;
8 use v5.10.1;
9 use POSIX qw(dup2 _exit setpgid :signal_h);
10
11 # Pure Perl implementation for folks that do not use Inline::C
12 sub pi_fork_exec ($$$$$$$) {
13         my ($redir, $f, $cmd, $env, $rlim, $cd, $pgid) = @_;
14         my $old = POSIX::SigSet->new();
15         my $set = POSIX::SigSet->new();
16         $set->fillset or die "fillset failed: $!";
17         sigprocmask(SIG_SETMASK, $set, $old) or die "can't block signals: $!";
18         my $syserr;
19         pipe(my ($r, $w));
20         my $pid = fork;
21         unless (defined $pid) { # compat with Inline::C version
22                 $syserr = $!;
23                 $pid = -1;
24         }
25         if ($pid == 0) {
26                 close $r;
27                 $SIG{__DIE__} = sub {
28                         warn(@_);
29                         syswrite($w, my $num = $! + 0);
30                         _exit(1);
31                 };
32                 for my $child_fd (0..$#$redir) {
33                         my $parent_fd = $redir->[$child_fd];
34                         next if $parent_fd == $child_fd;
35                         dup2($parent_fd, $child_fd) or
36                                 die "dup2($parent_fd, $child_fd): $!";
37                 }
38                 if ($pgid >= 0 && !defined(setpgid(0, $pgid))) {
39                         die "setpgid(0, $pgid): $!";
40                 }
41                 for (keys %SIG) {
42                         $SIG{$_} = 'DEFAULT' if substr($_, 0, 1) ne '_';
43                 }
44                 if ($cd ne '') {
45                         chdir $cd or die "chdir $cd: $!";
46                 }
47                 while (@$rlim) {
48                         my ($r, $soft, $hard) = splice(@$rlim, 0, 3);
49                         BSD::Resource::setrlimit($r, $soft, $hard) or
50                                 die "setrlimit($r=[$soft,$hard]: $!)";
51                 }
52                 $old->delset(POSIX::SIGCHLD) or die "delset SIGCHLD: $!";
53                 sigprocmask(SIG_SETMASK, $old) or die "SETMASK: ~SIGCHLD: $!";
54                 $cmd->[0] = $f;
55                 if ($ENV{MOD_PERL}) {
56                         @$cmd = (which('env'), '-i', @$env, @$cmd);
57                 } else {
58                         %ENV = map { split(/=/, $_, 2) } @$env;
59                 }
60                 undef $r;
61                 exec { $f } @$cmd;
62                 die "exec @$cmd failed: $!";
63         }
64         close $w;
65         sigprocmask(SIG_SETMASK, $old) or die "can't unblock signals: $!";
66         if (my $cerrnum = do { local $/, <$r> }) {
67                 $pid = -1;
68                 $! = $cerrnum;
69         } else {
70                 $! = $syserr;
71         }
72         $pid;
73 }
74
75 1;