lib/PublicInbox/Spawn.pm

   1 # Copyright (C) 2016 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3 package PublicInbox::Spawn;
   4 use strict;
   5 use warnings;
   6 use base qw(Exporter);
   7 our @EXPORT_OK = qw/which spawn/;
   8
   9 my $vfork_spawn = <<'VFORK_SPAWN';
  10 #include <sys/types.h>
  11 #include <sys/uio.h>
  12 #include <unistd.h>
  13 #include <alloca.h>
  14
  15 #define AV_ALLOCA(av, max) alloca((max = (av_len((av)) + 1)) * sizeof(char *))
  16
  17 static void av2c_copy(char **dst, AV *src, I32 max)
  18 {
  19         I32 i;
  20
  21         for (i = 0; i < max; i++) {
  22                 SV **sv = av_fetch(src, i, 0);
  23                 dst[i] = sv ? SvPV_nolen(*sv) : 0;
  24         }
  25         dst[max] = 0;
  26 }
  27
  28 static void *deconst(const char *s)
  29 {
  30         union { const char *in; void *out; } u;
  31         u.in = s;
  32         return u.out;
  33 }
  34
  35 /* needs to be safe inside a vfork'ed process */
  36 static void xerr(const char *msg)
  37 {
  38         struct iovec iov[3];
  39         const char *err = strerror(errno); /* should be safe in practice */
  40
  41         iov[0].iov_base = deconst(msg);
  42         iov[0].iov_len = strlen(msg);
  43         iov[1].iov_base = deconst(err);
  44         iov[1].iov_len = strlen(err);
  45         iov[2].iov_base = deconst("\n");
  46         iov[2].iov_len = 1;
  47         writev(2, iov, 3);
  48         _exit(1);
  49 }
  50
  51 #define REDIR(var,fd) do { \
  52         if (var != fd && dup2(var, fd) < 0) \
  53                 xerr("error redirecting std"#var ": "); \
  54 } while (0)
  55
  56 /*
  57  * unstable internal API.  This was easy to implement but does not
  58  * support arbitrary redirects.  It'll be updated depending on
  59  * whatever we'll need in the future.
  60  * Be sure to update PublicInbox::SpawnPP if this changes
  61  */
  62 int public_inbox_fork_exec(int in, int out, int err,
  63                         SV *file, SV *cmdref, SV *envref)
  64 {
  65         AV *cmd = (AV *)SvRV(cmdref);
  66         AV *env = (AV *)SvRV(envref);
  67         const char *filename = SvPV_nolen(file);
  68         pid_t pid;
  69         char **argv, **envp;
  70         I32 max;
  71
  72         argv = AV_ALLOCA(cmd, max);
  73         av2c_copy(argv, cmd, max);
  74
  75         envp = AV_ALLOCA(env, max);
  76         av2c_copy(envp, env, max);
  77
  78         pid = vfork();
  79         if (pid == 0) {
  80                 REDIR(in, 0);
  81                 REDIR(out, 1);
  82                 REDIR(err, 2);
  83                 execve(filename, argv, envp);
  84                 xerr("execve failed");
  85         }
  86
  87         return (int)pid;
  88 }
  89 VFORK_SPAWN
  90
  91 my $inline_dir = $ENV{PERL_INLINE_DIRECTORY};
  92 $vfork_spawn = undef unless defined $inline_dir && -d $inline_dir && -w _;
  93 if (defined $vfork_spawn) {
  94         # Inline 0.64 or later has locking in multi-process env,
  95         # but we support 0.5 on Debian wheezy
  96         use Fcntl qw(:flock);
  97         eval {
  98                 my $f = "$inline_dir/.public-inbox.lock";
  99                 open my $fh, '>', $f or die "failed to open $f: $!\n";
 100                 flock($fh, LOCK_EX) or die "LOCK_EX failed on $f: $!\n";
 101                 eval 'use Inline C => $vfork_spawn';
 102                 flock($fh, LOCK_UN) or die "LOCK_UN failed on $f: $!\n";
 103         };
 104         if ($@) {
 105                 warn "Inline::C failed for vfork: $@\n";
 106                 $vfork_spawn = undef;
 107         }
 108 }
 109
 110 unless (defined $vfork_spawn) {
 111         require PublicInbox::SpawnPP;
 112         no warnings 'once';
 113         *public_inbox_fork_exec = *PublicInbox::SpawnPP::public_inbox_fork_exec
 114 }
 115
 116 sub which ($) {
 117         my ($file) = @_;
 118         foreach my $p (split(':', $ENV{PATH})) {
 119                 $p .= "/$file";
 120                 return $p if -x $p;
 121         }
 122         undef;
 123 }
 124
 125 sub spawn ($;$$) {
 126         my ($cmd, $env, $opts) = @_;
 127         my $f = which($cmd->[0]);
 128         defined $f or die "$cmd->[0]: command not found\n";
 129         my @env;
 130         $opts ||= {};
 131
 132         my %env = $opts->{-env} ? () : %ENV;
 133         if ($env) {
 134                 foreach my $k (keys %$env) {
 135                         my $v = $env->{$k};
 136                         if (defined $v) {
 137                                 $env{$k} = $v;
 138                         } else {
 139                                 delete $env{$k};
 140                         }
 141                 }
 142         }
 143         while (my ($k, $v) = each %env) {
 144                 push @env, "$k=$v";
 145         }
 146         my $in = $opts->{0} || 0;
 147         my $out = $opts->{1} || 1;
 148         my $err = $opts->{2} || 2;
 149         public_inbox_fork_exec($in, $out, $err, $f, $cmd, \@env);
 150 }
 151
 152 1;