if ($opt->{quiet}) {
open my $null, '>', '/dev/null' or
die "failed to open /dev/null: $!\n";
- $opt->{1} = fileno($null); # suitable for spawn() redirect
- $opt->{-dev_null} = $null;
+ $opt->{1} = $null; # suitable for spawn() redirect
} else {
$opt->{verbose} ||= 1;
$opt->{-progress} = sub { print STDERR @_ };
my @cmd = (qw(git), "--git-dir=$self->{git_dir}",
qw(-c core.abbrev=40 cat-file), $batch);
- my $redir = { 0 => fileno($out_r), 1 => fileno($in_w) };
+ my $redir = { 0 => $out_r, 1 => $in_w };
if ($err) {
my $id = "git.$self->{git_dir}$batch.err";
my $fh = tmpfile($id) or fail($self, "tmpfile($id): $!");
$self->{$err} = $fh;
- $redir->{2} = fileno($fh);
+ $redir->{2} = $fh;
}
my $p = spawn(\@cmd, undef, $redir);
defined $p or fail($self, "spawn failed: $!");
err($env, "error seeking temporary file: $!");
return;
}
- { 0 => fileno($in), -hold => $in };
+ { 0 => $in };
}
sub parse_cgi_headers {
my $git_dir = $git->{git_dir};
my @cmd = ('git', "--git-dir=$git_dir", qw(fast-import
--quiet --done --date-format=raw));
- my $rdr = { 0 => fileno($out_r), 1 => fileno($in_w) };
+ my $rdr = { 0 => $out_r, 1 => $in_w };
my $pid = spawn(\@cmd, undef, $rdr);
die "spawn fast-import failed: $!" unless defined $pid;
$out_w->autoflush(1);
sysseek($in, 0, 0) or die "seek: $!";
dbg($self, 'preparing index');
- my $rdr = { 0 => fileno($in), -hold => $in };
+ my $rdr = { 0 => $in };
my $cmd = [ qw(git update-index -z --index-info) ];
my $qsp = PublicInbox::Qspawn->new($cmd, $self->{git_env}, $rdr);
$path_a = git_quote($path_a);
_exit(1);
}
-#define REDIR(var,fd) do { \
- if (var != fd && dup2(var, fd) < 0) \
- xerr("error redirecting std"#var ": "); \
-} while (0)
-
/*
- * unstable internal API. This was easy to implement but does not
- * support arbitrary redirects. It'll be updated depending on
+ * unstable internal API. It'll be updated depending on
* whatever we'll need in the future.
* Be sure to update PublicInbox::SpawnPP if this changes
*/
-int pi_fork_exec(int in, int out, int err,
- SV *file, SV *cmdref, SV *envref, SV *rlimref)
+int pi_fork_exec(SV *redirref, SV *file, SV *cmdref, SV *envref, SV *rlimref)
{
+ AV *redir = (AV *)SvRV(redirref);
AV *cmd = (AV *)SvRV(cmdref);
AV *env = (AV *)SvRV(envref);
AV *rlim = (AV *)SvRV(rlimref);
pid = vfork();
if (pid == 0) {
int sig;
- I32 i, max;
-
- REDIR(in, 0);
- REDIR(out, 1);
- REDIR(err, 2);
+ I32 i, child_fd, max = av_len(redir);
+
+ for (child_fd = 0; child_fd <= max; child_fd++) {
+ SV **parent = av_fetch(redir, child_fd, 0);
+ int parent_fd = SvIV(*parent);
+ if (parent_fd == child_fd)
+ continue;
+ if (dup2(parent_fd, child_fd) < 0)
+ xerr("dup2");
+ }
for (sig = 1; sig < NSIG; sig++)
signal(sig, SIG_DFL); /* ignore errors on signals */
while (my ($k, $v) = each %env) {
push @env, "$k=$v";
}
- my $in = $opts->{0} || 0;
- my $out = $opts->{1} || 1;
- my $err = $opts->{2} || 2;
+ my $redir = [];
+ for my $child_fd (0..2) {
+ my $parent_fd = $opts->{$child_fd};
+ if (defined($parent_fd) && $parent_fd !~ /\A[0-9]+\z/) {
+ defined(my $fd = fileno($parent_fd)) or
+ die "$parent_fd not an IO GLOB? $!";
+ $parent_fd = $fd;
+ }
+ $redir->[$child_fd] = $parent_fd // $child_fd;
+ }
my $rlim = [];
foreach my $l (RLIMITS()) {
}
push @$rlim, $r, @$v;
}
- my $pid = pi_fork_exec($in, $out, $err, $f, $cmd, \@env, $rlim);
+ my $pid = pi_fork_exec($redir, $f, $cmd, \@env, $rlim);
$pid < 0 ? undef : $pid;
}
use POSIX qw(dup2 :signal_h);
# Pure Perl implementation for folks that do not use Inline::C
-sub pi_fork_exec ($$$$$$) {
- my ($in, $out, $err, $f, $cmd, $env, $rlim) = @_;
+sub pi_fork_exec ($$$$$) {
+ my ($redir, $f, $cmd, $env, $rlim) = @_;
my $old = POSIX::SigSet->new();
my $set = POSIX::SigSet->new();
$set->fillset or die "fillset failed: $!";
BSD::Resource::setrlimit($r, $soft, $hard) or
warn "failed to set $r=[$soft,$hard]\n";
}
- if ($in != 0) {
- dup2($in, 0) or die "dup2 failed for stdin: $!";
+ 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 ($out != 1) {
- dup2($out, 1) or die "dup2 failed for stdout: $!";
- }
- if ($err != 2) {
- dup2($err, 2) or die "dup2 failed for stderr: $!";
- }
-
if ($ENV{MOD_PERL}) {
exec which('env'), '-i', @$env, @$cmd;
die "exec env -i ... $cmd->[0] failed: $!\n";
next unless ref($redir);
open my $fh, '+>', undef or die "open: $!";
$fhref->[$fd] = $fh;
- $spawn_opt->{$fd} = fileno($fh);
+ $spawn_opt->{$fd} = $fh;
next if $fd > 0;
$fh->autoflush(1);
print $fh $$redir or die "print: $!";
my ($r, $w);
pipe($r, $w) or die "failed to create pipe: $!";
- my $rdr = { 0 => fileno($tmp_fh), 1 => fileno($w) };
+ my $rdr = { 0 => $tmp_fh, 1 => $w };
my $git_dir = $self->{-inbox}->git->{git_dir};
my $cmd = ['git', "--git-dir=$git_dir", qw(hash-object --stdin)];
my $pid = spawn($cmd, undef, $rdr);
defined(my $dfd = $opt->{$fd}) or next;
$rdr->{$fd} = $dfd;
}
- $rdr->{1} = fileno($w) if $pr && pipe($r, $w);
+ $rdr->{1} = $w if $pr && pipe($r, $w);
# we rely on --no-renumber to keep docids synched to NNTP
my $cmd = [ $XAPIAN_COMPACT, '--no-renumber' ];
my @cmd = ('git', "--git-dir=$alt", qw(hash-object -w --stdin));
is(system(qw(git init -q --bare), $alt), 0, 'create alt directory');
open my $fh, '<', "$alt/config" or die "open failed: $!\n";
- my $rd = popen_rd(\@cmd, {}, { 0 => fileno($fh) } );
+ my $rd = popen_rd(\@cmd, {}, { 0 => $fh } );
close $fh or die "close failed: $!";
chomp(my $remote = <$rd>);
my $gcf = PublicInbox::Git->new($dir);
my $cmd = [qw(curl --tcp-nodelay --no-buffer -T- -HExpect: -sS), $url];
open my $cout, '+>', undef or die;
open my $cerr, '>', undef or die;
- my $rdr = { 0 => fileno($r), 1 => fileno($cout), 2 => fileno($cerr) };
+ my $rdr = { 0 => $r, 1 => $cout, 2 => $cerr };
my $pid = spawn($cmd, undef, $rdr);
close $r or die "close read pipe: $!";
foreach my $c ('a'..'z') {
$in->flush or die "flush failed: $!";
$in->seek(0, SEEK_SET);
my $out = tempfile();
- my $pid = spawn(\@cmd, {}, { 0 => fileno($in), 1 => fileno($out)});
+ my $pid = spawn(\@cmd, {}, { 0 => $in, 1 => $out });
is(waitpid($pid, 0), $pid, 'waitpid succeeds on hash-object');
is($?, 0, 'hash-object');
$out->seek(0, SEEK_SET);
my $res;
$qsp->psgi_qx({}, undef, sub { $res = ${$_[0]} });
is($res, "err\nout\n", 'captured stderr and stdout');
+
+ $res = undef;
+ $qsp = PublicInbox::Qspawn->new($cmd, {}, { 2 => \*STDOUT });
+ $qsp->psgi_qx({}, undef, sub { $res = ${$_[0]} });
+ is($res, "err\nout\n", 'captured stderr and stdout');
}
sub finish_err ($) {
while (my ($label, $size) = each %bin) {
pipe(my ($rout, $wout)) or die;
pipe(my ($rin, $win)) or die;
- my $rdr = { 0 => fileno($rin), 1 => fileno($wout) };
+ my $rdr = { 0 => $rin, 1 => $wout };
my $pid = spawn($cmd , $env, $rdr);
$wout = $rin = undef;
print { $win } ("\0" x $size) or die;
my ($r, $w);
pipe $r, $w or die "pipe failed: $!";
my $pid = spawn(['sh', '-c', 'echo $HELLO'],
- { 'HELLO' => 'world' }, { 1 => fileno($w) });
+ { 'HELLO' => 'world' }, { 1 => $w });
close $w or die "close pipe[1] failed: $!";
is(<$r>, "world\n", 'read stdout of spawned from pipe');
is(waitpid($pid, 0), $pid, 'waitpid succeeds on spawned process');