use POSIX qw(dup2);
use IO::Socket::INET;
our @EXPORT = qw(tmpdir tcp_server tcp_connect require_git require_mods
- run_script start_script key2sub);
+ run_script start_script key2sub xsys xqx);
sub tmpdir (;$) {
my ($base) = @_;
sub key2script ($) {
my ($key) = @_;
- return $key if (index($key, '/') >= 0);
+ return $key if ($key eq 'git' || index($key, '/') >= 0);
# n.b. we may have scripts which don't start with "public-inbox" in
# the future:
$key =~ s/\A([-\.])/public-inbox$1/;
sub wait_for_tail () { sleep(2) }
+# like system() built-in, but uses spawn() for env/rdr + vfork
+sub xsys {
+ my ($cmd, $env, $rdr) = @_;
+ if (ref($cmd)) {
+ $rdr ||= {};
+ } else {
+ $cmd = [ @_ ];
+ $env = undef;
+ $rdr = {};
+ }
+ run_script($cmd, $env, { %$rdr, run_mode => 0 });
+ $? >> 8
+}
+
+# like `backtick` or qx{} op, but uses spawn() for env/rdr + vfork
+sub xqx {
+ my ($cmd, $env, $rdr) = @_;
+ $rdr //= {};
+ run_script($cmd, $env, { %$rdr, run_mode => 0, 1 => \(my $out) });
+ wantarray ? split(/^/m, $out) : $out;
+}
+
sub start_script {
my ($cmd, $env, $opt) = @_;
my ($key, @argv) = @$cmd;
{
PublicInbox::Import::init_bare($tmpdir);
my @cmd = ('git', "--git-dir=$tmpdir", qw(config foo.bar), "hi\nhi");
- is(system(@cmd), 0, "set config");
+ is(xsys(@cmd), 0, "set config");
my $tmp = PublicInbox::Config->new("$tmpdir/config");
use_ok 'PublicInbox::DS';
if ('close-on-exec for epoll and kqueue') {
- use PublicInbox::Spawn qw(spawn);
+ use PublicInbox::Spawn qw(spawn which);
my $pid;
my $evfd_re = qr/(?:kqueue|eventpoll)/i;
my $l = <$r>;
is($l, undef, 'cloexec works and sleep(1) is running');
- my @of = grep(/$evfd_re/, `lsof -p $pid 2>/dev/null`);
- my $err = $?;
SKIP: {
- skip "lsof missing? (\$?=$err)", 1 if $err;
+ my $lsof = which('lsof') or skip 'lsof missing', 1;
+ my $rdr = { 2 => \(my $null) };
+ my @of = grep(/$evfd_re/, xqx([$lsof, '-p', $pid], {}, $rdr));
+ my $err = $?;
+ skip "lsof broken ? (\$?=$err)", 1 if $err;
is_deeply(\@of, [], 'no FDs leaked to subprocess');
};
if (defined $pid) {
$t = 'mailEditor set in config'; {
$in = $out = $err = '';
- my $rc = system(qw(git config), "--file=$cfgfile",
+ my $rc = xsys(qw(git config), "--file=$cfgfile",
'publicinbox.maileditor',
"$^X -i -p -e 's/boolean prefix/bool pfx/'");
is($rc, 0, 'set publicinbox.mailEditor');
{
PublicInbox::Import::init_bare($dir);
my $fi_data = './t/git.fast-import-data';
- ok(-r $fi_data, "fast-import data readable (or run test at top level)");
- local $ENV{GIT_DIR} = $dir;
- system("git fast-import --quiet <$fi_data");
+ open my $fh, '<', $fi_data or die
+ "fast-import data readable (or run test at top level: $!";
+ my $rdr = { 0 => $fh };
+ xsys([qw(git fast-import --quiet)], { GIT_DIR => $dir }, $rdr);
is($?, 0, 'fast-import succeeded');
}
}
if (1) {
- my $cmd = [ 'git', "--git-dir=$dir", qw(hash-object -w --stdin) ];
-
# need a big file, use the AGPL-3.0 :p
my $big_data = './COPYING';
ok(-r $big_data, 'COPYING readable');
my $size = -s $big_data;
ok($size > 8192, 'file is big enough');
-
- my $buf = do {
- local $ENV{GIT_DIR} = $dir;
- `git hash-object -w --stdin <$big_data`;
- };
+ open my $fh, '<', $big_data or die;
+ my $cmd = [ 'git', "--git-dir=$dir", qw(hash-object -w --stdin) ];
+ my $buf = xqx($cmd, { GIT_DIR => $dir }, { 0 => $fh });
is(0, $?, 'hashed object successfully');
chomp $buf;
use strict;
use warnings;
use Test::More;
-use PublicInbox::Spawn qw(which spawn);
+use PublicInbox::Spawn qw(which);
+use PublicInbox::TestCommon;
use IO::Handle; # ->autoflush
use Fcntl qw(:seek);
eval { require highlight } or
is($$ref, $$lref, 'do_hl_lang matches do_hl');
SKIP: {
- which('w3m') or skip 'w3m(1) missing to check output', 1;
- my $cmd = [ qw(w3m -T text/html -dump -config /dev/null) ];
- open my $in, '+>', undef or die;
- open my $out, '+>', undef or die;
- my $rdr = { 0 => fileno($in), 1 => fileno($out) };
- $in->autoflush(1);
- print $in '<pre>', $$ref, '</pre>' or die;
- $in->seek(0, SEEK_SET) or die;
- my $pid = spawn($cmd, undef, $rdr);
- waitpid($pid, 0);
+ my $w3m = which('w3m') or
+ skip('w3m(1) missing to check output', 1);
+ my $cmd = [ $w3m, qw(-T text/html -dump -config /dev/null) ];
+ my $in = '<pre>' . $$ref . '</pre>';
+ my $out = xqx($cmd, undef, { 0 => \$in });
# expand tabs and normalize whitespace,
# w3m doesn't preserve tabs
$orig =~ s/\t/ /gs;
- $out->seek(0, SEEK_SET) or die;
- $out = do { local $/; <$out> };
$out =~ s/\s*\z//sg;
$orig =~ s/\s*\z//sg;
is($out, $orig, 'w3m output matches');
use warnings;
use Test::More;
use Time::HiRes qw(gettimeofday tv_interval);
-use PublicInbox::Spawn qw(which spawn);
+use PublicInbox::Spawn qw(which spawn popen_rd);
use PublicInbox::TestCommon;
require_mods(qw(Plack::Util Plack::Builder HTTP::Date HTTP::Status));
use Digest::SHA qw(sha1_hex);
my $sock = tcp_server() or die;
my @zmods = qw(PublicInbox::GzipFilter IO::Uncompress::Gunzip);
-# make sure stdin is not a pipe for lsof test to check for leaking pipes
-open(STDIN, '<', '/dev/null') or die 'no /dev/null: $!';
-
# Make sure we don't clobber socket options set by systemd or similar
# using socket activation:
my ($defer_accept_val, $accf_arg, $TCP_DEFER_ACCEPT);
};
SKIP: {
- which('curl') or skip('curl(1) missing', 4);
+ my $curl = which('curl') or skip('curl(1) missing', 4);
my $base = 'http://' . $sock->sockhost . ':' . $sock->sockport;
my $url = "$base/sha1";
my ($r, $w);
pipe($r, $w) or die "pipe: $!";
- my $cmd = [qw(curl --tcp-nodelay --no-buffer -T- -HExpect: -sS), $url];
+ my $cmd = [$curl, qw(--tcp-nodelay -T- -HExpect: -sSN), $url];
open my $cout, '+>', undef or die;
open my $cerr, '>', undef or die;
my $rdr = { 0 => $r, 1 => $cout, 2 => $cerr };
seek($cout, 0, SEEK_SET);
is(<$cout>, sha1_hex($str), 'read expected body');
- open my $fh, '-|', qw(curl -sS), "$base/async-big" or die $!;
+ my $fh = popen_rd([$curl, '-sS', "$base/async-big"]);
my $n = 0;
my $non_zero = 0;
while (1) {
$n += $r;
$buf =~ /\A\0+\z/ or $non_zero++;
}
- close $fh or die "curl errored out \$?=$?";
+ close $fh or die "close curl pipe: $!";
+ is($?, 0, 'curl succesful');
is($n, 30 * 1024 * 1024, 'got expected output from curl');
is($non_zero, 0, 'read all zeros');
- require_mods(@zmods, 1);
- open $fh, '-|', qw(curl -sS), "$base/psgi-return-gzip" or die;
- binmode $fh;
- my $buf = do { local $/; <$fh> };
- close $fh or die "curl errored out \$?=$?";
+ require_mods(@zmods, 2);
+ my $buf = xqx([$curl, '-sS', "$base/psgi-return-gzip"]);
+ is($?, 0, 'curl succesful');
IO::Uncompress::Gunzip::gunzip(\$buf => \(my $out));
is($out, "hello world\n");
}
SKIP: {
skip 'only testing lsof(8) output on Linux', 1 if $^O ne 'linux';
- skip 'no lsof in PATH', 1 unless which('lsof');
- my @lsof = `lsof -p $td->{pid}`;
+ my $lsof = which('lsof') or skip 'no lsof in PATH', 1;
+ my $null_in = '';
+ my $rdr = { 2 => \(my $null_err), 0 => \$null_in };
+ my @lsof = xqx([$lsof, '-p', $td->{pid}], undef, $rdr);
is_deeply([grep(/\bdeleted\b/, @lsof)], [], 'no lingering deleted inputs');
# filter out pipes inherited from the parent
- my @this = `lsof -p $$`;
+ my @this = xqx([$lsof, '-p', $$], undef, $rdr);
my $bad;
my $extract_inodes = sub {
map {;
is($conn->read($buf, 1), 0, "EOF");
}
- is(system(qw(git clone -q --mirror),
+ is(xsys(qw(git clone -q --mirror),
"http://$host:$port/$group", "$tmpdir/clone.git"),
0, 'smart clone successful');
# ensure dumb cloning works, too:
- is(system('git', "--git-dir=$maindir",
+ is(xsys('git', "--git-dir=$maindir",
qw(config http.uploadpack false)),
0, 'disable http.uploadpack');
- is(system(qw(git clone -q --mirror),
+ is(xsys(qw(git clone -q --mirror),
"http://$host:$port/$group", "$tmpdir/dumb.git"),
0, 'clone successful');
ok($td->kill, 'killed httpd');
$td->join;
- is(system('git', "--git-dir=$tmpdir/clone.git",
+ is(xsys('git', "--git-dir=$tmpdir/clone.git",
qw(fsck --no-verbose)), 0,
'fsck on cloned directory successful');
}
push @cmd, "$ibx->{inboxdir}/git/0.git", "$mirror/git/0.git";
}
my $fetch_dir = $cmd[-1];
- is(system(@cmd), 0, "v$v clone OK");
+ is(xsys(@cmd), 0, "v$v clone OK");
# inbox init
local $ENV{PI_CONFIG} = "$tmpdir/.picfg";
$im->done;
# mirror updates
- is(system('git', "--git-dir=$fetch_dir", qw(fetch -q)), 0, 'fetch OK');
+ is(xsys('git', "--git-dir=$fetch_dir", qw(fetch -q)), 0, 'fetch OK');
ok(run_script(['-index', $mirror]), "v$v index mirror again OK");
($nr, $msgs) = $ro_mirror->recent;
is($nr, 2, '2nd message seen in mirror');
}
# sync the mirror
- is(system('git', "--git-dir=$fetch_dir", qw(fetch -q)), 0, 'fetch OK');
+ is(xsys('git', "--git-dir=$fetch_dir", qw(fetch -q)), 0, 'fetch OK');
ok(run_script(['-index', $mirror]), "v$v index mirror again OK");
($nr, $msgs) = $ro_mirror->recent;
is($nr, 1, '2nd message gone from mirror');
push @expect, $i;
}
$im->done;
- is(system('git', "--git-dir=$fetch_dir", qw(fetch -q)), 0, 'fetch OK');
+ is(xsys('git', "--git-dir=$fetch_dir", qw(fetch -q)), 0, 'fetch OK');
ok(run_script(['-index', '--reindex', $mirror]),
"v$v index --reindex mirror OK");
@ro_nums = map { $_->{num} } @{$ro_mirror->over->query_ts(0, 0)};
sub read_indexlevel {
my ($inbox) = @_;
- local $ENV{GIT_CONFIG} = "$ENV{PI_DIR}/config";
- chomp(my $lvl = `git config publicinbox.$inbox.indexlevel`);
+ my $cmd = [ qw(git config), "publicinbox.$inbox.indexlevel" ];
+ my $env = { GIT_CONFIG => "$ENV{PI_DIR}/config" };
+ chomp(my $lvl = xqx($cmd, $env));
$lvl;
}
Date: Thu, 01 Jan 1970 00:00:00 +0000
EOF
- system(qw(git config --file), $pi_config, "$cfgpfx.listid", $list_id);
+ xsys(qw(git config --file), $pi_config, "$cfgpfx.listid", $list_id);
$? == 0 or die "failed to set listid $?";
my $in = $simple->as_string;
ok(run_script(['-mda'], undef, { 0 => \$in }),
local $ENV{PI_CONFIG} = $pi_config;
local $ENV{PI_EMERGENCY} = "$tmpdir/emergency";
my @cfg = ('git', 'config', "--file=$pi_config");
-is(system(@cfg, 'publicinboxmda.spamcheck', 'none'), 0);
+is(xsys(@cfg, 'publicinboxmda.spamcheck', 'none'), 0);
for my $v (qw(V1 V2)) {
my @warn;
"http://example.com/$v", $addr ];
ok(run_script($cmd), 'public-inbox-init');
ok(run_script(['-index', $inboxdir]), 'public-inbox-index');
- is(system(@cfg, "$cfgpfx.filter", 'PublicInbox::Filter::RubyLang'), 0);
- is(system(@cfg, "$cfgpfx.altid",
+ is(xsys(@cfg, "$cfgpfx.filter", 'PublicInbox::Filter::RubyLang'), 0);
+ is(xsys(@cfg, "$cfgpfx.altid",
'serial:alerts:file=msgmap.sqlite3'), 0);
for my $i (1..2) {
my @v2 = ($ibx->over->get_art(1), $ibx->over->get_art(2));
is_deeply(\@v2, \@old, 'v2 conversion times match');
- system(qw(git clone -sq --mirror), "$tmpdir/v2/git/0.git",
+ xsys(qw(git clone -sq --mirror), "$tmpdir/v2/git/0.git",
"$tmpdir/v2-clone/git/0.git") == 0 or die "clone: $?";
$cmd = [ '-init', '-Lbasic', '-V2', 'v2c', "$tmpdir/v2-clone",
'http://example.com/v2c', 'v2c@example.com' ];
my @cmd = ('-init', $group, $inboxdir, 'http://example.com/', $addr);
push @cmd, "-V$version", '-Lbasic';
ok(run_script(\@cmd), 'init OK');
- is(system(qw(git config), "--file=$home/.public-inbox/config",
+ is(xsys(qw(git config), "--file=$home/.public-inbox/config",
"publicinbox.$group.newsgroup", $group),
0, 'enabled newsgroup');
my $len;
if ($INC{'Search/Xapian.pm'} && ($ENV{TEST_RUN_MODE}//2)) {
skip 'Search/Xapian.pm pre-loaded (by t/run.perl?)', 1;
}
- my @of = `lsof -p $td->{pid} 2>/dev/null`;
+ my $rdr = { 2 => \(my $null) };
+ my @of = xqx(['lsof', '-p', $td->{pid}], undef, $rdr);
skip('lsof broken', 1) if (!scalar(@of) || $?);
my @xap = grep m!Search/Xapian!, @of;
is_deeply(\@xap, [], 'Xapian not loaded in nntpd');
body => "hello world\n",
));
$im->done;
- is(system(qw(git --git-dir), $git_dir, 'fsck', '--strict'), 0, 'git fsck ok');
+ is(xsys(qw(git --git-dir), $git_dir, 'fsck', '--strict'), 0,
+ 'git fsck ok');
}
done_testing();
for my $dir (glob("$ibx->{inboxdir}/git/*.git")) {
my ($bn) = ($dir =~ m!([^/]+)\z!);
- is(system(qw(git --git-dir), $dir,
+ is(xsys(qw(git --git-dir), $dir,
qw(fsck --strict --no-progress)),
0, "git fsck is clean in epoch $bn");
}
my $ibx = PublicInbox::Inbox->new({ inboxdir => $git_dir });
my ($root_id, $last_id);
-is(0, system(qw(git init --shared -q --bare), $git_dir), "git init (main)")
+is(0, xsys(qw(git init --shared -q --bare), $git_dir), "git init (main)")
or BAIL_OUT("`git init --shared' failed, weird FS or seccomp?");
eval { PublicInbox::Search->new($ibx)->xdb };
ok($@, "exception raised on non-existent DB");
require_git(2.6);
use PublicInbox::Spawn qw(popen_rd);
require_mods(qw(DBD::SQLite Search::Xapian Plack::Util));
-chomp(my $git_dir = `git rev-parse --git-dir 2>/dev/null`);
-plan skip_all => "$0 must be run from a git working tree" if $?;
+my $git_dir = xqx([qw(git rev-parse --git-dir)], undef, {2 => \(my $null)});
+$? == 0 or plan skip_all => "$0 must be run from a git working tree";
+chomp $git_dir;
# needed for alternates, and --absolute-git-dir is only in git 2.13+
$git_dir = abs_path($git_dir);
my $config = "$ENV{PI_DIR}/config";
ok(-f $config, 'config exists');
my $k = 'publicinboxmda.spamcheck';
- is(system('git', 'config', "--file=$config", $k, 'none'), 0,
+ is(xsys('git', 'config', "--file=$config", $k, 'none'), 0,
'disabled spamcheck for mda');
ok(run_script(['-mda'], undef, $rdr), 'mda did not die');
"http://$host:$port/v2/$i$sfx",
"$tmpdir/m/git/$i.git");
- is(system(@cmd), 0, "cloned $i.git");
+ is(xsys(@cmd), 0, "cloned $i.git");
ok(-d "$tmpdir/m/git/$i.git", "mirror $i OK");
}
my $fetch_each_epoch = sub {
foreach my $i (0..$epoch_max) {
my $dir = "$tmpdir/m/git/$i.git";
- is(system('git', "--git-dir=$dir", 'fetch', '-q'), 0,
+ is(xsys('git', "--git-dir=$dir", 'fetch', '-q'), 0,
'fetch successful');
}
};
if ('ensure git configs are correct') {
my @cmd = (qw(git config), "--file=$inboxdir/all.git/config",
qw(core.sharedRepository 0644));
- is(system(@cmd), 0, "set sharedRepository in all.git");
+ is(xsys(@cmd), 0, "set sharedRepository in all.git");
$git0 = PublicInbox::Git->new("$inboxdir/git/0.git");
chomp(my $v = $git0->qx(qw(config core.sharedRepository)));
is($v, '0644', 'child repo inherited core.sharedRepository');
'empty repo has no fingerprint');
{
my $fi_data = './t/git.fast-import-data';
- local $ENV{GIT_DIR} = $bare->{git_dir};
- is(system("git fast-import --quiet <$fi_data"), 0, 'fast-import');
+ open my $fh, '<', $fi_data or die "open $fi_data: $!";
+ my $env = { GIT_DIR => $bare->{git_dir} };
+ is(xsys([qw(git fast-import --quiet)], $env, { 0 => $fh }), 0,
+ 'fast-import');
}
like(PublicInbox::WwwListing::fingerprint($bare), qr/\A[a-f0-9]{40}\z/,
ok($sock, 'sock created');
my ($host, $port) = ($sock->sockhost, $sock->sockport);
my @clone = qw(git clone -q -s --bare);
- is(system(@clone, $bare->{git_dir}, $alt), 0, 'clone shared repo');
+ is(xsys(@clone, $bare->{git_dir}, $alt), 0, 'clone shared repo');
PublicInbox::Import::init_bare("$v2/all.git");
for my $i (0..2) {
- is(system(@clone, $alt, "$v2/git/$i.git"), 0, "clone epoch $i");
+ is(xsys(@clone, $alt, "$v2/git/$i.git"), 0, "clone epoch $i")
}
ok(open(my $fh, '>', "$v2/inbox.lock"), 'mock a v2 inbox');
open $fh, '>', "$alt/description" or die;
print $fh "we're all clones\n" or die;
close $fh or die;
- is(system('git', "--git-dir=$alt", qw(config gitweb.owner lorelei)), 0,
+ is(xsys('git', "--git-dir=$alt", qw(config gitweb.owner lorelei)), 0,
'set gitweb user');
ok(unlink("$bare->{git_dir}/description"), 'removed bare/description');
open $fh, '>', $cfgfile or die;
tiny_test($json, $host, $port);
- skip 'skipping grok-pull integration test', 2 if !which('grok-pull');
+ my $grok_pull = which('grok-pull') or
+ skip('skipping grok-pull integration test', 2);
ok(mkdir("$tmpdir/mirror"), 'prepare grok mirror dest');
open $fh, '>', "$tmpdir/repos.conf" or die;
close $fh or die;
- system(qw(grok-pull -c), "$tmpdir/repos.conf");
+ xsys($grok_pull, '-c', "$tmpdir/repos.conf");
is($? >> 8, 127, 'grok-pull exit code as expected');
for (qw(alt bare v2/git/0.git v2/git/1.git v2/git/2.git)) {
ok(-d "$tmpdir/mirror/$_", "grok-pull created $_");
close $fh or die;
ok(mkdir("$tmpdir/per-inbox"), 'prepare single-v2-inbox mirror');
- system(qw(grok-pull -c), "$tmpdir/per-inbox.conf");
+ xsys($grok_pull, '-c', "$tmpdir/per-inbox.conf");
is($? >> 8, 127, 'grok-pull exit code as expected');
for (qw(v2/git/0.git v2/git/1.git v2/git/2.git)) {
ok(-d "$tmpdir/per-inbox/$_", "grok-pull created $_");
skip 'curl(1) not found', $nr unless $curl;
my $url = "http://$host:$port/description";
my $dst = "$tmpdir/desc";
- is(system($curl, qw(-RsSf), '-o', $dst, $url), 0, 'curl -R');
+ is(xsys($curl, qw(-RsSf), '-o', $dst, $url), 0, 'curl -R');
is((stat($dst))[9], $mtime, 'curl used remote mtime');
- is(system($curl, qw(-sSf), '-z', $dst, '-o', "$dst.2", $url), 0,
+ is(xsys($curl, qw(-sSf), '-z', $dst, '-o', "$dst.2", $url), 0,
'curl -z noop');
ok(!-e "$dst.2", 'no modification, nothing retrieved');
utime(0, 0, $dst) or die "utime failed: $!";
- is(system($curl, qw(-sSfR), '-z', $dst, '-o', "$dst.2", $url), 0,
+ is(xsys($curl, qw(-sSfR), '-z', $dst, '-o', "$dst.2", $url), 0,
'curl -z updates');
ok(-e "$dst.2", 'faked modification, got new file retrieved');
}