use warnings;
use POSIX qw(dup2);
require IO::Handle;
+use PublicInbox::Spawn qw(spawn popen_rd);
sub new {
my ($class, $git_dir) = @_;
pipe($out_r, $out_w) or fail($self, "pipe failed: $!");
my @cmd = ('git', "--git-dir=$self->{git_dir}", qw(cat-file), $batch);
- $self->{$pid} = fork;
- defined $self->{$pid} or fail($self, "fork failed: $!");
- if ($self->{$pid} == 0) {
- dup2(fileno($out_r), 0) or die "redirect stdin failed: $!\n";
- dup2(fileno($in_w), 1) or die "redirect stdout failed: $!\n";
- exec(@cmd) or die 'exec `' . join(' '). "' failed: $!\n";
- }
+ my $redir = { 0 => fileno($out_r), 1 => fileno($in_w) };
+ $self->{$pid} = spawn(\@cmd, undef, $redir);
close $out_r or fail($self, "close failed: $!");
close $in_w or fail($self, "close failed: $!");
$out_w->autoflush(1);
sub popen {
my ($self, @cmd) = @_;
- my $mode = '-|';
- $mode = shift @cmd if ($cmd[0] eq '|-');
@cmd = ('git', "--git-dir=$self->{git_dir}", @cmd);
- my $pid = open my $fh, $mode, @cmd or
- die('open `'.join(' ', @cmd) . " pipe failed: $!\n");
- $fh;
+ popen_rd(\@cmd);
}
sub cleanup {
use strict;
use warnings;
use Fcntl qw(:seek);
-use POSIX qw(dup2);
+use PublicInbox::Spawn qw(spawn);
# n.b. serving "description" and "cloneurl" should be innocuous enough to
# not cause problems. serving "config" might...
$err->print("error creating pipe: $!\n");
return r(500);
}
- my $pid = fork; # TODO: vfork under Linux...
- unless (defined $pid) {
- $err->print("error forking: $!\n");
- return r(500);
+ my %env = %ENV;
+ # GIT_HTTP_EXPORT_ALL, GIT_COMMITTER_NAME, GIT_COMMITTER_EMAIL
+ # may be set in the server-process and are passed as-is
+ foreach my $name (qw(QUERY_STRING
+ REMOTE_USER REMOTE_ADDR
+ HTTP_CONTENT_ENCODING
+ CONTENT_TYPE
+ SERVER_PROTOCOL
+ REQUEST_METHOD)) {
+ my $val = $env->{$name};
+ $env{$name} = $val if defined $val;
}
my $git_dir = $git->{git_dir};
- if ($pid == 0) {
- # GIT_HTTP_EXPORT_ALL, GIT_COMMITTER_NAME, GIT_COMMITTER_EMAIL
- # may be set in the server-process and are passed as-is
- foreach my $name (qw(QUERY_STRING
- REMOTE_USER REMOTE_ADDR
- HTTP_CONTENT_ENCODING
- CONTENT_TYPE
- SERVER_PROTOCOL
- REQUEST_METHOD)) {
- my $val = $env->{$name};
- $ENV{$name} = $val if defined $val;
- }
- # $ENV{GIT_PROJECT_ROOT} = $git->{git_dir};
- $ENV{GIT_HTTP_EXPORT_ALL} = '1';
- $ENV{PATH_TRANSLATED} = "$git_dir/$path";
- dup2(fileno($in), 0) or die "redirect stdin failed: $!\n";
- dup2(fileno($wpipe), 1) or die "redirect stdout failed: $!\n";
- my @cmd = qw(git http-backend);
- exec(@cmd) or die 'exec `' . join(' ', @cmd). "' failed: $!\n";
+ $env{GIT_HTTP_EXPORT_ALL} = '1';
+ $env{PATH_TRANSLATED} = "$git_dir/$path";
+ my %rdr = ( 0 => fileno($in), 1 => fileno($wpipe) );
+ my $pid = spawn([qw(git http-backend)], \%env, \%rdr);
+ unless (defined $pid) {
+ $err->print("error spawning: $!\n");
+ return r(500);
}
$wpipe = $in = undef;
$buf = '';
--- /dev/null
+# Copyright (C) 2016 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+
+# a tied handle for auto reaping of children tied to a pipe, see perltie(1)
+package PublicInbox::ProcessPipe;
+use strict;
+use warnings;
+
+sub TIEHANDLE {
+ my ($class, $pid, $fh) = @_;
+ bless { pid => $pid, fh => $fh }, $class;
+}
+
+sub READ { sysread($_[0]->{fh}, $_[1], $_[2], $_[3] || 0) }
+
+sub READLINE { readline($_[0]->{fh}) }
+
+sub CLOSE { close($_[0]->{fh}) }
+
+sub FILENO { fileno($_[0]->{fh}) }
+
+sub DESTROY {
+ my $fh = delete($_[0]->{fh});
+ close $fh if $fh;
+ waitpid($_[0]->{pid}, 0);
+}
+
+sub pid { $_[0]->{pid} }
+
+1;
# Copyright (C) 2016 all contributors <meta@public-inbox.org>
# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+#
+# This allows vfork to be used for spawning subprocesses if
+# PERL_INLINE_DIRECTORY is explicitly defined in the environment.
+# Under Linux, vfork can make a big difference in spawning performance
+# as process size increases (fork still needs to mark pages for CoW use).
+# Currently, we only use this for code intended for long running
+# daemons (inside the PSGI code (-httpd) and -nntpd). The short-lived
+# scripts (-mda, -index, -learn, -init) either use IPC::run or standard
+# Perl routines.
+
package PublicInbox::Spawn;
use strict;
use warnings;
use base qw(Exporter);
-our @EXPORT_OK = qw/which spawn/;
+use Symbol qw(gensym);
+use PublicInbox::ProcessPipe;
+our @EXPORT_OK = qw/which spawn popen_rd/;
my $vfork_spawn = <<'VFORK_SPAWN';
#include <sys/types.h>
public_inbox_fork_exec($in, $out, $err, $f, $cmd, \@env);
}
+sub popen_rd {
+ my ($cmd, $env, $opts) = @_;
+ unless (wantarray || defined $vfork_spawn || defined $env) {
+ open my $fh, '-|', @$cmd or
+ die('open `'.join(' ', @$cmd) . " pipe failed: $!\n");
+ return $fh
+ }
+ pipe(my ($r, $w)) or die "pipe: $!\n";
+ $opts ||= {};
+ my $blocking = $opts->{Blocking};
+ $r->blocking($blocking) if defined $blocking;
+ $opts->{1} = fileno($w);
+ my $pid = spawn($cmd, $env, $opts);
+ close $w;
+ return ($r, $pid) if wantarray;
+ my $ret = gensym;
+ tie *$ret, 'PublicInbox::ProcessPipe', $pid, $r;
+ $ret;
+}
+
1;
use strict;
use warnings;
use Test::More;
-use PublicInbox::Spawn qw(which spawn);
+use PublicInbox::Spawn qw(which spawn popen_rd);
{
my $true = which('true');
is($?, 0, 'env(1) exited successfully');
}
+{
+ my $fh = popen_rd([qw(echo hello)]);
+ ok(fileno($fh) >= 0, 'tied fileno works');
+ my $l = <$fh>;
+ is($l, "hello\n", 'tied readline works');
+ $l = <$fh>;
+ ok(!$l, 'tied readline works for EOF');
+}
+
+{
+ my $fh = popen_rd([qw(printf foo\nbar)]);
+ ok(fileno($fh) >= 0, 'tied fileno works');
+ my @line = <$fh>;
+ is_deeply(\@line, [ "foo\n", 'bar' ], 'wantarray works on readline');
+}
+
+{
+ my $fh = popen_rd([qw(echo hello)]);
+ my $buf;
+ is(sysread($fh, $buf, 6), 6, 'sysread got 6 bytes');
+ is($buf, "hello\n", 'tied gets works');
+ is(sysread($fh, $buf, 6), 0, 'sysread got EOF');
+}
+
+{
+ my ($fh, $pid) = popen_rd([qw(sleep 60)], undef, { Blocking => 0 });
+ ok(defined $pid && $pid > 0, 'returned pid when array requested');
+ is(kill(0, $pid), 1, 'child process is running');
+ ok(!defined(sysread($fh, my $buf, 1)) && $!{EAGAIN},
+ 'sysread returned quickly with EAGAIN');
+ is(kill(15, $pid), 1, 'child process killed early');
+ is(waitpid($pid, 0), $pid, 'child process reapable');
+}
+
done_testing();
1;