lib/PublicInbox/Spawn.pm

   1 # Copyright (C) 2016-2018 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3 #
   4 # This allows vfork to be used for spawning subprocesses if
   5 # PERL_INLINE_DIRECTORY is explicitly defined in the environment.
   6 # Under Linux, vfork can make a big difference in spawning performance
   7 # as process size increases (fork still needs to mark pages for CoW use).
   8 # Currently, we only use this for code intended for long running
   9 # daemons (inside the PSGI code (-httpd) and -nntpd).  The short-lived
  10 # scripts (-mda, -index, -learn, -init) either use IPC::run or standard
  11 # Perl routines.
  12
  13 package PublicInbox::Spawn;
  14 use strict;
  15 use warnings;
  16 use base qw(Exporter);
  17 use Symbol qw(gensym);
  18 use IO::Handle;
  19 use PublicInbox::ProcessPipe;
  20 our @EXPORT_OK = qw/which spawn popen_rd/;
  21
  22 my $vfork_spawn = <<'VFORK_SPAWN';
  23 #include <sys/types.h>
  24 #include <sys/uio.h>
  25 #include <unistd.h>
  26 #include <alloca.h>
  27 #include <signal.h>
  28 #include <assert.h>
  29
  30 #define AV_ALLOCA(av, max) alloca((max = (av_len((av)) + 1)) * sizeof(char *))
  31
  32 static void av2c_copy(char **dst, AV *src, I32 max)
  33 {
  34         I32 i;
  35
  36         for (i = 0; i < max; i++) {
  37                 SV **sv = av_fetch(src, i, 0);
  38                 dst[i] = sv ? SvPV_nolen(*sv) : 0;
  39         }
  40         dst[max] = 0;
  41 }
  42
  43 static void *deconst(const char *s)
  44 {
  45         union { const char *in; void *out; } u;
  46         u.in = s;
  47         return u.out;
  48 }
  49
  50 /* needs to be safe inside a vfork'ed process */
  51 static void xerr(const char *msg)
  52 {
  53         struct iovec iov[3];
  54         const char *err = strerror(errno); /* should be safe in practice */
  55
  56         iov[0].iov_base = deconst(msg);
  57         iov[0].iov_len = strlen(msg);
  58         iov[1].iov_base = deconst(err);
  59         iov[1].iov_len = strlen(err);
  60         iov[2].iov_base = deconst("\n");
  61         iov[2].iov_len = 1;
  62         writev(2, iov, 3);
  63         _exit(1);
  64 }
  65
  66 #define REDIR(var,fd) do { \
  67         if (var != fd && dup2(var, fd) < 0) \
  68                 xerr("error redirecting std"#var ": "); \
  69 } while (0)
  70
  71 /*
  72  * unstable internal API.  This was easy to implement but does not
  73  * support arbitrary redirects.  It'll be updated depending on
  74  * whatever we'll need in the future.
  75  * Be sure to update PublicInbox::SpawnPP if this changes
  76  */
  77 int public_inbox_fork_exec(int in, int out, int err,
  78                         SV *file, SV *cmdref, SV *envref)
  79 {
  80         AV *cmd = (AV *)SvRV(cmdref);
  81         AV *env = (AV *)SvRV(envref);
  82         const char *filename = SvPV_nolen(file);
  83         pid_t pid;
  84         char **argv, **envp;
  85         I32 max;
  86         sigset_t set, old;
  87         int ret, errnum;
  88
  89         argv = AV_ALLOCA(cmd, max);
  90         av2c_copy(argv, cmd, max);
  91
  92         envp = AV_ALLOCA(env, max);
  93         av2c_copy(envp, env, max);
  94
  95         ret = sigfillset(&set);
  96         assert(ret == 0 && "BUG calling sigfillset");
  97         ret = sigprocmask(SIG_SETMASK, &set, &old);
  98         assert(ret == 0 && "BUG calling sigprocmask to block");
  99         pid = vfork();
 100         if (pid == 0) {
 101                 int sig;
 102
 103                 REDIR(in, 0);
 104                 REDIR(out, 1);
 105                 REDIR(err, 2);
 106                 for (sig = 1; sig < NSIG; sig++)
 107                         signal(sig, SIG_DFL); /* ignore errors on signals */
 108                 /*
 109                  * don't bother unblocking, we don't want signals
 110                  * to the group taking out a subprocess
 111                  */
 112                 execve(filename, argv, envp);
 113                 xerr("execve failed");
 114         }
 115         errnum = errno;
 116         ret = sigprocmask(SIG_SETMASK, &old, NULL);
 117         assert(ret == 0 && "BUG calling sigprocmask to restore");
 118         errno = errnum;
 119
 120         return (int)pid;
 121 }
 122 VFORK_SPAWN
 123
 124 my $inline_dir = $ENV{PERL_INLINE_DIRECTORY};
 125 $vfork_spawn = undef unless defined $inline_dir && -d $inline_dir && -w _;
 126 if (defined $vfork_spawn) {
 127         # Inline 0.64 or later has locking in multi-process env,
 128         # but we support 0.5 on Debian wheezy
 129         use Fcntl qw(:flock);
 130         eval {
 131                 my $f = "$inline_dir/.public-inbox.lock";
 132                 open my $fh, '>', $f or die "failed to open $f: $!\n";
 133                 flock($fh, LOCK_EX) or die "LOCK_EX failed on $f: $!\n";
 134                 eval 'use Inline C => $vfork_spawn'; #, BUILD_NOISY => 1';
 135                 my $err = $@;
 136                 flock($fh, LOCK_UN) or die "LOCK_UN failed on $f: $!\n";
 137                 die $err if $err;
 138         };
 139         if ($@) {
 140                 warn "Inline::C failed for vfork: $@\n";
 141                 $vfork_spawn = undef;
 142         }
 143 }
 144
 145 unless (defined $vfork_spawn) {
 146         require PublicInbox::SpawnPP;
 147         no warnings 'once';
 148         *public_inbox_fork_exec = *PublicInbox::SpawnPP::public_inbox_fork_exec
 149 }
 150
 151 # n.b. we never use absolute paths with this
 152 sub which ($) {
 153         my ($file) = @_;
 154         foreach my $p (split(':', $ENV{PATH})) {
 155                 $p .= "/$file";
 156                 return $p if -x $p;
 157         }
 158         undef;
 159 }
 160
 161 sub spawn ($;$$) {
 162         my ($cmd, $env, $opts) = @_;
 163         my $f = which($cmd->[0]);
 164         defined $f or die "$cmd->[0]: command not found\n";
 165         my @env;
 166         $opts ||= {};
 167
 168         my %env = $opts->{-env} ? () : %ENV;
 169         if ($env) {
 170                 foreach my $k (keys %$env) {
 171                         my $v = $env->{$k};
 172                         if (defined $v) {
 173                                 $env{$k} = $v;
 174                         } else {
 175                                 delete $env{$k};
 176                         }
 177                 }
 178         }
 179         while (my ($k, $v) = each %env) {
 180                 push @env, "$k=$v";
 181         }
 182         my $in = $opts->{0} || 0;
 183         my $out = $opts->{1} || 1;
 184         my $err = $opts->{2} || 2;
 185         my $pid = public_inbox_fork_exec($in, $out, $err, $f, $cmd, \@env);
 186         $pid < 0 ? undef : $pid;
 187 }
 188
 189 sub popen_rd {
 190         my ($cmd, $env, $opts) = @_;
 191         pipe(my ($r, $w)) or die "pipe: $!\n";
 192         $opts ||= {};
 193         my $blocking = $opts->{Blocking};
 194         IO::Handle::blocking($r, $blocking) if defined $blocking;
 195         $opts->{1} = fileno($w);
 196         my $pid = spawn($cmd, $env, $opts);
 197         return unless defined $pid;
 198         return ($r, $pid) if wantarray;
 199         my $ret = gensym;
 200         tie *$ret, 'PublicInbox::ProcessPipe', $pid, $r;
 201         $ret;
 202 }
 203
 204 1;