diff options
Diffstat (limited to 't')
131 files changed, 4263 insertions, 1550 deletions
diff --git a/t/address.t b/t/address.t index 6aa94628..86f47395 100644 --- a/t/address.t +++ b/t/address.t @@ -1,7 +1,7 @@ -# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org> +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use warnings; +use v5.12; use Test::More; use_ok 'PublicInbox::Address'; @@ -10,6 +10,7 @@ sub test_pkg { my $emails = $pkg->can('emails'); my $names = $pkg->can('names'); my $pairs = $pkg->can('pairs'); + my $objects = $pkg->can('objects'); is_deeply([qw(e@example.com e@example.org)], [$emails->('User <e@example.com>, e@example.org')], @@ -35,6 +36,18 @@ sub test_pkg { [ 'xyz', 'y@x' ], [ 'U Ser', 'u@x' ] ], "pairs extraction works for $pkg"); + # only what's used by PublicInbox::IMAP: + my @objs = $objects->($s); + my @exp = (qw(User e e), qw(e e e), ('John A. Doe', qw(j d)), + qw(x x x), qw(xyz y x), ('U Ser', qw(u x))); + for (my $i = 0; $i <= $#objs; $i++) { + my $exp_name = shift @exp; + my $name = $objs[$i]->name; + is $name, $exp_name, "->name #$i matches"; + is $objs[$i]->user, shift @exp, "->user #$i matches"; + is $objs[$i]->host , shift @exp, "->host #$i matches"; + } + @names = $names->('"user@example.com" <user@example.com>'); is_deeply(['user'], \@names, 'address-as-name extraction works as expected'); @@ -64,6 +77,10 @@ sub test_pkg { is_deeply([], \@emails , 'no address for local address'); @names = $emails->('Local User <user>'); is_deeply([], \@names, 'no address, no name'); + + my $p = $pairs->('NAME, a@example, wtf@'); + is scalar(grep { defined($_->[0] // $_->[1]) } @$p), + scalar(@$p), 'something is always defined in bogus pairs'; } test_pkg('PublicInbox::Address'); @@ -1,11 +1,12 @@ #!perl -w -# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use PublicInbox::TestCommon; use PublicInbox::Import; use_ok 'PublicInbox::Admin'; +use autodie; my $v1 = create_inbox 'v1', -no_gc => 1, sub {}; my ($tmpdir, $for_destroy) = tmpdir(); my $git_dir = $v1->{inboxdir}; @@ -13,7 +14,7 @@ my ($res, $err, $v); my $v2ibx; SKIP: { require_mods(qw(DBD::SQLite), 5); - require_git(2.6, 1) or skip 5, 'git too old'; + require_git(2.6, 5); $v2ibx = create_inbox 'v2', indexlevel => 'basic', version => 2, -no_gc => 1, sub { my ($v2w, $ibx) = @_; @@ -23,6 +24,17 @@ SKIP: { }; *resolve_inboxdir = \&PublicInbox::Admin::resolve_inboxdir; +*resolve_git_dir = \&PublicInbox::Admin::resolve_git_dir; + +{ + symlink $git_dir, my $sym = "$tmpdir/v1-symlink.git"; + for my $d ('') { # TODO: should work inside $sym/objects + local $ENV{PWD} = $sym.$d; + chdir $sym.$d; + is resolve_git_dir('.'), $sym, + "symlink preserved from {SYMLINKDIR}.git$d"; + } +} # v1 is(resolve_inboxdir($git_dir), $git_dir, 'top-level GIT_DIR resolved'); @@ -5,7 +5,7 @@ use strict; use v5.10.1; use PublicInbox::TestCommon; use PublicInbox::Eml; -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(DBD::SQLite Xapian)); use_ok 'PublicInbox::Msgmap'; use_ok 'PublicInbox::SearchIdx'; my ($tmpdir, $for_destroy) = tmpdir(); diff --git a/t/altid_v2.t b/t/altid_v2.t index 281a09d5..6bc90453 100644 --- a/t/altid_v2.t +++ b/t/altid_v2.t @@ -6,7 +6,7 @@ use v5.10.1; use PublicInbox::TestCommon; use PublicInbox::Eml; require_git(2.6); -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(DBD::SQLite Xapian)); require PublicInbox::Msgmap; my $another = 'another-nntp.sqlite3'; my $altid = [ "serial:gmane:file=$another" ]; @@ -14,9 +14,9 @@ my $ibx = create_inbox 'v2', version => 2, indexlevel => 'medium', altid => $altid, sub { my ($im, $ibx) = @_; my $mm = PublicInbox::Msgmap->new_file("$ibx->{inboxdir}/$another", 2); - $mm->mid_set(1234, 'a@example.com') == 1 or BAIL_OUT 'mid_set once'; - ok(0 == $mm->mid_set(1234, 'a@example.com'), 'mid_set not idempotent'); - ok(0 == $mm->mid_set(1, 'a@example.com'), 'mid_set fails with dup MID'); + is($mm->mid_set(1234, 'a@example.com'), 1, 'mid_set') or xbail 'once'; + is($mm->mid_set(1234, 'a@example.com')+0, 0, 'mid_set not idempotent'); + is($mm->mid_set(1, 'a@example.com')+0, 0, 'mid_set fails with dup MID'); $im->add(PublicInbox::Eml->new(<<'EOF')) or BAIL_OUT; From: a@example.com To: b@example.com @@ -27,8 +27,8 @@ hello world gmane:666 EOF }; my $mm = PublicInbox::Msgmap->new_file("$ibx->{inboxdir}/$another", 2); -ok(0 == $mm->mid_set(1234, 'a@example.com'), 'mid_set not idempotent'); -ok(0 == $mm->mid_set(1, 'a@example.com'), 'mid_set fails with dup MID'); +is($mm->mid_set(1234, 'a@example.com') + 0, 0, 'mid_set not idempotent'); +is($mm->mid_set(1, 'a@example.com') + 0, 0, 'mid_set fails with dup MID'); my $mset = $ibx->search->mset('gmane:1234'); my $msgs = $ibx->search->mset_to_smsg($ibx, $mset); $msgs = [ map { $_->{mid} } @$msgs ]; diff --git a/t/check-www-inbox.perl b/t/check-www-inbox.perl index 033b90d1..46f9ce1e 100644 --- a/t/check-www-inbox.perl +++ b/t/check-www-inbox.perl @@ -123,7 +123,7 @@ while (keys %workers) { # reacts to SIGCHLD } } while ($u = shift @queue) { - my $s = $todo[1]->send($u, MSG_EOR); + my $s = $todo[1]->send($u, 0); if ($!{EAGAIN}) { unshift @queue, $u; last; @@ -177,7 +177,7 @@ sub worker_loop { foreach my $l (@links, "DONE\t$u") { next if $l eq '' || $l =~ /\.mbox(?:\.gz)\z/; do { - $s = $done_wr->send($l, MSG_EOR); + $s = $done_wr->send($l, 0); } while (!defined $s && $!{EINTR}); die "$$ send $!\n" unless defined $s; my $n = length($l); diff --git a/t/cindex-join.t b/t/cindex-join.t new file mode 100644 index 00000000..22c67107 --- /dev/null +++ b/t/cindex-join.t @@ -0,0 +1,88 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +# cindex --join functionality against mwrap, a small projects +# started as C+Ruby and got forked to C+Perl/XS w/ public inboxes for each +use v5.12; +use PublicInbox::TestCommon; +use PublicInbox::IO qw(write_file); +use PublicInbox::Import; +use PublicInbox::Config; +use autodie; +use File::Spec; +$ENV{TEST_REMOTE_JOIN} or plan skip_all => 'TEST_REMOTE_JOIN unset'; +require_cmd 'join'; +local $ENV{TAIL_ALL} = $ENV{TAIL_ALL} // 1; # while features are unstable +require_mods(qw(json Xapian DBD::SQLite +SCM_RIGHTS)); +my @code = qw(https://80x24.org/mwrap-perl.git + https://80x24.org/mwrap.git); +my @inboxes = qw(https://80x24.org/mwrap-public 2 inbox.comp.lang.ruby.mwrap + https://80x24.org/mwrap-perl 2 inbox.comp.lang.perl.mwrap); +my (%code, %inboxes); +my $topdir = File::Spec->rel2abs('.'); +my $tmpdir = tmpdir; +while (my $url = shift @code) { + my ($key) = ($url =~ m!/([^/]+\.git)\z!); + $code{$key} = create_coderepo $key, sub { + PublicInbox::Import::init_bare '.'; + write_file '>>', 'config', <<EOM; +[remote "origin"] + url = $url + fetch = +refs/*:refs/* + mirror = true +EOM + if (my $d = $code{'mwrap-perl.git'}) { + $d = File::Spec->abs2rel("$topdir/$d", 'objects'); + write_file '>','objects/info/alternates',"$d/objects\n" + } + diag "mirroring coderepo: $url ..."; + xsys_e qw(git fetch -q origin); + }; +} + +while (my ($url, $v, $ng) = splice(@inboxes, 0, 3)) { + my ($key) = ($url =~ m!/([^/]+)\z!); + my @opt = (version => $v, tmpdir => "$tmpdir/$key", -no_gc => 1); + $inboxes{$key} = create_inbox $key, @opt, sub { + my ($im, $ibx) = @_; + $im->done; + diag "cloning public-inbox $url ..."; + run_script([qw(-clone -q), $url, $ibx->{inboxdir}]) or + xbail "clone: $?"; + diag "indexing $ibx->{inboxdir} ..."; + run_script([qw(-index -v -L medium --dangerous), + $ibx->{inboxdir}]) or xbail "index: $?"; + }; + $inboxes{$key}->{newsgroup} = $ng; +}; +my $env = {}; +open my $fh, '>', $env->{PI_CONFIG} = "$tmpdir/pi_config"; +for (sort keys %inboxes) { + print $fh <<EOM; +[publicinbox "$_"] + inboxdir = $inboxes{$_}->{inboxdir} + address = $_\@80x24.org + newsgroup = $inboxes{$_}->{newsgroup} +EOM +} +close $fh; +my $cidxdir = "$tmpdir/cidx"; +# this should be fast since mwrap* are small +my $rdr = { 1 => \my $cout, 2 => \my $cerr }; +ok run_script([qw(-cindex -v --all --show=join_data), + '--join=aggressive,dt:..2022-12-01', + '-d', $cidxdir, map { ('-g', $_) } values %code ], + $env, $rdr), 'initial join inboxes w/ coderepos'; +my $out = PublicInbox::Config->json->decode($cout); +is($out->{join_data}->{dt}->[0], '19700101'.'000000', + 'dt:..$END_DATE starts from epoch'); + +ok run_script([qw(-cindex -v --all -u --join --show), + '-d', $cidxdir], $env, $rdr), 'incremental --join'; + +ok run_script([qw(-cindex -v --no-scan --show), + '-d', $cidxdir], $env, $rdr), 'show'; +$out = PublicInbox::Config->json->decode($cout); +is ref($out->{join_data}), 'HASH', 'got hash join data'; +is $cerr, '', 'no warnings or errors in stderr w/ --show'; +done_testing; diff --git a/t/cindex.t b/t/cindex.t new file mode 100644 index 00000000..0ae0b2b4 --- /dev/null +++ b/t/cindex.t @@ -0,0 +1,302 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use v5.12; +use PublicInbox::TestCommon; +use Cwd qw(getcwd); +use List::Util qw(sum); +use autodie qw(close mkdir open rename); +require_mods(qw(json Xapian +SCM_RIGHTS DBD::SQLite)); +use_ok 'PublicInbox::CodeSearchIdx'; +use PublicInbox::Import; +my ($tmp, $for_destroy) = tmpdir(); +my $pwd = getcwd(); +my @unused_keys = qw(last_commit has_threadid skip_docdata); +local $ENV{PI_CONFIG} = '/dev/null'; +# local $ENV{TAIL_ALL} = $ENV{TAIL_ALL} // 1; # while features are unstable +my $opt = { 1 => \(my $cidx_out), 2 => \(my $cidx_err) }; + +# I reworked CodeSearchIdx->shard_worker to handle empty trees +# in the initial commit generated by cvs2svn for xapian.git +create_coderepo 'empty-tree-root-0600', tmpdir => "$tmp/wt0", sub { + xsys_e([qw(/bin/sh -c), <<'EOM']); +git init -q && +git config core.sharedRepository 0600 +tree=$(git mktree </dev/null) && +head=$(git symbolic-ref HEAD) && +cmt=$(echo 'empty root' | git commit-tree $tree) && +git update-ref $head $cmt && +echo hi >f && +git add f && +git commit -q -m hi && +git gc -q +EOM +}; # /create_coderepo + +ok(run_script([qw(-cindex --dangerous -q -g), "$tmp/wt0"]), 'cindex internal'); +{ + my $exists = -e "$tmp/wt0/.git/public-inbox-cindex/cidx.lock"; + my @st = stat(_); + ok($exists, 'internal dir created'); + is($st[2] & 0600, 0600, 'mode respects core.sharedRepository'); + @st = stat("$tmp/wt0/.git/public-inbox-cindex"); + is($st[2] & 0700, 0700, 'dir mode respects core.sharedRepository'); +} + +# it's possible for git to emit NUL characters in diffs +# (see c4201214cbf10636e2c1ab9131573f735b42c8d4 in linux.git) +my $zp = create_coderepo 'NUL in patch', sub { + my $src = PublicInbox::IO::try_cat("$pwd/COPYING"); + xsys_e([qw(git init -q)]); + + # needs to be further than FIRST_FEW_BYTES (8000) in git.git + $src =~ s/\b(Limitation of Liability\.)\n\n/$1\n\0\n/s or + xbail "BUG: no `\\n\\n' in $pwd/COPYING"; + + PublicInbox::IO::write_file '>', 'f', $src; + xsys_e([qw(/bin/sh -c), <<'EOM']); +git add f && +git commit -q -m 'initial with NUL character' +EOM + $src =~ s/\n\0\n/\n\n/ or xbail "BUG: no `\\n\\0\\n'"; + PublicInbox::IO::write_file '>', 'f', $src; + xsys_e([qw(/bin/sh -c), <<'EOM']); +git add f && +git commit -q -m 'remove NUL character' && +git gc -q +EOM +}; # /create_coderepo + +$zp = File::Spec->rel2abs($zp); +ok(run_script([qw(-cindex --dangerous -q -d), "$tmp/ext", + '-g', $zp, '-g', "$tmp/wt0" ]), + 'cindex external'); +ok(-e "$tmp/ext/cidx.lock", 'external dir created'); +ok(!-d "$zp/.git/public-inbox-cindex", 'no cindex in original coderepo'); + +ok(run_script([qw(-cindex -L medium --dangerous -q -d), + "$tmp/med", '-g', $zp, '-g', "$tmp/wt0"]), 'cindex external medium'); + + +SKIP: { + have_xapian_compact 2; + ok(run_script([qw(-compact -q), "$tmp/ext"]), 'compact on full'); + ok(run_script([qw(-compact -q), "$tmp/med"]), 'compact on medium'); +} + +my $no_metadata_set = sub { + my ($i, $extra, $xdb) = @_; + for my $xdb (@$xdb) { + for my $k (@unused_keys, @$extra) { + is($xdb->get_metadata($k) // '', '', + "metadata $k unset in shard #$i"); + } + ++$i; + } +}; + +{ + my $mid_size = sum(map { -s $_ } glob("$tmp/med/cidx*/*/*")); + my $full_size = sum(map { -s $_ } glob("$tmp/ext/cidx*/*/*")); + ok($full_size > $mid_size, 'full size > mid size') or + diag "full=$full_size mid=$mid_size"; + for my $l (qw(med ext)) { + ok(run_script([qw(-cindex -q --reindex -u -d), "$tmp/$l"]), + "reindex $l"); + } + $mid_size = sum(map { -s $_ } glob("$tmp/med/cidx*/*/*")); + $full_size = sum(map { -s $_ } glob("$tmp/ext/cidx*/*/*")); + ok($full_size > $mid_size, 'full size > mid size after reindex') or + diag "full=$full_size mid=$mid_size"; + my $csrch = PublicInbox::CodeSearch->new("$tmp/med"); + my ($xdb0, @xdb) = $csrch->xdb_shards_flat; + $no_metadata_set->(0, [], [ $xdb0 ]); + is($xdb0->get_metadata('indexlevel'), 'medium', + 'indexlevel set in shard #0'); + $no_metadata_set->(1, ['indexlevel'], \@xdb); + + ok(run_script([qw(-cindex -q -L full --reindex -u -d), "$tmp/med"]), + 'reindex medium as full'); + @xdb = $csrch->xdb_shards_flat; + $no_metadata_set->(0, ['indexlevel'], \@xdb); +} + +use_ok 'PublicInbox::CodeSearch'; + + +my @xh_args; +my $exp = [ 'initial with NUL character', 'remove NUL character' ]; +my $zp_git = "$zp/.git"; +if ('multi-repo search') { + my $csrch = PublicInbox::CodeSearch->new("$tmp/ext"); + my $mset = $csrch->mset('NUL'); + is(scalar($mset->items), 2, 'got results'); + my @have = sort(map { $_->get_document->get_data } $mset->items); + is_xdeeply(\@have, $exp, 'got expected subjects'); + + $mset = $csrch->mset('NUL', { git_dir => "$tmp/wt0/.git" }); + is(scalar($mset->items), 0, 'no results with other GIT_DIR'); + + $mset = $csrch->mset('NUL', { git_dir => $zp_git }); + @have = sort(map { $_->get_document->get_data } $mset->items); + is_xdeeply(\@have, $exp, 'got expected subjects w/ GIT_DIR filter'); + my @xdb = $csrch->xdb_shards_flat; + $no_metadata_set->(0, ['indexlevel'], \@xdb); + @xh_args = $csrch->xh_args; +} + +my $test_xhc = sub { + my ($xhc) = @_; + my $csrch = PublicInbox::CodeSearch->new("$tmp/ext"); + my $impl = $xhc->{impl}; + my ($r, @l); + $r = $xhc->mkreq([], qw(mset -c -g), $zp_git, @xh_args, 'NUL'); + chomp(@l = <$r>); + like shift(@l), qr/\bmset\.size=2\b/, "got expected header $impl"; + my %docid2data; + my @got = sort map { + my ($docid, $pct, $rank, @extra) = split /\0/; + ok $pct >= 0 && $pct <= 100, 'pct in range'; + ok $rank >= 0 && $rank <= 100000, 'rank ok'; + is scalar(@extra), 0, 'no extra fields'; + $docid2data{$docid} = + $csrch->xdb->get_document($docid)->get_data; + } @l; + is_deeply(\@got, $exp, "expected doc_data $impl"); + + $r = $xhc->mkreq([], qw(mset -c -g), "$tmp/wt0/.git", @xh_args, 'NUL'); + chomp(@l = <$r>); + like shift(@l), qr/\bmset.size=0\b/, "got miss in wrong dir $impl"; + is_deeply(\@l, [], "no extra lines $impl"); + + while (my ($did, $expect) = each %docid2data) { + is_deeply($csrch->xdb->get_document($did)->get_data, + $expect, "docid=$did data matches"); + } + ok(!$xhc->{io}->close, "$impl close"); + is($?, 66 << 8, "got EX_NOINPUT from $impl exit"); +}; + +SKIP: { + require_mods('+SCM_RIGHTS', 1); + require PublicInbox::XapClient; + my $xhc = PublicInbox::XapClient::start_helper('-j0'); + my $csrch = PublicInbox::CodeSearch->new("$tmp/ext"); + $test_xhc->($xhc, $csrch); + skip 'PI_NO_CXX set', 1 if $ENV{PI_NO_CXX}; + $xhc->{impl} =~ /Cxx/ or + skip 'C++ compiler or xapian development libs missing', 1; + skip 'TEST_XH_CXX_ONLY set', 1 if $ENV{TEST_XH_CXX_ONLY}; + local $ENV{PI_NO_CXX} = 1; # force XS or SWIG binding test + $xhc = PublicInbox::XapClient::start_helper('-j0'); + $test_xhc->($xhc, $csrch); +} + +if ('--update') { + my $csrch = PublicInbox::CodeSearch->new("$tmp/ext"); + my $mset = $csrch->mset('dfn:for-update'); + is(scalar($mset->items), 0, 'no result before update'); + + my $e = \%PublicInbox::TestCommon::COMMIT_ENV; + xsys_e([qw(/bin/sh -c), <<'EOM'], $e, { -C => "$tmp/wt0" }); +>for-update && git add for-update && git commit -q -m updated +EOM + ok(run_script([qw(-cindex -qu -d), "$tmp/ext"]), '-cindex -u'); + $mset = $csrch->reopen->mset('dfn:for-update'); + is(scalar($mset->items), 1, 'got updated result'); + + ok(run_script([qw(-cindex -qu --reindex -d), "$tmp/ext"]), 'reindex'); + $mset = $csrch->reopen->mset('dfn:for-update'); + is(scalar($mset->items), 1, 'same result after reindex'); +} + +SKIP: { # --prune + require_cmd($ENV{XAPIAN_DELVE} || 'xapian-delve', 1); + require_git v2.6, 1; + my $csrch = PublicInbox::CodeSearch->new("$tmp/ext"); + is(scalar($csrch->mset('s:hi')->items), 1, 'got hit'); + + rename("$tmp/wt0/.git", "$tmp/wt0/.giit"); + ok(run_script([qw(-cindex -q --prune -d), "$tmp/ext"], undef, $opt), + 'prune'); + is(${$opt->{2}}, '', 'nothing in stderr') or diag explain($opt); + $csrch->reopen; + is(scalar($csrch->mset('s:hi')->items), 0, 'hit pruned'); + + rename("$tmp/wt0/.giit", "$tmp/wt0/.git"); + ok(run_script([qw(-cindex -qu -d), "$tmp/ext"]), 'update'); + $csrch->reopen; + is(scalar($csrch->mset('s:hi')->items), 0, + 'hit stays pruned since GIT_DIR was previously pruned'); + isnt(scalar($csrch->mset('s:NUL')->items), 0, + 'prune did not clobber entire index'); +} + +File::Path::remove_tree("$tmp/ext"); +mkdir("$tmp/ext", 0707); +ok(run_script([qw(-cindex --dangerous -q -d), "$tmp/ext", '-g', $zp]), + 'external on existing dir'); +{ + my @st = stat("$tmp/ext/cidx.lock"); + is($st[2] & 0777, 0604, 'created lock respects odd permissions'); +} + +ok(run_script([qw(-xcpdb), "$tmp/ext"]), 'xcpdb upgrade'); +ok(run_script([qw(-xcpdb -R4), "$tmp/ext"]), 'xcpdb reshard'); + +SKIP: { + have_xapian_compact 2; + ok(run_script([qw(-xcpdb -R2 --compact), "$tmp/ext"]), + 'xcpdb reshard+compact'); + ok(run_script([qw(-xcpdb --compact), "$tmp/ext"]), 'xcpdb compact'); +}; + +SKIP: { + require_cmd('join', 1); + my $basic = create_inbox 'basic', indexlevel => 'basic', sub { + my ($im, $ibx) = @_; + $im->add(eml_load('t/plack-qp.eml')); + }; + my $env = { PI_CONFIG => "$tmp/pi_config" }; + PublicInbox::IO::write_file '>', $env->{PI_CONFIG}, <<EOM; +[publicinbox "basictest"] + inboxdir = $basic->{inboxdir} + address = basic\@example.com +EOM + my $cmd = [ qw(-cindex -u --all -d), "$tmp/ext", + '--join=aggressive,dt:19700101000000..now', + '-I', $basic->{inboxdir} ]; + $cidx_out = $cidx_err = ''; + ok(run_script($cmd, $env, $opt), 'join w/o search'); + like($cidx_err, qr/W: \Q$basic->{inboxdir}\E not indexed for search/s, + 'non-Xapian-enabled inbox noted'); +} + +# we need to support blank sections for a top-level repos +# (e.g. <https://example.com/my-project> +# git.kernel.org could use "pub" as section name, though, since all git repos +# are currently under //git.kernel.org/pub/**/* +{ + mkdir(my $d = "$tmp/blanksection"); + my $cfg = cfg_new($d, <<EOM); +[cindex ""] + topdir = $tmp/ext + localprefix = $tmp +EOM + my $csrch = $cfg->lookup_cindex(''); + is ref($csrch), 'PublicInbox::CodeSearch', 'codesearch w/ blank name'; + is_deeply $csrch->{localprefix}, [ "$tmp" ], 'localprefix respected'; + my $nr = 0; + $cfg->each_cindex(sub { + my ($cs, @rest) = @_; + is $cs->{topdir}, $csrch->{topdir}, 'each_cindex works'; + is_deeply \@rest, [ '.' ], 'got expected arg'; + ++$nr; + }, '.'); + is $nr, 1, 'iterated through cindices'; + my $oid = 'dba13ed2ddf783ee8118c6a581dbf75305f816a3'; + my $mset = $csrch->mset("dfpost:$oid"); + is $mset->size, 1, 'got result from full OID search'; +} + +done_testing; diff --git a/t/clone-coderepo-puh1.sh b/t/clone-coderepo-puh1.sh new file mode 100755 index 00000000..37a52bd4 --- /dev/null +++ b/t/clone-coderepo-puh1.sh @@ -0,0 +1,6 @@ +#!/bin/sh +# sample --post-update-hook for t/clone-coderepo.t test +case $CLONE_CODEREPO_TEST_OUT in +'') ;; +*) echo "uno $@" >> "$CLONE_CODEREPO_TEST_OUT" ;; +esac diff --git a/t/clone-coderepo-puh2.sh b/t/clone-coderepo-puh2.sh new file mode 100755 index 00000000..1170a08a --- /dev/null +++ b/t/clone-coderepo-puh2.sh @@ -0,0 +1,6 @@ +#!/bin/sh +# sample --post-update-hook for t/clone-coderepo.t test +case $CLONE_CODEREPO_TEST_OUT in +'') ;; +*) echo "dos $@" >> "$CLONE_CODEREPO_TEST_OUT" ;; +esac diff --git a/t/clone-coderepo.psgi b/t/clone-coderepo.psgi new file mode 100644 index 00000000..77072174 --- /dev/null +++ b/t/clone-coderepo.psgi @@ -0,0 +1,21 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +# for clone-coderepo.t +use v5.12; +use Plack::Builder; +use PublicInbox::WwwStatic; +use PublicInbox::WWW; +my $www = PublicInbox::WWW->new; +my $static = PublicInbox::WwwStatic->new(docroot => $ENV{TEST_DOCROOT}); +builder { + enable 'Head'; + sub { + my ($env) = @_; + if ($env->{PATH_INFO} eq '/manifest.js.gz') { + my $res = $static->call($env); + return $res if $res->[0] != 404; + } + $www->call($env); + }; +} diff --git a/t/clone-coderepo.t b/t/clone-coderepo.t new file mode 100644 index 00000000..c6180fc4 --- /dev/null +++ b/t/clone-coderepo.t @@ -0,0 +1,220 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use v5.12; +use PublicInbox::TestCommon; +use PublicInbox::Import; +use File::Temp; +use File::Path qw(remove_tree); +use PublicInbox::SHA qw(sha1_hex); +use PublicInbox::IO; +require_mods(qw(json Plack::Builder HTTP::Date HTTP::Status)); +require_git_http_backend; +require_git '1.8.5'; +require_cmd 'curl'; +require_ok 'PublicInbox::LeiMirror'; +my ($tmpdir, $for_destroy) = tmpdir(); +my $pa = "$tmpdir/src/a.git"; +my $pb = "$tmpdir/src/b.git"; +PublicInbox::Import::init_bare($pa); +my ($stdout, $stderr) = ("$tmpdir/out.log", "$tmpdir/err.log"); +my $pi_config = "$tmpdir/pi_config"; +my $td; +my $tcp = tcp_server(); +my $url = 'http://'.tcp_host_port($tcp).'/'; +my $set_manifest = sub { + my ($m, $f) = @_; + $f //= "$tmpdir/src/manifest.js.gz"; + my $ft = File::Temp->new(TMPDIR => $tmpdir, UNLINK => 0); + PublicInbox::LeiMirror::dump_manifest($m, $ft); + PublicInbox::LeiMirror::ft_rename($ft, $f, 0666); +}; +my $read_manifest = sub { + my ($f) = @_; + open my $fh, '<', $f or xbail "open($f): $!"; + PublicInbox::LeiMirror::decode_manifest($fh, $f, $f); +}; + +my $t0 = time - 1; +my $m; # manifest hashref + +{ + my $fi_data = PublicInbox::IO::try_cat './t/git.fast-import-data'; + my $db = PublicInbox::Import::default_branch; + $fi_data =~ s!\brefs/heads/master\b!$db!gs; + my $rdr = { 0 => \$fi_data }; + my @git = ('git', "--git-dir=$pa"); + xsys_e([@git, qw(fast-import --quiet)], undef, $rdr); + xsys_e([qw(/bin/cp -Rp a.git b.git)], undef, { -C => "$tmpdir/src" }); + open my $fh, '>', $pi_config or xbail "open($pi_config): $!"; + print $fh <<EOM or xbail "print: $!"; +[publicinbox] + cgitrc = $tmpdir/cgitrc + cgit = fallback +EOM + close $fh or xbail "close: $!"; + + my $f = "$tmpdir/cgitrc"; + open $fh, '>', $f or xbail "open($f): $!"; + print $fh <<EOM or xbail "print: $!"; +project-list=$tmpdir/src/projects.list +scan-path=$tmpdir/src +EOM + close $fh or xbail "close($f): $!"; + + my $cmd = [ '-httpd', '-W0', "--stdout=$stdout", "--stderr=$stderr", + File::Spec->rel2abs('t/clone-coderepo.psgi') ]; + my $env = { TEST_DOCROOT => "$tmpdir/src", PI_CONFIG => $pi_config }; + $td = start_script($cmd, $env, { 3 => $tcp }); + my $fp = sha1_hex(my $refs = xqx([@git, 'show-ref'])); + my $alice = "\x{100}lice"; + $m = { + '/a.git' => { + fingerprint => $fp, + modified => 1, + owner => $alice, + description => "${alice}'s repo", + }, + '/b.git' => { + fingerprint => $fp, + modified => 1, + owner => 'Bob', + }, + }; + $set_manifest->($m); + $f = "$tmpdir/src/projects.list"; + open $fh, '>', $f, or xbail "open($f): $!"; + print $fh <<EOM or xbail "print($f): $!"; +a.git +b.git +EOM + close $fh or xbail "close($f): $!"; +} + +my $cmd = [qw(-clone --inbox-config=never --manifest= --project-list= + --objstore= -p -q), $url, "$tmpdir/dst", '--exit-code']; +ok(run_script($cmd), 'clone'); +is(xqx([qw(git config gitweb.owner)], { GIT_DIR => "$tmpdir/dst/a.git" }), + "\xc4\x80lice\n", 'a.git gitweb.owner set'); +is(xqx([qw(git config gitweb.owner)], { GIT_DIR => "$tmpdir/dst/b.git" }), + "Bob\n", 'b.git gitweb.owner set'); +my $desc = PublicInbox::IO::try_cat("$tmpdir/dst/a.git/description"); +is($desc, "\xc4\x80lice's repo\n", 'description set'); + +my $dst_pl = "$tmpdir/dst/projects.list"; +my $dst_mf = "$tmpdir/dst/manifest.js.gz"; +ok(!-d "$tmpdir/dst/objstore", 'no objstore created w/o forkgroups'); +my $r = $read_manifest->($dst_mf); +is_deeply($r, $m, 'manifest matches'); + +is(PublicInbox::IO::try_cat($dst_pl), "a.git\nb.git\n", + 'wrote projects.list'); + +{ # check symlinks + $m->{'/a.git'}->{symlinks} = [ '/old/a.git' ]; + $set_manifest->($m); + utime($t0, $t0, $dst_mf) or xbail "utime: $!"; + ok(run_script($cmd), 'clone again +symlinks'); + ok(-l "$tmpdir/dst/old/a.git", 'symlink created'); + is(PublicInbox::IO::try_cat($dst_pl), "a.git\nb.git\n", + 'projects.list does not include symlink by default'); + + $r = $read_manifest->($dst_mf); + is_deeply($r, $m, 'updated manifest matches'); +} +{ # cleanup old projects from projects.list + open my $fh, '>>', $dst_pl or xbail $!; + print $fh "gone.git\n" or xbail $!; + close $fh or xbail $!; + + utime($t0, $t0, $dst_mf) or xbail "utime: $!"; + my $rdr = { 2 => \(my $err = '') }; + ok(run_script($cmd, undef, $rdr), 'clone again for expired gone.git'); + is(PublicInbox::IO::try_cat($dst_pl), "a.git\nb.git\n", + 'project list cleaned'); + like($err, qr/no longer exist.*\bgone\.git\b/s, 'gone.git noted'); +} + +{ # --purge + open my $fh, '>>', $dst_pl or xbail $!; + print $fh "gone-rdonly.git\n" or xbail $!; + close $fh or xbail $!; + my $ro = "$tmpdir/dst/gone-rdonly.git"; + PublicInbox::Import::init_bare($ro); + ok(-d $ro, 'gone-rdonly.git created'); + my @st = stat($ro) or xbail "stat($ro): $!"; + chmod($st[2] & 0555, $ro) or xbail "chmod($ro): $!"; + + utime($t0, $t0, $dst_mf) or xbail "utime: $!"; + my $rdr = { 2 => \(my $err = '') }; + my $xcmd = [ @$cmd, '--purge' ]; + ok(run_script($xcmd, undef, $rdr), 'clone again for expired gone.git'); + is(PublicInbox::IO::try_cat($dst_pl), "a.git\nb.git\n", + 'project list cleaned'); + like($err, qr!ignored/gone.*?\bgone-rdonly\.git\b!s, + 'gone-rdonly.git noted'); + ok(!-d $ro, 'gone-rdonly.git dir gone from --purge'); +} + +my $test_puh = sub { + my (@clone_arg) = @_; + my $x = [qw(-clone --inbox-config=never --manifest= --project-list= + -q -p), $url, "$tmpdir/dst", @clone_arg, + '--post-update-hook=./t/clone-coderepo-puh1.sh', + '--post-update-hook=./t/clone-coderepo-puh2.sh' ]; + my $log = "$tmpdir/puh.log"; + my $env = { CLONE_CODEREPO_TEST_OUT => $log }; + remove_tree("$tmpdir/dst"); + ok(run_script($x, $env), "fresh clone @clone_arg w/ post-update-hook"); + ok(-e $log, "hooks run on fresh clone @clone_arg"); + open my $lh, '<', $log or xbail "open $log: $!"; + chomp(my @l = readline($lh)); + is(scalar(@l), 4, "4 lines written by hooks on @clone_arg"); + for my $r (qw(a b)) { + is_xdeeply(['uno', 'dos'], + [ (map { s/ .+//; $_ } grep(m!/$r\.git\z!, @l)) ], + "$r.git hooks ran in order") or diag explain(\@l); + } + unlink($log) or xbail "unlink: $!"; + ok(run_script($x, $env), "no-op clone @clone_arg w/ post-update-hook"); + ok(!-e $log, "hooks not run on no-op @clone_arg"); + + push @$x, '--exit-code'; + ok(!run_script($x, $env), 'no-op clone w/ --exit-code fails'); + is($? >> 8, 127, '--exit-code gave 127'); +}; +$test_puh->(); +ok(!-e "$tmpdir/dst/objstore", 'no objstore, yet'); + +my $fgrp = 'fgrp'; +$m->{'/a.git'}->{forkgroup} = $m->{'/b.git'}->{forkgroup} = $fgrp; +$set_manifest->($m); +$test_puh->('--objstore='); +ok(-e "$tmpdir/dst/objstore", 'objstore created'); + +# ensure new repos can be detected +{ + xsys_e([qw(/bin/cp -Rp a.git c.git)], undef, { -C => "$tmpdir/src" }); + open my $fh, '>>', "$tmpdir/src/projects.list" or xbail "open $!"; + say $fh 'c.git' or xbail "say $!"; + close $fh or xbail "close $!"; + xsys_e([qw(git clone -q), "${url}c.git", "$tmpdir/dst/c.git"]); + SKIP: { + require_mods(qw(Plack::Test::ExternalServer LWP::UserAgent), 1); + use_ok($_) for qw(HTTP::Request::Common); + chop(my $uri = $url) eq '/' or xbail "BUG: no /"; + local $ENV{PLACK_TEST_EXTERNALSERVER_URI} = $uri; + my %opt = (ua => LWP::UserAgent->new); + $opt{ua}->max_redirect(0); + $opt{client} = sub { + my ($cb) = @_; + my $res = $cb->(GET('/c.git/')); + is($res->code, 200, 'got 200 response for /'); + $res = $cb->(GET('/c.git/tree/')); + is($res->code, 200, 'got 200 response for /tree'); + }; + Plack::Test::ExternalServer::test_psgi(%opt); + } +} + +done_testing; diff --git a/t/cmd_ipc.t b/t/cmd_ipc.t index 75697a15..c973c6f0 100644 --- a/t/cmd_ipc.t +++ b/t/cmd_ipc.t @@ -1,23 +1,20 @@ #!perl -w # Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use v5.10.1; -use Test::More; +use v5.12; use PublicInbox::TestCommon; -use Socket qw(AF_UNIX SOCK_STREAM MSG_EOR); -pipe(my ($r, $w)) or BAIL_OUT; +use autodie; +use Socket qw(AF_UNIX SOCK_STREAM SOCK_SEQPACKET); +pipe(my $r, my $w); my ($send, $recv); require_ok 'PublicInbox::Spawn'; -my $SOCK_SEQPACKET = eval { Socket::SOCK_SEQPACKET() } // undef; -use Time::HiRes qw(usleep); +require POSIX; my $do_test = sub { SKIP: { my ($type, $flag, $desc) = @_; - defined $type or skip 'SOCK_SEQPACKET missing', 7; my ($s1, $s2); my $src = 'some payload' x 40; - socketpair($s1, $s2, AF_UNIX, $type, 0) or BAIL_OUT $!; + socketpair($s1, $s2, AF_UNIX, $type, 0); my $sfds = [ fileno($r), fileno($w), fileno($s1) ]; $send->($s1, $sfds, $src, $flag); my (@fds) = $recv->($s2, my $buf, length($src) + 1); @@ -38,7 +35,7 @@ my $do_test = sub { SKIP: { @exp = stat $s1; @cur = stat $s1a; is("$exp[0]\0$exp[1]", "$cur[0]\0$cur[1]", '$s1 dev/ino matches'); - if (defined($SOCK_SEQPACKET) && $type == $SOCK_SEQPACKET) { + if ($type == SOCK_SEQPACKET) { $r1 = $w1 = $s1a = undef; $src = (',' x 1023) . '-' .('.' x 1024); $send->($s1, $sfds, $src, $flag); @@ -50,47 +47,50 @@ my $do_test = sub { SKIP: { $s2->blocking(0); @fds = $recv->($s2, $buf, length($src) + 1); ok($!{EAGAIN}, "EAGAIN set by ($desc)"); + is($buf, '', "recv buffer emptied on EAGAIN ($desc)"); is_deeply(\@fds, [ undef ], "EAGAIN $desc"); $s2->blocking(1); - if ($ENV{TEST_ALRM}) { + if ('test ALRM') { my $alrm = 0; local $SIG{ALRM} = sub { $alrm++ }; my $tgt = $$; - my $pid = fork // xbail "fork: $!"; + my $pid = fork; if ($pid == 0) { # need to loop since Perl signals are racy # (the interpreter doesn't self-pipe) - while (usleep(1000)) { - kill 'ALRM', $tgt; + my $n = 3; + while (tick(0.01 * $n) && --$n) { + kill('ALRM', $tgt) } + close $s1; + POSIX::_exit(1); } + close $s1; @fds = $recv->($s2, $buf, length($src) + 1); - ok($!{EINTR}, "EINTR set by ($desc)"); - kill('KILL', $pid); waitpid($pid, 0); - is_deeply(\@fds, [ undef ], "EINTR $desc"); + is_deeply(\@fds, [], "EINTR->EOF $desc"); ok($alrm, 'SIGALRM hit'); } - close $s1; @fds = $recv->($s2, $buf, length($src) + 1); is_deeply(\@fds, [], "no FDs on EOF $desc"); is($buf, '', "buffer cleared on EOF ($desc)"); - socketpair($s1, $s2, AF_UNIX, $type, 0) or BAIL_OUT $!; + socketpair($s1, $s2, AF_UNIX, $type, 0); $s1->blocking(0); my $nsent = 0; + my $srclen = length($src); while (defined(my $n = $send->($s1, $sfds, $src, $flag))) { $nsent += $n; - fail "sent 0 bytes" if $n == 0; + fail "sent $n bytes of $srclen" if $srclen != $n; } - ok($!{EAGAIN} || $!{ETOOMANYREFS}, - "hit EAGAIN || ETOOMANYREFS on send $desc") or - diag "send failed with: $!"; + ok($!{EAGAIN} || $!{ETOOMANYREFS} || $!{EMSGSIZE}, + "hit EAGAIN || ETOOMANYREFS || EMSGSIZE on send $desc") + or diag "send failed with: $! (nsent=$nsent)"; ok($nsent > 0, 'sent some bytes'); - socketpair($s1, $s2, AF_UNIX, $type, 0) or BAIL_OUT $!; + socketpair($s1, $s2, AF_UNIX, $type, 0); is($send->($s1, [], $src, $flag), length($src), 'sent w/o FDs'); $buf = 'nope'; @fds = $recv->($s2, $buf, length($src)); @@ -99,7 +99,7 @@ my $do_test = sub { SKIP: { my $nr = 2 * 1024 * 1024; while (1) { - vec(my $vec = '', $nr * 8 - 1, 1) = 1; + vec(my $vec = '', $nr - 1, 8) = 1; my $n = $send->($s1, [], $vec, $flag); if (defined($n)) { $n == length($vec) or @@ -123,7 +123,7 @@ SKIP: { $send = $send_ic; $recv = $recv_ic; $do_test->(SOCK_STREAM, 0, 'Inline::C stream'); - $do_test->($SOCK_SEQPACKET, MSG_EOR, 'Inline::C seqpacket'); + $do_test->(SOCK_SEQPACKET, 0, 'Inline::C seqpacket'); } SKIP: { @@ -132,25 +132,24 @@ SKIP: { $send = PublicInbox::CmdIPC4->can('send_cmd4'); $recv = PublicInbox::CmdIPC4->can('recv_cmd4'); $do_test->(SOCK_STREAM, 0, 'MsgHdr stream'); - $do_test->($SOCK_SEQPACKET, MSG_EOR, 'MsgHdr seqpacket'); + $do_test->(SOCK_SEQPACKET, 0, 'MsgHdr seqpacket'); SKIP: { ($send_ic && $recv_ic) or skip 'Inline::C not installed/enabled', 12; $recv = $recv_ic; $do_test->(SOCK_STREAM, 0, 'Inline::C -> MsgHdr stream'); - $do_test->($SOCK_SEQPACKET, 0, 'Inline::C -> MsgHdr seqpacket'); + $do_test->(SOCK_SEQPACKET, 0, 'Inline::C -> MsgHdr seqpacket'); } } SKIP: { - skip 'not Linux', 1 if $^O ne 'linux'; require_ok 'PublicInbox::Syscall'; $send = PublicInbox::Syscall->can('send_cmd4') or - skip 'send_cmd4 not defined for arch'; + skip "send_cmd4 not defined for $^O arch", 1; $recv = PublicInbox::Syscall->can('recv_cmd4') or - skip 'recv_cmd4 not defined for arch'; - $do_test->(SOCK_STREAM, 0, 'PP Linux stream'); - $do_test->($SOCK_SEQPACKET, MSG_EOR, 'PP Linux seqpacket'); + skip "recv_cmd4 not defined for $^O arch", 1; + $do_test->(SOCK_STREAM, 0, 'pure Perl stream'); + $do_test->(SOCK_SEQPACKET, 0, 'pure Perl seqpacket'); } done_testing; @@ -1,13 +1,31 @@ -# Copyright (C) 2014-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use v5.10.1; +use v5.12; use PublicInbox::TestCommon; use PublicInbox::Import; use_ok 'PublicInbox'; ok(defined(eval('$PublicInbox::VERSION')), 'VERSION defined'); use_ok 'PublicInbox::Config'; my ($tmpdir, $for_destroy) = tmpdir(); +use autodie qw(open close); +my $validate_git_behavior = $ENV{TEST_VALIDATE_GIT_BEHAVIOR}; + +{ + my $f = "$tmpdir/bool_config"; + open my $fh, '>', $f; + print $fh <<EOM; +[imap] + debug + port = 2 +EOM + close $fh; + my $cfg = PublicInbox::Config->git_config_dump($f); + $validate_git_behavior and + is(xqx([qw(git config -f), $f, qw(--bool imap.debug)]), + "true\n", 'git handles key-only as truth'); + ok($cfg->git_bool($cfg->{'imap.debug'}), 'key-only value handled'); + is($cfg->{'imap.port'}, 2, 'normal k=v read after key-only'); +} { PublicInbox::Import::init_bare($tmpdir); @@ -64,28 +82,30 @@ my ($tmpdir, $for_destroy) = tmpdir(); { - my $cfgpfx = "publicinbox.test"; my @altid = qw(serial:gmane:file=a serial:enamg:file=b); - my $config = PublicInbox::Config->new(\<<EOF); -$cfgpfx.address=test\@example.com -$cfgpfx.mainrepo=/path/to/non/existent -$cfgpfx.altid=serial:gmane:file=a -$cfgpfx.altid=serial:enamg:file=b + my $config = cfg_new $tmpdir, <<EOF; +[publicinbox "test"] + address = test\@example.com + inboxdir = /path/to/non/existent + altid=serial:gmane:file=a + altid=serial:enamg:file=b EOF my $ibx = $config->lookup_name('test'); is_deeply($ibx->{altid}, [ @altid ]); - $config = PublicInbox::Config->new(\<<EOF); -$cfgpfx.address=test\@example.com -$cfgpfx.mainrepo=/path/to/non/existent + $config = cfg_new $tmpdir, <<EOF; +[publicinbox "test"] + address = test\@example.com + inboxdir = /path/to/non/existent EOF $ibx = $config->lookup_name('test'); is($ibx->{inboxdir}, '/path/to/non/existent', 'mainrepo still works'); - $config = PublicInbox::Config->new(\<<EOF); -$cfgpfx.address=test\@example.com -$cfgpfx.inboxdir=/path/to/non/existent -$cfgpfx.mainrepo=/path/to/deprecated + $config = cfg_new $tmpdir, <<EOF; +[publicinbox "test"] + address = test\@example.com + inboxdir = /path/to/non/existent + mainrepo = /path/to/deprecated EOF $ibx = $config->lookup_name('test'); is($ibx->{inboxdir}, '/path/to/non/existent', @@ -93,28 +113,29 @@ EOF } { - my $pfx = "publicinbox.test"; - my $str = <<EOF; -$pfx.address=test\@example.com -$pfx.inboxdir=/path/to/non/existent -$pfx.newsgroup=inbox.test -publicinbox.nntpserver=news.example.com + my $cfg = cfg_new $tmpdir, <<EOF; +[publicinbox "test"] + address = test\@example.com + inboxdir = /path/to/non/existent + newsgroup = inbox.test +[publicinbox] + nntpserver = news.example.com EOF - my $cfg = PublicInbox::Config->new(\$str); my $ibx = $cfg->lookup_name('test'); is_deeply($ibx->nntp_url({ www => { pi_cfg => $cfg }}), [ 'nntp://news.example.com/inbox.test' ], 'nntp_url uses global NNTP server'); - $str = <<EOF; -$pfx.address=test\@example.com -$pfx.inboxdir=/path/to/non/existent -$pfx.newsgroup=inbox.test -$pfx.nntpserver=news.alt.example.com -publicinbox.nntpserver=news.example.com -publicinbox.imapserver=imaps://mail.example.com + $cfg = cfg_new $tmpdir, <<EOF; +[publicinbox "test"] + address = test\@example.com + inboxdir = /path/to/non/existent + newsgroup = inbox.test + nntpserver = news.alt.example.com +[publicinbox] + nntpserver = news.example.com + imapserver = imaps://mail.example.com EOF - $cfg = PublicInbox::Config->new(\$str); $ibx = $cfg->lookup_name('test'); is_deeply($ibx->nntp_url({ www => { pi_cfg => $cfg }}), [ 'nntp://news.alt.example.com/inbox.test' ], @@ -126,17 +147,18 @@ EOF # no obfuscate domains { - my $pfx = "publicinbox.test"; - my $pfx2 = "publicinbox.foo"; - my $str = <<EOF; -$pfx.address=test\@example.com -$pfx.inboxdir=/path/to/non/existent -$pfx2.address=foo\@example.com -$pfx2.inboxdir=/path/to/foo -publicinbox.noobfuscate=public-inbox.org \@example.com z\@EXAMPLE.com -$pfx.obfuscate=true + my $cfg = cfg_new $tmpdir, <<EOF; +[publicinbox "test"] + address = test\@example.com + inboxdir = /path/to/non/existent +[publicinbox "foo"] + address = foo\@example.com + inboxdir = /path/to/foo +[publicinbox] + noobfuscate = public-inbox.org \@example.com z\@EXAMPLE.com +[publicinbox "test"] + obfuscate = true EOF - my $cfg = PublicInbox::Config->new(\$str); my $ibx = $cfg->lookup_name('test'); my $re = $ibx->{-no_obfuscate_re}; like('meta@public-inbox.org', $re, @@ -208,20 +230,21 @@ for my $s (@valid) { } { - my $pfx1 = "publicinbox.test1"; - my $pfx2 = "publicinbox.test2"; - my $str = <<EOF; -$pfx1.address=test\@example.com -$pfx1.inboxdir=/path/to/non/existent -$pfx2.address=foo\@example.com -$pfx2.inboxdir=/path/to/foo -$pfx1.coderepo=project -$pfx2.coderepo=project -coderepo.project.dir=/path/to/project.git + my $cfg = cfg_new $tmpdir, <<EOF; +[publicinbox "test1"] + address = test\@example.com + inboxdir = /path/to/non/existent + coderepo = project +[publicinbox "test2"] + address = foo\@example.com + inboxdir = /path/to/foo + coderepo = project +[coderepo "project"] + dir = /path/to/project.git EOF - my $cfg = PublicInbox::Config->new(\$str); my $t1 = $cfg->lookup_name('test1'); my $t2 = $cfg->lookup_name('test2'); + ok $cfg->repo_objs($t1)->[0], 'coderepo parsed'; is($cfg->repo_objs($t1)->[0], $cfg->repo_objs($t2)->[0], 'inboxes share ::Git object'); } @@ -245,21 +268,69 @@ EOF SKIP: { # XXX wildcard match requires git 2.26+ - require_git('1.8.5', 2) or - skip 'git 1.8.5+ required for --url-match', 2; - my $f = "$tmpdir/urlmatch"; - open my $fh, '>', $f or BAIL_OUT $!; - print $fh <<EOF or BAIL_OUT $!; + require_git v1.8.5, 2; + my $cfg = cfg_new $tmpdir, <<EOF; [imap "imap://mail.example.com"] pollInterval = 9 EOF - close $fh or BAIL_OUT; - local $ENV{PI_CONFIG} = $f; - my $cfg = PublicInbox::Config->new; my $url = 'imap://mail.example.com/INBOX'; is($cfg->urlmatch('imap.pollInterval', $url), 9, 'urlmatch hit'); is($cfg->urlmatch('imap.idleInterval', $url), undef, 'urlmatch miss'); }; +my $glob2re = PublicInbox::Config->can('glob2re'); +is($glob2re->('http://[::1]:1234/foo/'), undef, 'IPv6 URL not globbed'); +is($glob2re->('foo'), undef, 'plain string unchanged'); +is_deeply($glob2re->('[f-o]'), '[f-o]' , 'range accepted'); +is_deeply($glob2re->('*'), '[^/]*?' , 'wildcard accepted'); +is_deeply($glob2re->('{a,b,c}'), '(a|b|c)' , 'braces'); +is_deeply($glob2re->('{,b,c}'), '(|b|c)' , 'brace with empty @ start'); +is_deeply($glob2re->('{a,b,}'), '(a|b|)' , 'brace with empty @ end'); +is_deeply($glob2re->('{a}'), undef, 'ungrouped brace'); +is_deeply($glob2re->('{a'), undef, 'open left brace'); +is_deeply($glob2re->('a}'), undef, 'open right brace'); +is_deeply($glob2re->('*.[ch]'), '[^/]*?\\.[ch]', 'suffix glob'); +is_deeply($glob2re->('{[a-z],9,}'), '([a-z]|9|)' , 'brace with range'); +is_deeply($glob2re->('\\{a,b\\}'), undef, 'escaped brace'); +is_deeply($glob2re->('\\\\{a,b}'), '\\\\\\\\(a|b)', 'fake escape brace'); +is_deeply($glob2re->('**/foo'), '.*/foo', 'double asterisk start'); +is_deeply($glob2re->('foo/**'), 'foo/.*', 'double asterisk end'); +my $re = $glob2re->('a/**/b'); +is_deeply($re, 'a(?:/.*?/|/)b', 'double asterisk middle'); +like($_, qr!$re!, "a/**/b matches $_") for ('a/b', 'a/c/b', 'a/c/a/b'); +unlike($_, qr!$re!, "a/**/b doesn't match $_") for ('a/ab'); + +{ + my $w = ''; + local $SIG{__WARN__} = sub { $w .= "@_"; }; + my $cfg = cfg_new $tmpdir, <<EOF; +[publicinbox "a"] + address = a\@example.com + inboxdir = $tmpdir/aa +[publicinbox "b"] + address = b\@example.com + inboxdir = $tmpdir/aa +EOF + $cfg->fill_all; + like $w, qr!`\Q$tmpdir/aa\E' used by both!, 'inboxdir conflict warned'; +} + +{ + my $w = ''; + local $SIG{__WARN__} = sub { $w .= "@_"; }; + my $cfg = cfg_new $tmpdir, <<EOF; +[publicinbox "a"] + address = a\@example.com + inboxdir = $tmpdir/a + newsgroup = inbox.test +[publicinbox "b"] + address = b\@example.com + inboxdir = $tmpdir/b + newsgroup = inbox.tesT +EOF + $cfg->fill_all; + like $w, qr!`inbox\.test' used by both!, 'newsgroup conflict warned'; + like $w, qr!`inbox\.tesT' lowercased!, 'upcase warned'; +} -done_testing(); +done_testing; diff --git a/t/config_limiter.t b/t/config_limiter.t index 8c83aca8..f4d99080 100644 --- a/t/config_limiter.t +++ b/t/config_limiter.t @@ -1,15 +1,14 @@ -# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use warnings; -use Test::More; -use PublicInbox::Config; -my $cfgpfx = "publicinbox.test"; +use v5.12; +use PublicInbox::TestCommon; +my $tmpdir = tmpdir; { - my $config = PublicInbox::Config->new(\<<EOF); -$cfgpfx.address=test\@example.com -$cfgpfx.inboxdir=/path/to/non/existent -$cfgpfx.httpbackendmax=12 + my $config = cfg_new $tmpdir, <<EOF; +[publicinbox "test"] + address = test\@example.com + inboxdir = /path/to/non/existent + httpbackendmax = 12 EOF my $ibx = $config->lookup_name('test'); my $git = $ibx->git; @@ -24,11 +23,13 @@ EOF } { - my $config = PublicInbox::Config->new(\<<EOF); -publicinboxlimiter.named.max=3 -$cfgpfx.address=test\@example.com -$cfgpfx.inboxdir=/path/to/non/existent -$cfgpfx.httpbackendmax=named + my $config = cfg_new $tmpdir, <<EOF; +[publicinboxlimiter "named"] + max = 3 +[publicinbox "test"] + address = test\@example.com + inboxdir = /path/to/non/existent + httpbackendmax = named EOF my $ibx = $config->lookup_name('test'); my $git = $ibx->git; diff --git a/t/convert-compact.t b/t/convert-compact.t index 7270cab0..b123f17b 100644 --- a/t/convert-compact.t +++ b/t/convert-compact.t @@ -1,5 +1,5 @@ #!perl -w -# Copyright (C) 2018-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; @@ -7,9 +7,8 @@ use PublicInbox::Eml; use PublicInbox::TestCommon; use PublicInbox::Import; require_git(2.6); -require_mods(qw(DBD::SQLite Search::Xapian)); -have_xapian_compact or - plan skip_all => 'xapian-compact missing for '.__FILE__; +require_mods(qw(DBD::SQLite Xapian)); +have_xapian_compact; my ($tmpdir, $for_destroy) = tmpdir(); my $ibx = create_inbox 'v1', indexlevel => 'medium', tmpdir => "$tmpdir/v1", pre_cb => sub { @@ -36,14 +35,14 @@ EOF $im->add($eml) or BAIL_OUT '->add'; }; umask(077) or BAIL_OUT "umask: $!"; -is(((stat("$ibx->{inboxdir}/public-inbox"))[2]) & 07777, 0755, +oct_is(((stat("$ibx->{inboxdir}/public-inbox"))[2]) & 05777, 0755, 'sharedRepository respected for v1'); -is(((stat("$ibx->{inboxdir}/public-inbox/msgmap.sqlite3"))[2]) & 07777, 0644, - 'sharedRepository respected for v1 msgmap'); +oct_is(((stat("$ibx->{inboxdir}/public-inbox/msgmap.sqlite3"))[2]) & 05777, + 0644, 'sharedRepository respected for v1 msgmap'); my @xdir = glob("$ibx->{inboxdir}/public-inbox/xap*/*"); foreach (@xdir) { my @st = stat($_); - is($st[2] & 07777, -f _ ? 0644 : 0755, + oct_is($st[2] & 05777, -f _ ? 0644 : 0755, 'sharedRepository respected on file after convert'); } @@ -56,7 +55,7 @@ ok(run_script($cmd, undef, $rdr), 'v1 compact works'); @xdir = glob("$ibx->{inboxdir}/public-inbox/xap*"); is(scalar(@xdir), 1, 'got one xapian directory after compact'); -is(((stat($xdir[0]))[2]) & 07777, 0755, +oct_is(((stat($xdir[0]))[2]) & 05777, 0755, 'sharedRepository respected on v1 compact'); my $hwm = do { @@ -72,9 +71,9 @@ ok(run_script($cmd, undef, $rdr), 'convert --no-index works'); $cmd = [ '-convert', $ibx->{inboxdir}, "$tmpdir/x/v2" ]; ok(run_script($cmd, undef, $rdr), 'convert works'); @xdir = glob("$tmpdir/x/v2/xap*/*"); -foreach (@xdir) { +for (@xdir) { # TODO: should public-inbox-convert preserve S_ISGID bit? my @st = stat($_); - is($st[2] & 07777, -f _ ? 0644 : 0755, + oct_is($st[2] & 07777, -f _ ? 0644 : 0755, 'sharedRepository respected after convert'); } @@ -88,20 +87,20 @@ is($ibx->mm->num_highwater, $hwm, 'highwater mark unchanged in v2 inbox'); @xdir = glob("$tmpdir/x/v2/xap*/*"); foreach (@xdir) { my @st = stat($_); - is($st[2] & 07777, -f _ ? 0644 : 0755, + oct_is($st[2] & 07777, -f _ ? 0644 : 0755, 'sharedRepository respected after v2 compact'); } -is(((stat("$tmpdir/x/v2/msgmap.sqlite3"))[2]) & 07777, 0644, +oct_is(((stat("$tmpdir/x/v2/msgmap.sqlite3"))[2]) & 07777, 0644, 'sharedRepository respected for v2 msgmap'); @xdir = (glob("$tmpdir/x/v2/git/*.git/objects/*/*"), glob("$tmpdir/x/v2/git/*.git/objects/pack/*")); foreach (@xdir) { my @st = stat($_); - is($st[2] & 07777, -f _ ? 0444 : 0755, + oct_is($st[2] & 07777, -f _ ? 0444 : 0755, 'sharedRepository respected after v2 compact'); } -my $msgs = $ibx->recent({limit => 1000}); +my $msgs = $ibx->over->recent({limit => 1000}); is($msgs->[0]->{mid}, 'a-mid@b', 'message exists in history'); is(scalar @$msgs, 1, 'only one message in history'); diff --git a/t/data/attached-mbox-with-utf8.eml b/t/data/attached-mbox-with-utf8.eml new file mode 100644 index 00000000..53dad830 --- /dev/null +++ b/t/data/attached-mbox-with-utf8.eml @@ -0,0 +1,45 @@ +Date: Mon, 24 Sep 2018 09:46:40 -0700 (PDT) +Message-Id: <attached-mbox-with-utf8@example> +To: test@example.com +Subject: [PATCHES] attached mbox with UTF-8 patch +From: attacher@example.com +Mime-Version: 1.0 +Content-Type: Multipart/Mixed; + boundary="--Next_Part(Mon_Sep_24_09_46_40_2018_110)--" +Content-Transfer-Encoding: 7bit + +----Next_Part(Mon_Sep_24_09_46_40_2018_110)-- +Content-Type: Text/Plain; charset=us-ascii +Content-Transfer-Encoding: 7bit + +hello world + +----Next_Part(Mon_Sep_24_09_46_40_2018_110)-- +Content-Type: Application/Octet-Stream +Content-Transfer-Encoding: base64 +Content-Disposition: attachment; filename="foo.mbox" + +RnJvbSAzNGRkMWQyNWQ3NmU0NjRjNTM0ZGI0MDllYTdlZDQyNWFiMDVjODI2IE1vbiBTZXAgMTcg +MDA6MDA6MDAgMjAwMQpGcm9tOiA9P1VURi04P3E/Qmo9QzM9Qjhybj89IDxiam9ybkBleGFtcGxl +LmNvbT4KRGF0ZTogVGh1LCAxMiBTZXAgMjAxOSAxMDo0MjowMCArMDIwMApNSU1FLVZlcnNpb246 +IDEuMApDb250ZW50LVR5cGU6IHRleHQvcGxhaW47IGNoYXJzZXQ9VVRGLTgKQ29udGVudC1UcmFu +c2Zlci1FbmNvZGluZzogOGJpdAoKU2lnbmVkLW9mZi1ieTogQmrDuHJuIDxiam9ybkBleGFtcGxl +LmNvbT4KU2lnbmVkLW9mZi1ieTogaiDFu2VuIDx6QGV4YW1wbGUuY29tPgotLS0KIGZvby5jIHwg +MSArLQogMSBmaWxlIGNoYW5nZWQsIDEgaW5zZXJ0aW9ucygrKSwgMSBkZWxldGlvbnMoLSkKCmRp +ZmYgLS1naXQgYS9mb28uYyBiL2Zvby5jCmluZGV4IDVjNDJjZjgxYTA4Yi4uODVmYmE2NGMzZmNm +IDEwMDY0NAotLS0gYS9mb28uYworKysgYi9mb28uYwpAQCAtMjIxLDkgKzIyMSw5IEBAIGludCBo +ZWxsbyh2b2lkKQogCQlnb3RvIHBoYWlsOwogCX0KIHNraXA6Ci0JaWYgKAlmb28gJiYKKwl1bmxl +c3MgKGZvbykKIGJsYWgKIGJsYWgKIGJsYWgKLS0gCkJqw7hybgoKRnJvbSAzNGRkMWQyNWQ3NmU0 +NjRjNTM0ZGI0MDllYTdlZDQyNWFiMDVjODI2IE1vbiBTZXAgMTcgMDA6MDA6MDAgMjAwMQpGcm9t +OiA9P1VURi04P3E/Qmo9QzM9Qjhybj89IDxiam9ybkBleGFtcGxlLmNvbT4KRGF0ZTogVGh1LCAx +MiBTZXAgMjAxOSAxMDo0MjowMCArMDIwMApNSU1FLVZlcnNpb246IDEuMApDb250ZW50LVR5cGU6 +IHRleHQvcGxhaW47IGNoYXJzZXQ9VVRGLTgKQ29udGVudC1UcmFuc2Zlci1FbmNvZGluZzogOGJp +dAoKU2lnbmVkLW9mZi1ieTogQmrDuHJuIDxiam9ybkBleGFtcGxlLmNvbT4KU2lnbmVkLW9mZi1i +eTogaiDFu2VuIDx6QGV4YW1wbGUuY29tPgotLS0KIGZvby5jIHwgMSArLQogMSBmaWxlIGNoYW5n +ZWQsIDEgaW5zZXJ0aW9ucygrKSwgMSBkZWxldGlvbnMoLSkKCmRpZmYgLS1naXQgYS9mb28uYyBi +L2Zvby5jCmluZGV4IDVjNDJjZjgxYTA4Yi4uODVmYmE2NGMzZmNmIDEwMDY0NAotLS0gYS9mb28u +YworKysgYi9mb28uYwpAQCAtMjIxLDkgKzIyMSw5IEBAIGludCBoZWxsbyh2b2lkKQogCQlnb3Rv +IHBoYWlsOwogCX0KIHNraXA6Ci0JaWYgKAlmb28gJiYKKwl1bmxlc3MgKGZvbykKIGJsYWgKIGJs +YWgKIGJsYWgKLS0gCkJqw7hybgo= + +----Next_Part(Mon_Sep_24_09_46_40_2018_110)---- diff --git a/t/dir_idle.t b/t/dir_idle.t index 19e54967..8d085d6e 100644 --- a/t/dir_idle.t +++ b/t/dir_idle.t @@ -1,7 +1,7 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use v5.10.1; use strict; use PublicInbox::TestCommon; +use v5.12; use PublicInbox::TestCommon; use PublicInbox::DS qw(now); use File::Path qw(make_path); use_ok 'PublicInbox::DirIdle'; @@ -11,26 +11,30 @@ my @x; my $cb = sub { push @x, \@_ }; my $di = PublicInbox::DirIdle->new($cb); $di->add_watches(["$tmpdir/a", "$tmpdir/c"], 1); -PublicInbox::DS->SetLoopTimeout(1000); +$PublicInbox::DS::loop_timeout = 1000; my $end = 3 + now; -PublicInbox::DS->SetPostLoopCallback(sub { scalar(@x) == 0 && now < $end }); -tick(0.011); +local @PublicInbox::DS::post_loop_do = (sub { scalar(@x) == 0 && now < $end }); rmdir("$tmpdir/a/b") or xbail "rmdir $!"; PublicInbox::DS::event_loop(); -is(scalar(@x), 1, 'got an event') and +if (is(scalar(@x), 1, 'got an rmdir event')) { is($x[0]->[0]->fullname, "$tmpdir/a/b", 'got expected fullname') and ok($x[0]->[0]->IN_DELETE, 'IN_DELETE set'); +} else { + check_broken_tmpfs; + xbail explain(\@x); +} -tick(0.011); rmdir("$tmpdir/a") or xbail "rmdir $!"; @x = (); $end = 3 + now; PublicInbox::DS::event_loop(); -is(scalar(@x), 1, 'got an event') and +if (is(scalar(@x), 1, 'got an event after rmdir')) { is($x[0]->[0]->fullname, "$tmpdir/a", 'got expected fullname') and ok($x[0]->[0]->IN_DELETE_SELF, 'IN_DELETE_SELF set'); - -tick(0.011); +} else { + check_broken_tmpfs; + diag explain(\@x); +} rename("$tmpdir/c", "$tmpdir/j") or xbail "rmdir $!"; @x = (); $end = 3 + now; @@ -40,5 +44,4 @@ is(scalar(@x), 1, 'got an event') and ok($x[0]->[0]->IN_DELETE_SELF || $x[0]->[0]->IN_MOVE_SELF, 'IN_DELETE_SELF set on move'); -PublicInbox::DS->Reset; done_testing; diff --git a/t/ds-kqxs.t b/t/ds-kqxs.t index 43c71fed..87f7199d 100644 --- a/t/ds-kqxs.t +++ b/t/ds-kqxs.t @@ -1,13 +1,14 @@ -# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # Licensed the same as Danga::Socket (and Perl5) # License: GPL-1.0+ or Artistic-1.0-Perl # <https://www.gnu.org/licenses/gpl-1.0.txt> # <https://dev.perl.org/licenses/artistic.html> -use strict; +use v5.12; use Test::More; unless (eval { require IO::KQueue }) { - my $m = $^O !~ /bsd/ ? 'DSKQXS is only for *BSD systems' - : "no IO::KQueue, skipping $0: $@"; + my $m = ($^O =~ /bsd/ || $^O eq 'dragonfly') ? + "no IO::KQueue, skipping $0: $@" : + 'DSKQXS is only for *BSD systems'; plan skip_all => $m; } diff --git a/t/ds-leak.t b/t/ds-leak.t index 4e8d76cd..f39985e0 100644 --- a/t/ds-leak.t +++ b/t/ds-leak.t @@ -1,9 +1,9 @@ -# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # Licensed the same as Danga::Socket (and Perl5) # License: GPL-1.0+ or Artistic-1.0-Perl # <https://www.gnu.org/licenses/gpl-1.0.txt> # <https://dev.perl.org/licenses/artistic.html> -use strict; use v5.10.1; use PublicInbox::TestCommon; +use v5.12; use PublicInbox::TestCommon; use_ok 'PublicInbox::DS'; if ('close-on-exec for epoll and kqueue') { @@ -11,8 +11,8 @@ if ('close-on-exec for epoll and kqueue') { my $pid; my $evfd_re = qr/(?:kqueue|eventpoll)/i; - PublicInbox::DS->SetLoopTimeout(0); - PublicInbox::DS->SetPostLoopCallback(sub { 0 }); + $PublicInbox::DS::loop_timeout = 0; + local @PublicInbox::DS::post_loop_do = (sub { 0 }); # make sure execve closes if we're using fork() my ($r, $w); @@ -29,11 +29,8 @@ if ('close-on-exec for epoll and kqueue') { is($l, undef, 'cloexec works and sleep(1) is running'); SKIP: { - my $lsof = require_cmd('lsof', 1) 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; + my @of = grep /$evfd_re/, lsof_pid $pid, $rdr; is_deeply(\@of, [], 'no FDs leaked to subprocess'); }; if (defined $pid) { @@ -54,8 +51,8 @@ SKIP: { } my $cb = sub {}; for my $i (0..$n) { - PublicInbox::DS->SetLoopTimeout(0); - PublicInbox::DS->SetPostLoopCallback($cb); + $PublicInbox::DS::loop_timeout = 0; + local @PublicInbox::DS::post_loop_do = ($cb); PublicInbox::DS::event_loop(); PublicInbox::DS->Reset; } diff --git a/t/ds-poll.t b/t/ds-poll.t index d8861369..22dbc802 100644 --- a/t/ds-poll.t +++ b/t/ds-poll.t @@ -1,50 +1,64 @@ -# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # Licensed the same as Danga::Socket (and Perl5) # License: GPL-1.0+ or Artistic-1.0-Perl # <https://www.gnu.org/licenses/gpl-1.0.txt> # <https://dev.perl.org/licenses/artistic.html> -use strict; -use warnings; +use v5.12; use Test::More; -use PublicInbox::Syscall qw(:epoll); +use PublicInbox::Syscall qw(EPOLLIN EPOLLOUT EPOLLONESHOT); +use autodie qw(close pipe syswrite); my $cls = $ENV{TEST_IOPOLLER} // 'PublicInbox::DSPoll'; use_ok $cls; my $p = $cls->new; my ($r, $w, $x, $y); -pipe($r, $w) or die; -pipe($x, $y) or die; -is($p->epoll_ctl(EPOLL_CTL_ADD, fileno($r), EPOLLIN), 0, 'add EPOLLIN'); +pipe($r, $w); +pipe($x, $y); +is($p->ep_add($r, EPOLLIN), 0, 'add EPOLLIN'); my $events = []; -$p->epoll_wait(9, 0, $events); +$p->ep_wait(0, $events); is_deeply($events, [], 'no events set'); -is($p->epoll_ctl(EPOLL_CTL_ADD, fileno($w), EPOLLOUT|EPOLLONESHOT), 0, - 'add EPOLLOUT|EPOLLONESHOT'); -$p->epoll_wait(9, -1, $events); +is($p->ep_add($w, EPOLLOUT|EPOLLONESHOT), 0, 'add EPOLLOUT|EPOLLONESHOT'); +$p->ep_wait(-1, $events); is(scalar(@$events), 1, 'got POLLOUT event'); is($events->[0], fileno($w), '$w ready'); -$p->epoll_wait(9, 0, $events); +$p->ep_wait(0, $events); is(scalar(@$events), 0, 'nothing ready after oneshot'); is_deeply($events, [], 'no events set after oneshot'); syswrite($w, '1') == 1 or die; for my $t (0..1) { - $p->epoll_wait(9, $t, $events); + $p->ep_wait($t, $events); is($events->[0], fileno($r), "level-trigger POLLIN ready #$t"); is(scalar(@$events), 1, "only event ready #$t"); } syswrite($y, '1') == 1 or die; -is($p->epoll_ctl(EPOLL_CTL_ADD, fileno($x), EPOLLIN|EPOLLONESHOT), 0, - 'EPOLLIN|EPOLLONESHOT add'); -$p->epoll_wait(9, -1, $events); +is($p->ep_add($x, EPOLLIN|EPOLLONESHOT), 0, 'EPOLLIN|EPOLLONESHOT add'); +$p->ep_wait(-1, $events); is(scalar @$events, 2, 'epoll_wait has 2 ready'); my @fds = sort @$events; my @exp = sort((fileno($r), fileno($x))); is_deeply(\@fds, \@exp, 'got both ready FDs'); -is($p->epoll_ctl(EPOLL_CTL_DEL, fileno($r), 0), 0, 'EPOLL_CTL_DEL OK'); -$p->epoll_wait(9, 0, $events); +is($p->ep_del($r, 0), 0, 'EPOLL_CTL_DEL OK'); +$p->ep_wait(0, $events); is(scalar @$events, 0, 'nothing ready after EPOLL_CTL_DEL'); +is($p->ep_add($r, EPOLLIN), 0, 're-add'); +SKIP: { + $cls =~ m!::(?:DSPoll|Select)\z! or + skip 'EBADF test for select|poll only', 1; + my $old_fd = fileno($r); + close $r; + my @w; + eval { + local $SIG{__WARN__} = sub { push @w, @_ }; + $p->ep_wait(0, $events); + }; + ok($@, 'error detected from bad FD'); + ok($!{EBADF}, 'EBADF errno set'); + @w and ok(grep(/\bFD=$old_fd invalid/, @w), 'carps invalid FD'); +} + done_testing; @@ -1,5 +1,5 @@ #!perl -w -# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> # edit frontend behavior test (t/replace.t for backend) use strict; @@ -24,10 +24,11 @@ local $ENV{PI_CONFIG} = $cfgfile; my ($in, $out, $err, $cmd, $cur, $t); my $git = PublicInbox::Git->new("$ibx->{inboxdir}/git/0.git"); my $opt = { 0 => \$in, 1 => \$out, 2 => \$err }; +my $ipe = "$^X -w -i -p -e"; $t = '-F FILE'; { $in = $out = $err = ''; - local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/boolean prefix/bool pfx/'"; + local $ENV{MAIL_EDITOR} = "$ipe 's/boolean prefix/bool pfx/'"; $cmd = [ '-edit', "-F$file", $inboxdir ]; ok(run_script($cmd, undef, $opt), "$t edit OK"); $cur = PublicInbox::Eml->new($ibx->msg_by_mid($mid)); @@ -37,7 +38,7 @@ $t = '-F FILE'; { $t = '-m MESSAGE_ID'; { $in = $out = $err = ''; - local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/bool pfx/boolean prefix/'"; + local $ENV{MAIL_EDITOR} = "$ipe 's/bool pfx/boolean prefix/'"; $cmd = [ '-edit', "-m$mid", $inboxdir ]; ok(run_script($cmd, undef, $opt), "$t edit OK"); $cur = PublicInbox::Eml->new($ibx->msg_by_mid($mid)); @@ -48,7 +49,7 @@ $t = '-m MESSAGE_ID'; { $t = 'no-op -m MESSAGE_ID'; { $in = $out = $err = ''; my $before = $git->qx(qw(rev-parse HEAD)); - local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/bool pfx/boolean prefix/'"; + local $ENV{MAIL_EDITOR} = "$ipe 's/bool pfx/boolean prefix/'"; $cmd = [ '-edit', "-m$mid", $inboxdir ]; ok(run_script($cmd, undef, $opt), "$t succeeds"); my $prev = $cur; @@ -64,7 +65,7 @@ $t = 'no-op -m MESSAGE_ID'; { $t = 'no-op -m MESSAGE_ID w/Status: header'; { # because mutt does it $in = $out = $err = ''; my $before = $git->qx(qw(rev-parse HEAD)); - local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/^Subject:.*/Status: RO\\n\$&/'"; + local $ENV{MAIL_EDITOR} = "$ipe 's/^Subject:.*/Status: RO\\n\$&/'"; $cmd = [ '-edit', "-m$mid", $inboxdir ]; ok(run_script($cmd, undef, $opt), "$t succeeds"); my $prev = $cur; @@ -80,7 +81,7 @@ $t = 'no-op -m MESSAGE_ID w/Status: header'; { # because mutt does it $t = '-m MESSAGE_ID can change Received: headers'; { $in = $out = $err = ''; - local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/^Subject:.*/Received: x\\n\$&/'"; + local $ENV{MAIL_EDITOR} = "$ipe 's/^Subject:.*/Received: x\\n\$&/'"; $cmd = [ '-edit', "-m$mid", $inboxdir ]; ok(run_script($cmd, undef, $opt), "$t succeeds"); $cur = PublicInbox::Eml->new($ibx->msg_by_mid($mid)); @@ -91,7 +92,7 @@ $t = '-m MESSAGE_ID can change Received: headers'; { $t = '-m miss'; { $in = $out = $err = ''; - local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/boolean/FAIL/'"; + local $ENV{MAIL_EDITOR} = "$ipe 's/boolean/FAIL/'"; $cmd = [ '-edit', "-m$mid-miss", $inboxdir ]; ok(!run_script($cmd, undef, $opt), "$t fails on invalid MID"); like($err, qr/No message found/, "$t shows error"); @@ -99,7 +100,7 @@ $t = '-m miss'; { $t = 'non-interactive editor failure'; { $in = $out = $err = ''; - local $ENV{MAIL_EDITOR} = "$^X -i -p -e 'END { exit 1 }'"; + local $ENV{MAIL_EDITOR} = "$ipe 'END { exit 1 }'"; $cmd = [ '-edit', "-m$mid", $inboxdir ]; ok(!run_script($cmd, undef, $opt), "$t detected"); like($err, qr/END \{ exit 1 \}' failed:/, "$t shows error"); @@ -109,7 +110,7 @@ $t = 'mailEditor set in config'; { $in = $out = $err = ''; my $rc = xsys(qw(git config), "--file=$cfgfile", 'publicinbox.maileditor', - "$^X -i -p -e 's/boolean prefix/bool pfx/'"); + "$ipe 's/boolean prefix/bool pfx/'"); is($rc, 0, 'set publicinbox.mailEditor'); local $ENV{MAIL_EDITOR}; delete $ENV{MAIL_EDITOR}; @@ -123,20 +124,20 @@ $t = 'mailEditor set in config'; { $t = '--raw and mbox escaping'; { $in = $out = $err = ''; - local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/^\$/\\nFrom not mbox\\n/'"; + local $ENV{MAIL_EDITOR} = "$ipe 's/^\$/\\nFrom not mbox\\n/'"; $cmd = [ '-edit', "-m$mid", '--raw', $inboxdir ]; ok(run_script($cmd, undef, $opt), "$t succeeds"); $cur = PublicInbox::Eml->new($ibx->msg_by_mid($mid)); like($cur->body, qr/^From not mbox/sm, 'put "From " line into body'); - local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/^>From not/\$& an/'"; + local $ENV{MAIL_EDITOR} = "$ipe 's/^>From not/\$& an/'"; $cmd = [ '-edit', "-m$mid", $inboxdir ]; ok(run_script($cmd, undef, $opt), "$t succeeds with mbox escaping"); $cur = PublicInbox::Eml->new($ibx->msg_by_mid($mid)); like($cur->body, qr/^From not an mbox/sm, 'changed "From " line unescaped'); - local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/^From not an mbox\\n//s'"; + local $ENV{MAIL_EDITOR} = "$ipe 's/^From not an mbox\\n//s'"; $cmd = [ '-edit', "-m$mid", '--raw', $inboxdir ]; ok(run_script($cmd, undef, $opt), "$t succeeds again"); $cur = PublicInbox::Eml->new($ibx->msg_by_mid($mid)); @@ -154,7 +155,7 @@ $t = 'reuse Message-ID'; { $t = 'edit ambiguous Message-ID with -m'; { $in = $out = $err = ''; - local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/bool pfx/boolean prefix/'"; + local $ENV{MAIL_EDITOR} = "$ipe 's/bool pfx/boolean prefix/'"; $cmd = [ '-edit', "-m$mid", $inboxdir ]; ok(!run_script($cmd, undef, $opt), "$t fails w/o --force"); like($err, qr/Multiple messages with different content found matching/, @@ -164,7 +165,7 @@ $t = 'edit ambiguous Message-ID with -m'; { $t .= ' and --force'; { $in = $out = $err = ''; - local $ENV{MAIL_EDITOR} = "$^X -i -p -e 's/^Subject:.*/Subject:x/i'"; + local $ENV{MAIL_EDITOR} = "$ipe 's/^Subject:.*/Subject:x/i'"; $cmd = [ '-edit', "-m$mid", '--force', $inboxdir ]; ok(run_script($cmd, undef, $opt), "$t succeeds"); like($err, qr/Will edit all of them/, "$t notes all will be edited"); @@ -1,8 +1,8 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use v5.10.1; # TODO: check unicode_strings w/ 5.12 use strict; -use Test::More; use PublicInbox::TestCommon; use PublicInbox::MsgIter qw(msg_part_text); my @classes = qw(PublicInbox::Eml); @@ -355,7 +355,7 @@ if ('maxparts is a feature unique to us') { } SKIP: { - require_mods('PublicInbox::MIME', 1); + require_mods('Email::MIME', 1); my $eml = eml_load 't/utf8.eml'; my $mime = mime_load 't/utf8.eml'; for my $h (qw(Subject From To)) { @@ -1,25 +1,22 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use v5.10.1; +use v5.12; use Test::More; -use PublicInbox::Syscall qw(:epoll); +use autodie; +use PublicInbox::Syscall qw(EPOLLOUT); plan skip_all => 'not Linux' if $^O ne 'linux'; -my $epfd = epoll_create(); -ok($epfd >= 0, 'epoll_create'); -open(my $hnd, '+<&=', $epfd); # for autoclose - -pipe(my ($r, $w)) or die "pipe: $!"; -is(epoll_ctl($epfd, EPOLL_CTL_ADD, fileno($w), EPOLLOUT), 0, - 'epoll_ctl socket EPOLLOUT'); +require_ok 'PublicInbox::Epoll'; +my $ep = PublicInbox::Epoll->new; +pipe(my $r, my $w); +is($ep->ep_add($w, EPOLLOUT), 0, 'epoll_ctl pipe EPOLLOUT'); my @events; -epoll_wait($epfd, 100, 10000, \@events); +$ep->ep_wait(10000, \@events); is(scalar(@events), 1, 'got one event'); is($events[0], fileno($w), 'got expected FD'); close $w; -epoll_wait($epfd, 100, 0, \@events); +$ep->ep_wait(0, \@events); is(scalar(@events), 0, 'epoll_wait timeout'); done_testing; diff --git a/t/extindex-psgi.t b/t/extindex-psgi.t index 98dc2e48..896c46ff 100644 --- a/t/extindex-psgi.t +++ b/t/extindex-psgi.t @@ -1,5 +1,5 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; @@ -8,7 +8,7 @@ use PublicInbox::Config; use File::Copy qw(cp); use IO::Handle (); require_git(2.6); -require_mods(qw(json DBD::SQLite Search::Xapian +require_mods(qw(json DBD::SQLite Xapian HTTP::Request::Common Plack::Test URI::Escape Plack::Builder)); use_ok($_) for (qw(HTTP::Request::Common Plack::Test)); use IO::Uncompress::Gunzip qw(gunzip); @@ -21,7 +21,28 @@ mkdir "$home/.public-inbox" or BAIL_OUT $!; my $pi_config = "$home/.public-inbox/config"; cp($cfg_path, $pi_config) or BAIL_OUT; my $env = { HOME => $home }; -run_script([qw(-extindex --all), "$tmpdir/eidx"], $env) or BAIL_OUT; +my $m2t = create_inbox 'mid2tid', version => 2, indexlevel => 'basic', sub { + my ($im, $ibx) = @_; + for my $n (1..3) { + $im->add(PublicInbox::Eml->new(<<EOM)) or xbail 'add'; +Date: Fri, 02 Oct 1993 00:0$n:00 +0000 +Message-ID: <t\@$n> +Subject: tid $n +From: x\@example.com +References: <a-mid\@b> + +$n +EOM + $im->add(PublicInbox::Eml->new(<<EOM)) or xbail 'add'; +Date: Fri, 02 Oct 1993 00:0$n:00 +0000 +Message-ID: <ut\@$n> +Subject: unrelated tid $n +From: x\@example.com +References: <b-mid\@b> + +EOM + } +}; { open my $cfgfh, '>>', $pi_config or BAIL_OUT; $cfgfh->autoflush(1); @@ -32,8 +53,14 @@ run_script([qw(-extindex --all), "$tmpdir/eidx"], $env) or BAIL_OUT; [publicinbox] wwwlisting = all grokManifest = all +[publicinbox "m2t"] + inboxdir = $m2t->{inboxdir} + address = $m2t->{-primary_address} EOM + close $cfgfh or xbail "close: $!"; } + +run_script([qw(-extindex --all), "$tmpdir/eidx"], $env) or BAIL_OUT; my $www = PublicInbox::WWW->new(PublicInbox::Config->new($pi_config)); my $client = sub { my ($cb) = @_; @@ -83,6 +110,22 @@ my $client = sub { 't2 manifest'); is_deeply([ sort keys %{$m->{'/t1'}} ], [ '/t1' ], 't2 manifest'); + + # ensure ibx->{isrch}->{es}->over is used instead of ibx->over: + $res = $cb->(POST("/m2t/t\@1/?q=dt:19931002000259..&x=m")); + is($res->code, 200, 'hit on mid2tid query'); + $res = $cb->(POST("/m2t/t\@1/?q=dt:19931002000400..&x=m")); + is($res->code, 404, '404 on out-of-range mid2tid query'); + $res = $cb->(POST("/m2t/t\@1/?q=s:unrelated&x=m")); + is($res->code, 404, '404 on cross-thread search'); + + + for my $c (qw(new active)) { + $res = $cb->(GET("/m2t/topics_$c.html")); + is($res->code, 200, "topics_$c.html on basic v2"); + $res = $cb->(GET("/all/topics_$c.html")); + is($res->code, 200, "topics_$c.html on extindex"); + } }; test_psgi(sub { $www->call(@_) }, $client); %$env = (%$env, TMPDIR => $tmpdir, PI_CONFIG => $pi_config); diff --git a/t/extsearch.t b/t/extsearch.t index 2d7375d6..797aa8f5 100644 --- a/t/extsearch.t +++ b/t/extsearch.t @@ -1,30 +1,25 @@ #!perl -w # Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use Test::More; +use v5.12; use PublicInbox::TestCommon; use PublicInbox::Config; use PublicInbox::InboxWritable; -use Fcntl qw(:seek); require_git(2.6); -require_mods(qw(json DBD::SQLite Search::Xapian)); +require_mods(qw(json DBD::SQLite Xapian)); +use autodie qw(open rename truncate unlink); require PublicInbox::Search; use_ok 'PublicInbox::ExtSearch'; use_ok 'PublicInbox::ExtSearchIdx'; use_ok 'PublicInbox::OverIdx'; -my $sock = tcp_server(); -my $host_port = tcp_host_port($sock); my ($home, $for_destroy) = tmpdir(); local $ENV{HOME} = $home; mkdir "$home/.public-inbox" or BAIL_OUT $!; my $cfg_path = "$home/.public-inbox/config"; -open my $fh, '>', $cfg_path or BAIL_OUT $!; -print $fh <<EOF or BAIL_OUT $!; +PublicInbox::IO::write_file '>', $cfg_path, <<EOF; [publicinboxMda] spamcheck = none EOF -close $fh or BAIL_OUT $!; my $v2addr = 'v2test@example.com'; my $v1addr = 'v1test@example.com'; ok(run_script([qw(-init -Lbasic -V2 v2test --newsgroup v2.example), @@ -33,24 +28,18 @@ my $env = { ORIGINAL_RECIPIENT => $v2addr }; my $eml = eml_load('t/utf8.eml'); $eml->header_set('List-Id', '<v2.example.com>'); -open($fh, '+>', undef) or BAIL_OUT $!; -$fh->autoflush(1); -print $fh $eml->as_string or BAIL_OUT $!; -seek($fh, 0, SEEK_SET) or BAIL_OUT $!; -run_script(['-mda', '--no-precheck'], $env, { 0 => $fh }) or BAIL_OUT '-mda'; +my $in = \($eml->as_string); +run_script(['-mda', '--no-precheck'], $env, { 0 => $in }) or BAIL_OUT '-mda'; ok(run_script([qw(-init -V1 v1test --newsgroup v1.example), "$home/v1test", 'http://example.com/v1test', $v1addr ]), 'v1test init'); $eml->header_set('List-Id', '<v1.example.com>'); -seek($fh, 0, SEEK_SET) or BAIL_OUT $!; -truncate($fh, 0) or BAIL_OUT $!; -print $fh $eml->as_string or BAIL_OUT $!; -seek($fh, 0, SEEK_SET) or BAIL_OUT $!; +$in = \$eml->as_string; $env = { ORIGINAL_RECIPIENT => $v1addr }; -run_script(['-mda', '--no-precheck'], $env, { 0 => $fh }) or BAIL_OUT '-mda'; +run_script(['-mda', '--no-precheck'], $env, { 0 => $in }) or BAIL_OUT '-mda'; run_script([qw(-index -Lbasic), "$home/v1test"]) or BAIL_OUT "index $?"; @@ -106,14 +95,11 @@ if ('with boost') { } { # TODO: -extindex should write this to config - open $fh, '>>', $cfg_path or BAIL_OUT $!; - print $fh <<EOF or BAIL_OUT $!; + PublicInbox::IO::write_file '>>', $cfg_path, <<EOF; ; for ->ALL [extindex "all"] topdir = $home/extindex EOF - close $fh or BAIL_OUT $!; - my $pi_cfg = PublicInbox::Config->new; $pi_cfg->fill_all; ok($pi_cfg->ALL, '->ALL'); @@ -125,6 +111,8 @@ EOF SKIP: { require_mods(qw(Net::NNTP), 1); + my $sock = tcp_server(); + my $host_port = tcp_host_port($sock); my ($out, $err) = ("$home/nntpd.out.log", "$home/nntpd.err.log"); my $cmd = [ '-nntpd', '-W0', "--stdout=$out", "--stderr=$err" ]; my $td = start_script($cmd, undef, { 3 => $sock }); @@ -152,7 +140,7 @@ if ('inbox edited') { my ($in, $out, $err); $in = $out = $err = ''; my $opt = { 0 => \$in, 1 => \$out, 2 => \$err }; - my $env = { MAIL_EDITOR => "$^X -i -p -e 's/test message/BEST MSG/'" }; + my $env = { MAIL_EDITOR => "$^X -w -i -p -e 's/test message/BEST MSG/'" }; my $cmd = [ qw(-edit -Ft/utf8.eml), "$home/v2test" ]; ok(run_script($cmd, $env, $opt), '-edit'); ok(run_script([qw(-extindex --all), "$home/extindex"], undef, $opt), @@ -203,11 +191,7 @@ if ('inbox edited') { is_deeply($res, $exp, 'isearch limited results'); $pi_cfg = $res = $exp = undef; - open my $rmfh, '+>', undef or BAIL_OUT $!; - $rmfh->autoflush(1); - print $rmfh $eml2->as_string or BAIL_OUT $!; - seek($rmfh, 0, SEEK_SET) or BAIL_OUT $!; - $opt->{0} = $rmfh; + $opt->{0} = \($eml2->as_string); ok(run_script([qw(-learn rm --all)], undef, $opt), '-learn rm'); ok(run_script([qw(-extindex --all), "$home/extindex"], undef, undef), @@ -246,13 +230,11 @@ if ('inject w/o indexing') { isnt($tip, $cmt, '0.git v2 updated'); # inject a message w/o updating index - rename("$home/v1test/public-inbox", "$home/v1test/skip-index") or - BAIL_OUT $!; - open(my $eh, '<', 't/iso-2202-jp.eml') or BAIL_OUT $!; + rename("$home/v1test/public-inbox", "$home/v1test/skip-index"); + open(my $eh, '<', 't/iso-2202-jp.eml'); run_script(['-mda', '--no-precheck'], $env, { 0 => $eh}) or BAIL_OUT '-mda'; - rename("$home/v1test/skip-index", "$home/v1test/public-inbox") or - BAIL_OUT $!; + rename("$home/v1test/skip-index", "$home/v1test/public-inbox"); my ($in, $out, $err); $in = $out = $err = ''; @@ -309,7 +291,7 @@ if ('reindex catches missed messages') { is($oidx->eidx_meta($lc_key), $cmt_b, 'lc-v2 stays unchanged'); my @err = split(/^/, $err); is(scalar(@err), 1, 'only one warning') or diag "err=$err"; - like($err[0], qr/I: reindex_unseen/, 'got reindex_unseen message'); + like($err[0], qr/# reindex_unseen/, 'got reindex_unseen message'); my $new = $oidx->get_art($max + 1); is($new->{subject}, $eml->header('Subject'), 'new message added'); @@ -415,8 +397,8 @@ if ('remove v1test and test gc') { my $opt = { 2 => \(my $err = '') }; ok(run_script([qw(-extindex --gc), "$home/extindex"], undef, $opt), 'extindex --gc'); - like($err, qr/^I: remove #1 v1\.example /ms, 'removed v1 message'); - is(scalar(grep(!/^I:/, split(/^/m, $err))), 0, + like($err, qr/^# remove #1 v1\.example /ms, 'removed v1 message'); + is(scalar(grep(!/^#/, split(/^/m, $err))), 0, 'no non-informational messages'); $misc->{xdb}->reopen; @it = $misc->mset('')->items; @@ -481,7 +463,7 @@ SKIP: { for my $i (2..3) { is(grep(m!/ei[0-9]+/$i\z!, @dirs), 0, "no shard [$i]"); } - skip 'xapian-compact missing', 4 unless have_xapian_compact; + have_xapian_compact 1; ok(run_script([qw(-compact), $d], undef, $o), 'compact'); # n.b. stderr contains xapian-compact output @@ -501,10 +483,8 @@ SKIP: { "$home/v2tmp", 'http://example.com/v2tmp', $tmp_addr ]) or xbail '-init'; $env = { ORIGINAL_RECIPIENT => $tmp_addr }; - open $fh, '+>', undef or xbail "open $!"; - $fh->autoflush(1); my $mid = 'tmpmsg@example.com'; - print $fh <<EOM or xbail "print $!"; + my $in = \<<EOM; From: b\@z To: b\@r Message-Id: <$mid> @@ -512,8 +492,7 @@ Subject: tmpmsg Date: Tue, 19 Jan 2038 03:14:07 +0000 EOM - seek $fh, 0, SEEK_SET or xbail "seek $!"; - run_script([qw(-mda --no-precheck)], $env, {0 => $fh}) or xbail '-mda'; + run_script([qw(-mda --no-precheck)], $env, {0 => $in}) or xbail '-mda'; ok(run_script([qw(-extindex --all), "$home/extindex"]), 'update'); my $nr; { @@ -526,7 +505,7 @@ EOM $mset = $es->search->mset('z:0..'); $nr = $mset->size; } - truncate($cfg_path, $old_size) or xbail "truncate $!"; + truncate($cfg_path, $old_size); my $rdr = { 2 => \(my $err) }; ok(run_script([qw(-extindex --gc), "$home/extindex"], undef, $rdr), 'gc to get rid of removed inbox'); @@ -554,4 +533,64 @@ EOM is_deeply($x, $o, 'xref3 and over docids match'); } +{ + my $d = "$home/eidx-med"; + ok(run_script([qw(-extindex --dangerous --all -L medium -j3), $d]), + 'extindex medium init'); + my $es = PublicInbox::ExtSearch->new($d); + is($es->xdb->get_metadata('indexlevel'), 'medium', + 'es indexlevel before'); + my @xdb = $es->xdb_shards_flat; + is($xdb[0]->get_metadata('indexlevel'), 'medium', + '0 indexlevel before'); + shift @xdb; + for (@xdb) { + ok(!$_->get_metadata('indexlevel'), 'no indexlevel in >0 shard') + } + is($es->xdb->get_metadata('indexlevel'), 'medium', 'indexlevel before'); + ok(run_script([qw(-xcpdb -R5), $d]), 'xcpdb R5'); + $es = PublicInbox::ExtSearch->new($d); + is($es->xdb->get_metadata('indexlevel'), 'medium', + '0 indexlevel after'); + @xdb = $es->xdb_shards_flat; + is(scalar(@xdb), 5, 'got 5 shards'); + is($xdb[0]->get_metadata('indexlevel'), 'medium', '0 indexlevel after'); + shift @xdb; + for (@xdb) { + ok(!$_->get_metadata('indexlevel'), 'no indexlevel in >0 shard') + } + my $mpi = "$d/ALL.git/objects/pack/multi-pack-index"; + SKIP: { + skip 'git too old for for multi-pack-index', 2 if !-f $mpi; + unlink glob("$d/ALL.git/objects/pack/*"); + ok run_script([qw(-extindex --all -L medium -j3 + --no-multi-pack-index), $d]), + 'test --no-multi-pack-index'; + ok !-f $mpi, '--no-multi-pack-index respected'; + } +} + +test_lei(sub { + my $d = "$home/extindex"; + lei_ok('convert', '-o', "$home/md1", $d); + lei_ok('convert', '-o', "$home/md2", "extindex:$d"); + my $dst = []; + my $cb = sub { push @$dst, $_[2]->as_string }; + require PublicInbox::MdirReader; + PublicInbox::MdirReader->new->maildir_each_eml("$home/md1", $cb); + my @md1 = sort { $a cmp $b } @$dst; + ok(scalar(@md1), 'dumped messages to md1'); + $dst = []; + PublicInbox::MdirReader->new->maildir_each_eml("$home/md2", $cb); + @$dst = sort { $a cmp $b } @$dst; + is_deeply($dst, \@md1, + "convert from extindex w/ or w/o `extindex' prefix"); + + my @o = glob "$home/extindex/ei*/over.sqlite*"; + unlink(@o); + ok(!lei('convert', '-o', "$home/fail", "extindex:$d")); + like($lei_err, qr/unindexed .*?not supported/, + 'noted unindexed extindex is unsupported'); +}); + done_testing; diff --git a/t/fake_inotify.t b/t/fake_inotify.t index 734ddbfb..8221e092 100644 --- a/t/fake_inotify.t +++ b/t/fake_inotify.t @@ -1,13 +1,12 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> # # Ensure FakeInotify can pick up rename(2) and link(2) operations # used by Maildir writing tools -use strict; +use v5.12; use PublicInbox::TestCommon; use_ok 'PublicInbox::FakeInotify'; -my $MIN_FS_TICK = 0.011; # for low-res CONFIG_HZ=100 systems my ($tmpdir, $for_destroy) = tmpdir(); mkdir "$tmpdir/new" or BAIL_OUT "mkdir: $!"; mkdir "$tmpdir/new/rmd" or BAIL_OUT "mkdir: $!"; @@ -18,37 +17,35 @@ my $fi = PublicInbox::FakeInotify->new; my $mask = PublicInbox::FakeInotify::MOVED_TO_OR_CREATE(); my $w = $fi->watch("$tmpdir/new", $mask); -tick $MIN_FS_TICK; rename("$tmpdir/tst", "$tmpdir/new/tst") or BAIL_OUT "rename: $!"; my @events = map { $_->fullname } $fi->read; -is_deeply(\@events, ["$tmpdir/new/tst"], 'rename(2) detected'); +is_deeply(\@events, ["$tmpdir/new/tst"], 'rename(2) detected') or + diag explain(\@events); -tick $MIN_FS_TICK; open $fh, '>', "$tmpdir/tst" or BAIL_OUT "open: $!"; close $fh or BAIL_OUT "close: $!"; link("$tmpdir/tst", "$tmpdir/new/link") or BAIL_OUT "link: $!"; @events = map { $_->fullname } $fi->read; -is_deeply(\@events, ["$tmpdir/new/link"], 'link(2) detected'); +is_deeply(\@events, ["$tmpdir/new/link"], 'link(2) detected') or + diag explain(\@events); $w->cancel; -tick $MIN_FS_TICK; link("$tmpdir/new/tst", "$tmpdir/new/link2") or BAIL_OUT "link: $!"; @events = map { $_->fullname } $fi->read; -is_deeply(\@events, [], 'link(2) not detected after cancel'); +is_deeply(\@events, [], 'link(2) not detected after cancel') or + diag explain(\@events); $fi->watch("$tmpdir/new", PublicInbox::FakeInotify::IN_DELETE()); -tick $MIN_FS_TICK; rmdir("$tmpdir/new/rmd") or xbail "rmdir: $!"; @events = $fi->read; -is_deeply([map{ $_->fullname }@events], ["$tmpdir/new/rmd"], 'rmdir detected'); -ok($events[0]->IN_DELETE, 'IN_DELETE set on rmdir'); +is_deeply([map{ $_->fullname }@events], ["$tmpdir/new/rmd"], 'rmdir detected') or + diag explain(\@events); +ok($events[-1]->IN_DELETE, 'IN_DELETE set on rmdir'); -tick $MIN_FS_TICK; unlink("$tmpdir/new/tst") or xbail "unlink: $!"; @events = grep { ref =~ /Gone/ } $fi->read; -is_deeply([map{ $_->fullname }@events], ["$tmpdir/new/tst"], 'unlink detected'); +is_deeply([map{ $_->fullname }@events], ["$tmpdir/new/tst"], 'unlink detected') or + diag explain(\@events); ok($events[0]->IN_DELETE, 'IN_DELETE set on unlink'); -PublicInbox::DS->Reset; - done_testing; diff --git a/t/filter_rubylang.t b/t/filter_rubylang.t index 4e9695e1..490a2154 100644 --- a/t/filter_rubylang.t +++ b/t/filter_rubylang.t @@ -1,8 +1,7 @@ -# Copyright (C) 2017-2021 all contributors <meta@public-inbox.org> +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use warnings; -use Test::More; +use v5.12; use PublicInbox::Eml; use PublicInbox::TestCommon; use_ok 'PublicInbox::Filter::RubyLang'; @@ -56,6 +55,15 @@ EOF $mime = PublicInbox::Eml->new($msg); $ret = $f->delivery($mime); is($ret, 100, "delivery rejected without X-Mail-Count"); + + $mime = PublicInbox::Eml->new(<<'EOM'); +Message-ID: <new@host> +Subject: [ruby-core:13] times + +EOM + $ret = $f->delivery($mime); + is($ret, $mime, "delivery successful"); + is($mm->num_for('new@host'), 13, 'MM entry created based on Subject'); } done_testing(); @@ -10,6 +10,7 @@ use POSIX qw(_exit); use Cwd qw(abs_path); require_mods('PublicInbox::Gcf2'); use_ok 'PublicInbox::Gcf2'; +use PublicInbox::Syscall qw($F_SETPIPE_SZ); use PublicInbox::Import; my ($tmpdir, $for_destroy) = tmpdir(); @@ -109,7 +110,7 @@ SKIP: { for my $blk (1, 0) { my ($r, $w); pipe($r, $w) or BAIL_OUT $!; - fcntl($w, 1031, 4096) or + fcntl($w, $F_SETPIPE_SZ, 4096) or skip('Linux too old for F_SETPIPE_SZ', 14); $w->blocking($blk); seek($fh, 0, SEEK_SET) or BAIL_OUT "seek: $!"; @@ -129,7 +130,7 @@ SKIP: { $ck_copying->("pipe blocking($blk)"); pipe($r, $w) or BAIL_OUT $!; - fcntl($w, 1031, 4096) or BAIL_OUT $!; + fcntl($w, $F_SETPIPE_SZ, 4096) or BAIL_OUT $!; $w->blocking($blk); close $r; local $SIG{PIPE} = 'IGNORE'; diff --git a/t/gcf2_client.t b/t/gcf2_client.t index 6d059cad..33ee2c91 100644 --- a/t/gcf2_client.t +++ b/t/gcf2_client.t @@ -1,10 +1,10 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; +use v5.12; use PublicInbox::TestCommon; -use Test::More; use Cwd qw(getcwd); +use autodie qw(open close); use PublicInbox::Import; use PublicInbox::DS; @@ -17,7 +17,7 @@ PublicInbox::Import::init_bare($git_a); PublicInbox::Import::init_bare($git_b); my $fi_data = './t/git.fast-import-data'; my $rdr = {}; -open $rdr->{0}, '<', $fi_data or BAIL_OUT $!; +open $rdr->{0}, '<', $fi_data; xsys([qw(git fast-import --quiet)], { GIT_DIR => $git_a }, $rdr); is($?, 0, 'fast-import succeeded'); @@ -26,9 +26,9 @@ my $called = 0; my $err_f = "$tmpdir/err"; { PublicInbox::DS->Reset; - open my $err, '>>', $err_f or BAIL_OUT $!; + open my $err, '>>', $err_f; my $gcf2c = PublicInbox::Gcf2Client::new({ 2 => $err }); - $gcf2c->gcf2_async(\"$tree $git_a\n", sub { + $gcf2c->gcf2_async("$tree $git_a\n", sub { my ($bref, $oid, $type, $size, $arg) = @_; is($oid, $tree, 'got expected OID'); is($size, 30, 'got expected length'); @@ -39,12 +39,12 @@ my $err_f = "$tmpdir/err"; }, 'hi'); $gcf2c->cat_async_step($gcf2c->{inflight}); - open $err, '<', $err_f or BAIL_OUT $!; + open $err, '<', $err_f; my $estr = do { local $/; <$err> }; is($estr, '', 'nothing in stderr'); my $trunc = substr($tree, 0, 39); - $gcf2c->gcf2_async(\"$trunc $git_a\n", sub { + $gcf2c->gcf2_async("$trunc $git_a\n", sub { my ($bref, $oid, $type, $size, $arg) = @_; is(undef, $bref, 'missing bref is undef'); is($oid, $trunc, 'truncated OID printed'); @@ -55,30 +55,30 @@ my $err_f = "$tmpdir/err"; }, 'bye'); $gcf2c->cat_async_step($gcf2c->{inflight}); - open $err, '<', $err_f or BAIL_OUT $!; + open $err, '<', $err_f; $estr = do { local $/; <$err> }; like($estr, qr/retrying/, 'warned about retry'); # try failed alternates lookup PublicInbox::DS->Reset; - open $err, '>', $err_f or BAIL_OUT $!; + open $err, '>', $err_f; $gcf2c = PublicInbox::Gcf2Client::new({ 2 => $err }); - $gcf2c->gcf2_async(\"$tree $git_b\n", sub { + $gcf2c->gcf2_async("$tree $git_b\n", sub { my ($bref, $oid, $type, $size, $arg) = @_; is(undef, $bref, 'missing bref from alt is undef'); $called++; }); $gcf2c->cat_async_step($gcf2c->{inflight}); - open $err, '<', $err_f or BAIL_OUT $!; + open $err, '<', $err_f; $estr = do { local $/; <$err> }; like($estr, qr/retrying/, 'warned about retry before alt update'); # now try successful alternates lookup - open my $alt, '>>', "$git_b/objects/info/alternates" or BAIL_OUT $!; - print $alt "$git_a/objects\n" or BAIL_OUT $!; - close $alt or BAIL_OUT; + open my $alt, '>>', "$git_b/objects/info/alternates"; + print $alt "$git_a/objects\n"; + close $alt; my $expect = xqx(['git', "--git-dir=$git_a", qw(cat-file tree), $tree]); - $gcf2c->gcf2_async(\"$tree $git_a\n", sub { + $gcf2c->gcf2_async("$tree $git_a\n", sub { my ($bref, $oid, $type, $size, $arg) = @_; is($oid, $tree, 'oid match on alternates retry'); is($$bref, $expect, 'tree content matched'); @@ -1,12 +1,14 @@ -# Copyright (C) 2015-2021 all contributors <meta@public-inbox.org> +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use Test::More; +use v5.12; use PublicInbox::TestCommon; my ($dir, $for_destroy) = tmpdir(); use PublicInbox::Import; use POSIX qw(strftime); use PublicInbox::Git; +is(PublicInbox::Git::MAX_INFLIGHT, + int(PublicInbox::Git::MAX_INFLIGHT), 'MAX_INFLIGHT is an integer'); { PublicInbox::Import::init_bare($dir, 'master'); @@ -44,7 +46,7 @@ use PublicInbox::Git; my $f = 'HEAD:foo.txt'; my @x = $gcf->check($f); is(scalar @x, 3, 'returned 3 element array for existing file'); - like($x[0], qr/\A[a-f0-9]{40}\z/, 'returns obj ID in 1st element'); + like($x[0], qr/\A[a-f0-9]{40,64}\z/, 'returns obj ID in 1st element'); is('blob', $x[1], 'returns obj type in 2nd element'); like($x[2], qr/\A\d+\z/, 'returns obj size in 3rd element'); @@ -134,7 +136,7 @@ if (1) { } SKIP: { - require_git(2.6, 7) or skip('need git 2.6+ for --batch-all-objects', 7); + require_git(2.6, 7); my ($alt, $alt_obj) = tmpdir(); my $hash_obj = [ 'git', "--git-dir=$alt", qw(hash-object -w --stdin) ]; PublicInbox::Import::init_bare($alt); @@ -202,4 +204,5 @@ is(git_quote($s = "hello\nworld"), '"hello\\nworld"', 'quoted LF'); is(git_quote($s = "hello\x06world"), '"hello\\006world"', 'quoted \\x06'); is(git_unquote($s = '"hello\\006world"'), "hello\x06world", 'unquoted \\x06'); -done_testing(); +diag 'git_version='.sprintf('%vd', PublicInbox::Git::git_version()); +done_testing; diff --git a/t/gzip_filter.t b/t/gzip_filter.t index b349ae58..97eac2d0 100644 --- a/t/gzip_filter.t +++ b/t/gzip_filter.t @@ -1,7 +1,7 @@ -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use Test::More; +use v5.12; use IO::Handle (); # autoflush use Fcntl qw(SEEK_SET); use PublicInbox::TestCommon; @@ -31,7 +31,7 @@ require_ok 'PublicInbox::GzipFilter'; open my $fh, '<', 'COPYING' or die "open(COPYING): $!"; my $buf = do { local $/; <$fh> }; while ($filter->write($buf .= rand)) {} - ok($sigpipe, 'got SIGPIPE'); + ok($sigpipe, 'got SIGPIPE') or diag "\$!=$!"; close $w; } done_testing; @@ -1,5 +1,5 @@ #!/usr/bin/perl -w -# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use PublicInbox::TestCommon; use IO::Handle; # ->autoflush use Fcntl qw(:seek); @@ -11,7 +11,7 @@ is($hls->_shebang2lang(\"#!/usr/bin/perl -w\n"), 'perl', 'perl shebang OK'); is($hls->{-ext2lang}->{'pm'}, 'perl', '.pm suffix OK'); is($hls->{-ext2lang}->{'pl'}, 'perl', '.pl suffix OK'); like($hls->_path2lang('Makefile'), qr/\Amake/, 'Makefile OK'); -my $str = do { local $/; open(my $fh, __FILE__); <$fh> }; +my $str = do { local $/; open(my $fh, '<', __FILE__); <$fh> }; my $orig = $str; { diff --git a/t/httpd-corner.psgi b/t/httpd-corner.psgi index 10cf8350..e29fd87b 100644 --- a/t/httpd-corner.psgi +++ b/t/httpd-corner.psgi @@ -3,9 +3,22 @@ # corner case tests for the generic PSGI server # Usage: plackup [OPTIONS] /path/to/this/file use v5.12; -use warnings; use Plack::Builder; -require Digest::SHA; +require PublicInbox::SHA; +if (defined(my $f = $ENV{TEST_OPEN_FIFO})) { + open my $fh, '>', $f or die "open($f): $!"; + say $fh 'hi'; + close $fh; +} + +END { + if (defined(my $f = $ENV{TEST_EXIT_FIFO})) { + open my $fh, '>', $f or die "open($f): $!"; + say $fh "bye from $$"; + close $fh; + } +} + my $pi_config = $ENV{PI_CONFIG} // 'unset'; # capture ASAP my $app = sub { my ($env) = @_; @@ -16,7 +29,7 @@ my $app = sub { my $h = [ 'Content-Type' => 'text/plain' ]; my $body = []; if ($path eq '/sha1') { - my $sha1 = Digest::SHA->new('SHA-1'); + my $sha1 = PublicInbox::SHA->new(1); my $buf; while (1) { my $r = $in->read($buf, 4096); @@ -79,34 +92,34 @@ my $app = sub { my $rdr = { 2 => fileno($null) }; my $cmd = [qw(dd if=/dev/zero count=30 bs=1024k)]; my $qsp = PublicInbox::Qspawn->new($cmd, undef, $rdr); - return $qsp->psgi_return($env, undef, sub { + return $qsp->psgi_yield($env, undef, sub { my ($r, $bref) = @_; # make $rd_hdr retry sysread + $parse_hdr in Qspawn: return until length($$bref) > 8000; close $null; [ 200, [ qw(Content-Type application/octet-stream) ]]; }); - } elsif ($path eq '/psgi-return-gzip') { + } elsif ($path eq '/psgi-yield-gzip') { require PublicInbox::Qspawn; require PublicInbox::GzipFilter; my $cmd = [qw(echo hello world)]; my $qsp = PublicInbox::Qspawn->new($cmd); $env->{'qspawn.filter'} = PublicInbox::GzipFilter->new; - return $qsp->psgi_return($env, undef, sub { + return $qsp->psgi_yield($env, undef, sub { [ 200, [ qw(Content-Type application/octet-stream)]] }); - } elsif ($path eq '/psgi-return-compressible') { + } elsif ($path eq '/psgi-yield-compressible') { require PublicInbox::Qspawn; my $cmd = [qw(echo goodbye world)]; my $qsp = PublicInbox::Qspawn->new($cmd); - return $qsp->psgi_return($env, undef, sub { + return $qsp->psgi_yield($env, undef, sub { [200, [qw(Content-Type text/plain)]] }); - } elsif ($path eq '/psgi-return-enoent') { + } elsif ($path eq '/psgi-yield-enoent') { require PublicInbox::Qspawn; my $cmd = [ 'this-better-not-exist-in-PATH'.rand ]; my $qsp = PublicInbox::Qspawn->new($cmd); - return $qsp->psgi_return($env, undef, sub { + return $qsp->psgi_yield($env, undef, sub { [ 200, [ qw(Content-Type application/octet-stream)]] }); } elsif ($path eq '/pid') { @@ -118,6 +131,10 @@ my $app = sub { } elsif ($path eq '/PI_CONFIG') { $code = 200; push @$body, $pi_config; # show value at ->refresh_groups + } elsif ($path =~ m!\A/exit-fifo(.+)\z!) { + $code = 200; + $ENV{TEST_EXIT_FIFO} = $1; # for END {} + push @$body, "fifo $1 registered"; } [ $code, $h, $body ] }; diff --git a/t/httpd-corner.t b/t/httpd-corner.t index 973cc55d..7539573c 100644 --- a/t/httpd-corner.t +++ b/t/httpd-corner.t @@ -3,11 +3,12 @@ # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> # note: our HTTP server should be standalone and capable of running # generic PSGI/Plack apps. -use strict; use v5.10.1; use PublicInbox::TestCommon; +use v5.12; use PublicInbox::TestCommon; use Time::HiRes qw(gettimeofday tv_interval); +use autodie qw(getsockopt setsockopt); use PublicInbox::Spawn qw(spawn popen_rd); require_mods(qw(Plack::Util Plack::Builder HTTP::Date HTTP::Status)); -use Digest::SHA qw(sha1_hex); +use PublicInbox::SHA qw(sha1_hex); use IO::Handle (); use IO::Socket::UNIX; use Fcntl qw(:seek); @@ -26,20 +27,21 @@ my @zmods = qw(PublicInbox::GzipFilter IO::Uncompress::Gunzip); # 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); -if ($^O eq 'linux') { +SKIP: { + skip 'TCP_DEFER_ACCEPT is Linux-only', 1 if $^O ne 'linux'; $TCP_DEFER_ACCEPT = eval { Socket::TCP_DEFER_ACCEPT() } // 9; - setsockopt($sock, IPPROTO_TCP, $TCP_DEFER_ACCEPT, 5) or die; + setsockopt($sock, IPPROTO_TCP, $TCP_DEFER_ACCEPT, 5); my $x = getsockopt($sock, IPPROTO_TCP, $TCP_DEFER_ACCEPT); - defined $x or die "getsockopt: $!"; $defer_accept_val = unpack('i', $x); - if ($defer_accept_val <= 0) { - die "unexpected TCP_DEFER_ACCEPT value: $defer_accept_val"; - } -} elsif ($^O eq 'freebsd' && system('kldstat -m accf_data >/dev/null') == 0) { + ok($defer_accept_val > 0, 'TCP_DEFER_ACCEPT val non-zero') or + xbail "unexpected TCP_DEFER_ACCEPT value: $defer_accept_val"; +} +SKIP: { + require_mods '+accf_data'; require PublicInbox::Daemon; my $var = $PublicInbox::Daemon::SO_ACCEPTFILTER; $accf_arg = pack('a16a240', 'dataready', ''); - setsockopt($sock, SOL_SOCKET, $var, $accf_arg) or die "setsockopt: $!"; + setsockopt($sock, SOL_SOCKET, $var, $accf_arg); } sub unix_server ($) { @@ -320,7 +322,7 @@ sub conn_for { $spawn_httpd->('-W0'); } -sub delay { select(undef, undef, undef, shift || rand(0.02)) } +sub delay { tick(shift || rand(0.02)) } my $str = 'abcdefghijklmnopqrstuvwxyz'; my $len = length $str; @@ -341,7 +343,7 @@ SKIP: { my $url = "$base/sha1"; my ($r, $w); pipe($r, $w) or die "pipe: $!"; - my $cmd = [$curl, qw(--tcp-nodelay -T- -HExpect: -sSN), $url]; + my $cmd = [$curl, qw(--tcp-nodelay -T- -HExpect: -gsSN), $url]; open my $cout, '+>', undef or die; open my $cerr, '>', undef or die; my $rdr = { 0 => $r, 1 => $cout, 2 => $cerr }; @@ -358,7 +360,7 @@ SKIP: { seek($cout, 0, SEEK_SET); is(<$cout>, sha1_hex($str), 'read expected body'); - my $fh = popen_rd([$curl, '-sS', "$base/async-big"]); + my $fh = popen_rd([$curl, '-gsS', "$base/async-big"]); my $n = 0; my $non_zero = 0; while (1) { @@ -366,19 +368,19 @@ SKIP: { $n += $r; $buf =~ /\A\0+\z/ or $non_zero++; } - close $fh or die "close curl pipe: $!"; + $fh->close 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, 4); - my $buf = xqx([$curl, '-sS', "$base/psgi-return-gzip"]); + my $buf = xqx([$curl, '-gsS', "$base/psgi-yield-gzip"]); is($?, 0, 'curl succesful'); IO::Uncompress::Gunzip::gunzip(\$buf => \(my $out)); is($out, "hello world\n"); my $curl_rdr = { 2 => \(my $curl_err = '') }; - $buf = xqx([$curl, qw(-sSv --compressed), - "$base/psgi-return-compressible"], undef, $curl_rdr); + $buf = xqx([$curl, qw(-gsSv --compressed), + "$base/psgi-yield-compressible"], undef, $curl_rdr); is($?, 0, 'curl --compressed successful'); is($buf, "goodbye world\n", 'gzipped response as expected'); like($curl_err, qr/\bContent-Encoding: gzip\b/, @@ -386,8 +388,8 @@ SKIP: { } { - my $conn = conn_for($sock, 'psgi_return ENOENT'); - print $conn "GET /psgi-return-enoent HTTP/1.1\r\n\r\n" or die; + my $conn = conn_for($sock, 'psgi_yield ENOENT'); + print $conn "GET /psgi-yield-enoent HTTP/1.1\r\n\r\n" or die; my $buf = ''; sysread($conn, $buf, 16384, length($buf)) until $buf =~ /\r\n\r\n/; like($buf, qr!HTTP/1\.[01] 500\b!, 'got 500 error on ENOENT'); @@ -625,43 +627,33 @@ SKIP: { SKIP: { skip 'TCP_DEFER_ACCEPT is Linux-only', 1 if $^O ne 'linux'; my $var = $TCP_DEFER_ACCEPT; - defined(my $x = getsockopt($sock, IPPROTO_TCP, $var)) or die; + my $x = getsockopt($sock, IPPROTO_TCP, $var); is(unpack('i', $x), $defer_accept_val, 'TCP_DEFER_ACCEPT unchanged if previously set'); }; SKIP: { - skip 'SO_ACCEPTFILTER is FreeBSD-only', 1 if $^O ne 'freebsd'; - skip 'accf_data not loaded: kldload accf_data' if !defined $accf_arg; + require_mods '+accf_data'; my $var = $PublicInbox::Daemon::SO_ACCEPTFILTER; - defined(my $x = getsockopt($sock, SOL_SOCKET, $var)) or die; + my $x = getsockopt($sock, SOL_SOCKET, $var); is($x, $accf_arg, 'SO_ACCEPTFILTER unchanged if previously set'); }; SKIP: { - skip 'only testing lsof(8) output on Linux', 1 if $^O ne 'linux'; - my $lsof = require_cmd('lsof', 1) 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); - my $d = [ grep(/\(deleted\)/, @lsof) ]; - is_deeply($d, [], 'no lingering deleted inputs') or diag explain($d); + skip 'only testing /proc/PID/fd on Linux', 1 if $^O ne 'linux'; + my $fd_dir = "/proc/$td->{pid}/fd"; + -d $fd_dir or skip '/proc/$PID/fd missing', 1; + my @child = grep defined, map readlink, glob "$fd_dir/*"; + my @d = grep /\(deleted\)/, @child; + is_deeply(\@d, [], 'no lingering deleted inputs') or diag explain(\@d); # filter out pipes inherited from the parent - my @this = xqx([$lsof, '-p', $$], undef, $rdr); - my $bad; - my $extract_inodes = sub { - map {; - my @f = split(' ', $_); - my $inode = $f[-2]; - $bad = $_ if $inode !~ /\A[0-9]+\z/; - $inode => 1; - } grep (/\bpipe\b/, @_); - }; - my %child = $extract_inodes->(@lsof); + my @this = grep defined, map readlink, glob "/proc/$$/fd/*"; + my $extract_inodes = sub { map { $_ => 1 } grep /\bpipe\b/, @_ }; + my %child = $extract_inodes->(@child); my %parent = $extract_inodes->(@this); - skip("inode not in expected format: $bad", 1) if defined($bad); delete @child{(keys %parent)}; - is_deeply([], [keys %child], 'no extra pipes with -W0'); + is_deeply([], [keys %child], 'no extra pipes with -W0') or + diag explain([child => \%child, parent => \%parent]); }; # ensure compatibility with other PSGI servers @@ -677,13 +669,13 @@ SKIP: { my $app = require $psgi; test_psgi($app, sub { my ($cb) = @_; - my $req = GET('http://example.com/psgi-return-gzip'); + my $req = GET('http://example.com/psgi-yield-gzip'); my $res = $cb->($req); my $buf = $res->content; IO::Uncompress::Gunzip::gunzip(\$buf => \(my $out)); is($out, "hello world\n", 'got expected output'); - $req = GET('http://example.com/psgi-return-enoent'); + $req = GET('http://example.com/psgi-yield-enoent'); $res = $cb->($req); is($res->code, 500, 'got error on ENOENT'); seek($tmperr, 0, SEEK_SET) or die; diff --git a/t/httpd-https.t b/t/httpd-https.t index b0cd7eab..bf086123 100644 --- a/t/httpd-https.t +++ b/t/httpd-https.t @@ -102,10 +102,7 @@ for my $args ( ok(unpack('i', $x) > 0, 'TCP_DEFER_ACCEPT set on https'); }; SKIP: { - skip 'SO_ACCEPTFILTER is FreeBSD-only', 2 if $^O ne 'freebsd'; - if (system('kldstat -m accf_data >/dev/null')) { - skip 'accf_data not loaded? kldload accf_data', 2; - } + require_mods '+accf_data'; require PublicInbox::Daemon; ok(defined($PublicInbox::Daemon::SO_ACCEPTFILTER), 'SO_ACCEPTFILTER defined'); diff --git a/t/httpd-unix.t b/t/httpd-unix.t index fe4a2161..0b620bd6 100644 --- a/t/httpd-unix.t +++ b/t/httpd-unix.t @@ -1,15 +1,17 @@ -# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org> +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> # Tests for binding Unix domain sockets -use strict; -use warnings; -use Test::More; +use v5.12; use PublicInbox::TestCommon; use Errno qw(EADDRINUSE); use Cwd qw(abs_path); use Carp qw(croak); +use autodie qw(close); require_mods(qw(Plack::Util Plack::Builder HTTP::Date HTTP::Status)); use IO::Socket::UNIX; +use POSIX qw(mkfifo); +require PublicInbox::Sigfd; my ($tmpdir, $for_destroy) = tmpdir(); my $unix = "$tmpdir/unix.sock"; my $psgi = './t/httpd-corner.psgi'; @@ -17,6 +19,15 @@ my $out = "$tmpdir/out.log"; my $err = "$tmpdir/err.log"; my $td; +my $register_exit_fifo = sub { + my ($s, $f) = @_; + my $sock = new_sock($s); + ok($sock->write("GET /exit-fifo$f HTTP/1.0\r\n\r\n"), + 'request exit-fifo'); + ok($sock->read(my $buf, 4096), 'read exit-fifo response'); + like($buf, qr!\r\n\r\nfifo \Q$f\E registered\z!, 'set exit fifo'); +}; + my $spawn_httpd = sub { my (@args) = @_; my $cmd = [ '-httpd', @args, "--stdout=$out", "--stderr=$err", $psgi ]; @@ -32,18 +43,24 @@ my $spawn_httpd = sub { } ok(!-S $unix, 'UNIX socket does not exist, yet'); -$spawn_httpd->("-l$unix", '-W0'); -my %o = (Peer => $unix, Type => SOCK_STREAM); -for (1..1000) { - last if -S $unix && IO::Socket::UNIX->new(%o); - select undef, undef, undef, 0.02 +my $f1 = "$tmpdir/f1"; +mkfifo($f1, 0600); +{ + local $ENV{TEST_OPEN_FIFO} = $f1; + $spawn_httpd->("-l$unix", '-W0'); + open my $fh, '<', $f1 or xbail "open($f1): $!"; + is(my $hi = <$fh>, "hi\n", 'got FIFO greeting'); } - ok(-S $unix, 'UNIX socket was bound by -httpd'); + +sub new_sock ($) { + IO::Socket::UNIX->new(Peer => $_[0], Type => SOCK_STREAM) + // xbail "E: $! connecting to $_[0]"; +} + sub check_sock ($) { my ($unix) = @_; - my $sock = IO::Socket::UNIX->new(Peer => $unix, Type => SOCK_STREAM) - // BAIL_OUT "E: $! connecting to $unix"; + my $sock = new_sock($unix); ok($sock->write("GET /host-port HTTP/1.0\r\n\r\n"), 'wrote req to server'); ok($sock->read(my $buf, 4096), 'read response'); @@ -82,16 +99,17 @@ check_sock($unix); # portable Perl can delay or miss signal dispatches due to races, # so disable some tests on systems lacking signalfd(2) or EVFILT_SIGNAL -my $has_sigfd = PublicInbox::Sigfd->new({}, 0) ? 1 : $ENV{TEST_UNRELIABLE}; +my $has_sigfd = PublicInbox::Sigfd->new({}) ? 1 : $ENV{TEST_UNRELIABLE}; +PublicInbox::DS::Reset() if $has_sigfd; sub delay_until { - my $cond = shift; + my ($cond, $msg) = @_; my $end = time + 30; do { return if $cond->(); - select undef, undef, undef, 0.012; + tick(0.012); } until (time > $end); - Carp::confess('condition failed'); + Carp::confess($msg // 'condition failed'); } SKIP: { @@ -107,95 +125,110 @@ SKIP: { }; for my $w (qw(-W0 -W1)) { + my ($p0, $p1) = quit_waiter_pipe; # wait for daemonization $spawn_httpd->("-l$unix", '-D', '-P', $pid_file, $w); + close $p1; $td->join; is($?, 0, "daemonized $w process"); check_sock($unix); ok(-s $pid_file, "$w pid file written"); my $pid = $read_pid->($pid_file); + no_pollerfd($pid) if $w eq '-W1'; is(kill('TERM', $pid), 1, "signaled daemonized $w process"); - delay_until(sub { !kill(0, $pid) }); - is(kill(0, $pid), 0, "daemonized $w process exited"); + delete $td->{-extra}; # drop tail(1) process + wait_for_eof($p0, "httpd $w quit pipe"); ok(!-e $pid_file, "$w pid file unlinked at exit"); } - # try a USR2 upgrade with workers: my $httpd = abs_path('blib/script/public-inbox-httpd'); $psgi = abs_path($psgi); my $opt = { run_mode => 0 }; - my @args = ("-l$unix", '-D', '-P', $pid_file, -1, $out, -2, $err); - $td = start_script([$httpd, @args, $psgi], undef, $opt); - $td->join; - is($?, 0, "daemonized process again"); - check_sock($unix); - ok(-s $pid_file, 'pid file written'); - my $pid = $read_pid->($pid_file); - - # stop worker to ensure check_sock below hits $new_pid - kill('TTOU', $pid) or die "TTOU failed: $!"; - - kill('USR2', $pid) or die "USR2 failed: $!"; - delay_until(sub { - $pid != (eval { $read_pid->($pid_file) } // $pid) - }); - my $new_pid = $read_pid->($pid_file); - isnt($new_pid, $pid, 'new child started'); - ok($new_pid > 0, '$new_pid valid'); - delay_until(sub { -s "$pid_file.oldbin" }); - my $old_pid = $read_pid->("$pid_file.oldbin"); - is($old_pid, $pid, '.oldbin pid file written'); - ok($old_pid > 0, '$old_pid valid'); - - check_sock($unix); # ensures $new_pid is ready to receive signals - - # first, back out of the upgrade - kill('QUIT', $new_pid) or die "kill new PID failed: $!"; - delay_until(sub { - $pid == (eval { $read_pid->($pid_file) } // 0) - }); - is($read_pid->($pid_file), $pid, 'old PID file restored'); - ok(!-f "$pid_file.oldbin", '.oldbin PID file gone'); - - # retry USR2 upgrade - kill('USR2', $pid) or die "USR2 failed: $!"; - delay_until(sub { - $pid != (eval { $read_pid->($pid_file) } // $pid) - }); - $new_pid = $read_pid->($pid_file); - isnt($new_pid, $pid, 'new child started again'); - $old_pid = $read_pid->("$pid_file.oldbin"); - is($old_pid, $pid, '.oldbin pid file written'); - - # drop the old parent - kill('QUIT', $old_pid) or die "QUIT failed: $!"; - delay_until(sub { !kill(0, $old_pid) }); - ok(!-f "$pid_file.oldbin", '.oldbin PID file gone'); - - # drop the new child - check_sock($unix); - kill('QUIT', $new_pid) or die "QUIT failed: $!"; - delay_until(sub { !kill(0, $new_pid) }); - ok(!-f $pid_file, 'PID file is gone'); - - - # try USR2 without workers (-W0) - $td = start_script([$httpd, @args, '-W0', $psgi], undef, $opt); - $td->join; - is($?, 0, 'daemonized w/o workers'); - check_sock($unix); - $pid = $read_pid->($pid_file); - - # replace running process - kill('USR2', $pid) or die "USR2 failed: $!"; - delay_until(sub { !kill(0, $pid) }); - - check_sock($unix); - $pid = $read_pid->($pid_file); - kill('QUIT', $pid) or die "USR2 failed: $!"; - delay_until(sub { !kill(0, $pid) }); - ok(!-f $pid_file, 'PID file is gone'); + + if ('USR2 upgrades with workers') { + my ($p0, $p1) = quit_waiter_pipe; + $td = start_script([$httpd, @args, $psgi], undef, $opt); + close $p1; + $td->join; + is($?, 0, "daemonized process again"); + check_sock($unix); + ok(-s $pid_file, 'pid file written'); + my $pid = $read_pid->($pid_file); + + # stop worker to ensure check_sock below hits $new_pid + kill('TTOU', $pid) or die "TTOU failed: $!"; + + kill('USR2', $pid) or die "USR2 failed: $!"; + delay_until(sub { + $pid != (eval { $read_pid->($pid_file) } // $pid) + }); + my $new_pid = $read_pid->($pid_file); + isnt($new_pid, $pid, 'new child started'); + ok($new_pid > 0, '$new_pid valid'); + delay_until(sub { -s "$pid_file.oldbin" }); + my $old_pid = $read_pid->("$pid_file.oldbin"); + is($old_pid, $pid, '.oldbin pid file written'); + ok($old_pid > 0, '$old_pid valid'); + + check_sock($unix); # ensures $new_pid is ready to receive signals + + # first, back out of the upgrade + kill('QUIT', $new_pid) or die "kill new PID failed: $!"; + delay_until(sub { + $pid == (eval { $read_pid->($pid_file) } // 0) + }); + + delay_until(sub { !kill(0, $new_pid) }, 'new PID really died'); + + is($read_pid->($pid_file), $pid, 'old PID file restored'); + ok(!-f "$pid_file.oldbin", '.oldbin PID file gone'); + + # retry USR2 upgrade + kill('USR2', $pid) or die "USR2 failed: $!"; + delay_until(sub { + $pid != (eval { $read_pid->($pid_file) } // $pid) + }); + $new_pid = $read_pid->($pid_file); + isnt($new_pid, $pid, 'new child started again'); + $old_pid = $read_pid->("$pid_file.oldbin"); + is($old_pid, $pid, '.oldbin pid file written'); + + # drop the old parent + kill('QUIT', $old_pid) or die "QUIT failed: $!"; + delay_until(sub { !kill(0, $old_pid) }, 'old PID really died'); + + ok(!-f "$pid_file.oldbin", '.oldbin PID file gone'); + + # drop the new child + check_sock($unix); + kill('QUIT', $new_pid) or die "QUIT failed: $!"; + + wait_for_eof($p0, 'new process'); + ok(!-f $pid_file, 'PID file is gone'); + } + + if ('try USR2 without workers (-W0)') { + my ($p0, $p1) = quit_waiter_pipe; + $td = start_script([$httpd, @args, '-W0', $psgi], undef, $opt); + close $p1; + $td->join; + is($?, 0, 'daemonized w/o workers'); + $register_exit_fifo->($unix, $f1); + my $pid = $read_pid->($pid_file); + + # replace running process + kill('USR2', $pid) or xbail "USR2 failed: $!"; + open my $fh, '<', $f1 or xbail "open($f1): $!"; + is(my $bye = <$fh>, "bye from $pid\n", 'got FIFO bye'); + + check_sock($unix); + $pid = $read_pid->($pid_file); + kill('QUIT', $pid) or xbail "USR2 failed: $!"; + + wait_for_eof($p0, '-W0 USR2 test pipe'); + ok(!-f $pid_file, 'PID file is gone'); + } } done_testing(); @@ -7,6 +7,7 @@ use PublicInbox::TestCommon; use PublicInbox::Eml; use Socket qw(IPPROTO_TCP SOL_SOCKET); require_mods(qw(Plack::Util Plack::Builder HTTP::Date HTTP::Status)); +require_git_http_backend; # FIXME: too much setup my ($tmpdir, $for_destroy) = tmpdir(); @@ -104,10 +105,7 @@ SKIP: { ok(unpack('i', $x) > 0, 'TCP_DEFER_ACCEPT set'); }; SKIP: { - skip 'SO_ACCEPTFILTER is FreeBSD-only', 1 if $^O ne 'freebsd'; - if (system('kldstat -m accf_http >/dev/null') != 0) { - skip 'accf_http not loaded: kldload accf_http', 1; - } + require_mods '+accf_http'; require PublicInbox::Daemon; ok(defined($PublicInbox::Daemon::SO_ACCEPTFILTER), 'SO_ACCEPTFILTER defined'); @@ -1,5 +1,5 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> # unit tests (no network) for IMAP, see t/imapd.t for end-to-end tests use strict; @@ -9,12 +9,12 @@ require_git 2.6; require_mods(qw(-imapd)); require_ok 'PublicInbox::IMAP'; require_ok 'PublicInbox::IMAPD'; +use PublicInbox::IO qw(write_file); my ($tmpdir, $for_destroy) = tmpdir(); my $cfgfile = "$tmpdir/config"; { - open my $fh, '>', $cfgfile or BAIL_OUT $!; - print $fh <<EOF or BAIL_OUT $!; + write_file '>', $cfgfile, <<EOF; [publicinbox "a"] inboxdir = $tmpdir/a newsgroup = x.y.z @@ -23,9 +23,8 @@ my $cfgfile = "$tmpdir/config"; newsgroup = x.z.y [publicinbox "c"] inboxdir = $tmpdir/c - newsgroup = IGNORE.THIS + newsgroup = ignore.this.9 EOF - close $fh or BAIL_OUT $!; local $ENV{PI_CONFIG} = $cfgfile; for my $x (qw(a b c)) { ok(run_script(['-init', '-Lbasic', '-V2', $x, "$tmpdir/$x", @@ -37,8 +36,8 @@ EOF local $SIG{__WARN__} = sub { push @w, @_ }; $imapd->refresh_groups; my $self = { imapd => $imapd }; - is(scalar(@w), 1, 'got a warning for upper-case'); - like($w[0], qr/IGNORE\.THIS/, 'warned about upper-case'); + is(scalar(@w), 1, 'got a warning for slice-like name'); + like($w[0], qr/ignore\.this\.9/i, 'warned about slice-like name'); my $res = PublicInbox::IMAP::cmd_list($self, 'tag', 'x', '%'); is(scalar($$res =~ tr/\n/\n/), 2, 'only one result'); like($$res, qr/ x\r\ntag OK/, 'saw expected'); diff --git a/t/imap_searchqp.t b/t/imap_searchqp.t index e2f49e5a..d7840dd0 100644 --- a/t/imap_searchqp.t +++ b/t/imap_searchqp.t @@ -1,8 +1,10 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; +use autodie qw(open seek read); +use Fcntl qw(SEEK_SET); use Time::Local qw(timegm); use PublicInbox::TestCommon; require_mods(qw(-imapd)); @@ -28,12 +30,18 @@ $q = $parse->(qq{CHARSET UTF-8 From b}); is($q->{xap}, 'f:"b"', 'charset handled'); $q = $parse->(qq{CHARSET WTF-8 From b}); like($q, qr/\ANO \[/, 'bad charset rejected'); + { - # TODO: squelch errors by default? clients could flood logs - open my $fh, '>:scalar', \(my $buf) or die; - local *STDERR = $fh; + open my $tmperr, '+>', undef; + open my $olderr, '>&', \*STDERR; + open STDERR, '>&', $tmperr; $q = $parse->(qq{CHARSET}); + open STDERR, '>&', $olderr; + seek $tmperr, 0, SEEK_SET; + read($tmperr, my $buf, -s $tmperr); + is($buf, '', 'nothing spewed to STDERR on bad query'); } + like($q, qr/\ABAD /, 'bad charset rejected'); $q = $parse->(qq{HEADER CC B (SENTBEFORE 2-Oct-1993)}); diff --git a/t/imapd-tls.t b/t/imapd-tls.t index 44ab350c..b95085a2 100644 --- a/t/imapd-tls.t +++ b/t/imapd-tls.t @@ -1,8 +1,7 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use v5.10.1; +use v5.12; use Socket qw(IPPROTO_TCP SOL_SOCKET); use PublicInbox::TestCommon; # IO::Poll is part of the standard library, but distros may split it off... @@ -158,8 +157,19 @@ for my $args ( test_lei(sub { lei_ok qw(ls-mail-source), "imap://$starttls_addr", \'STARTTLS not used by default'; - ok(!lei(qw(ls-mail-source -c imap.starttls=true), + my $plain_out = $lei_out; + ok(!lei(qw(ls-mail-source -c imap.starttls), "imap://$starttls_addr"), 'STARTTLS verify fails'); + unlike $lei_err, qr!W: imap\.starttls= .*? is not boolean!i, + 'no non-boolean warning'; + lei_ok qw(-c imap.starttls -c imap.sslVerify= ls-mail-source), + "imap://$starttls_addr", + \'disabling imap.sslVerify works w/ STARTTLS'; + is $lei_out, $plain_out, 'sslVerify=false w/ STARTTLS output'; + lei_ok qw(ls-mail-source -c imap.sslVerify=false), + "imaps://$imaps_addr", + \'disabling imap.sslVerify works w/ imaps://'; + is $lei_out, $plain_out, 'sslVerify=false w/ IMAPS output'; }); SKIP: { @@ -171,10 +181,7 @@ for my $args ( is(unpack('i', $x), 0, 'TCP_DEFER_ACCEPT is 0 on plain IMAP'); }; SKIP: { - skip 'SO_ACCEPTFILTER is FreeBSD-only', 2 if $^O ne 'freebsd'; - if (system('kldstat -m accf_data >/dev/null')) { - skip 'accf_data not loaded? kldload accf_data', 2; - } + require_mods '+accf_data'; require PublicInbox::Daemon; my $x = getsockopt($imaps, SOL_SOCKET, $PublicInbox::Daemon::SO_ACCEPTFILTER); @@ -2,10 +2,11 @@ # Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> # end-to-end IMAP tests, see unit tests in t/imap.t, too -use strict; -use Test::More; +use v5.12; use Time::HiRes (); +use PublicInbox::DS qw(now); use PublicInbox::TestCommon; +use PublicInbox::TailNotify; use PublicInbox::Config; require_mods(qw(-imapd Mail::IMAPClient)); my $imap_client = 'Mail::IMAPClient'; @@ -20,7 +21,7 @@ my $first_range = '0'; my $level = 'basic'; SKIP: { - require_mods('Search::Xapian', 1); + require_mods('Xapian', 1); $level = 'medium'; }; @@ -249,7 +250,7 @@ SKIP: { ok($mic->logout, 'logout works'); -my $have_inotify = eval { require Linux::Inotify2; 1 }; +my $have_inotify = eval { require PublicInbox::Inotify; 1 }; for my $ibx (@ibx) { my $name = $ibx->{name}; @@ -436,10 +437,52 @@ ok($mic->logout, 'logged out'); like(<$c>, qr/\Atagonly BAD Error in IMAP command/, 'tag-only line'); } +{ + ok(my $ic = $imap_client->new(%mic_opt), 'logged in'); + my $mb = "$ibx[0]->{newsgroup}.$first_range"; + ok($ic->examine($mb), "EXAMINE $mb"); + my $uidnext = $ic->uidnext($mb); # we'll fetch BODYSTRUCTURE on this + my $im = $ibx[0]->importer(0); + $im->add(PublicInbox::Eml->new(<<EOF)) or BAIL_OUT; +Subject: test Ævar +Message-ID: <smtputf8-delivered-mess\@age> +From: Ævar Arnfjörð Bjarmason <avarab\@example> +To: git\@vger.kernel.org + +EOF + $im->done; + my $envl = $ic->get_envelope($uidnext); + is($envl->{subject}, 'test Ævar', 'UTF-8 subject'); + is($envl->{sender}->[0]->{personalname}, 'Ævar Arnfjörð Bjarmason', + 'UTF-8 sender[0].personalname'); + SKIP: { + skip 'need compress for comparisons', 1 if !$can_compress; + ok($ic = $imap_client->new(%mic_opt), 'uncompressed logged in'); + ok($ic && $ic->compress, 'compress enabled'); + ok($ic->examine($mb), "EXAMINE $mb"); + my $raw = $ic->get_envelope($uidnext); + is_deeply($envl, $raw, 'raw and compressed match'); + } +} + +my $wait_re = sub { + my ($tail_notify, $re) = @_; + my $end = now() + 5; + my (@l, @all); + until (grep(/$re/, @l = $tail_notify->getlines(5)) || now > $end) { + push @all, @l; + @l = (); + } + return \@l if @l; + diag explain(\@all); + xbail "never got `$re' message"; +}; + +my $watcherr = "$tmpdir/watcherr"; + SKIP: { use_ok 'PublicInbox::InboxIdle'; - require_git('1.8.5', 1) or - skip('git 1.8.5+ needed for --urlmatch', 4); + require_git '1.8.5', 4; my $old_env = { HOME => $ENV{HOME} }; my $home = "$tmpdir/watch_home"; mkdir $home or BAIL_OUT $!; @@ -458,26 +501,26 @@ SKIP: { my $cfg = PublicInbox::Config->new; PublicInbox::DS->Reset; my $ii = PublicInbox::InboxIdle->new($cfg); - my $cb = sub { PublicInbox::DS->SetPostLoopCallback(sub {}) }; + my $cb = sub { @PublicInbox::DS::post_loop_do = (sub {}) }; my $obj = bless \$cb, 'PublicInbox::TestCommon::InboxWakeup'; $cfg->each_inbox(sub { $_[0]->subscribe_unlock('ident', $obj) }); - my $watcherr = "$tmpdir/watcherr"; open my $err_wr, '>>', $watcherr or BAIL_OUT $!; - open my $err, '<', $watcherr or BAIL_OUT $!; + my $errw = PublicInbox::TailNotify->new($watcherr); my $w = start_script(['-watch'], undef, { 2 => $err_wr }); diag 'waiting for initial fetch...'; PublicInbox::DS::event_loop(); diag 'inbox unlocked on initial fetch, waiting for IDLE'; - tick until (grep(/I: \S+ idling/, <$err>)); + $wait_re->($errw, qr/# \S+ idling/); + open my $fh, '<', 't/iso-2202-jp.eml' or BAIL_OUT $!; $old_env->{ORIGINAL_RECIPIENT} = $addr; ok(run_script([qw(-mda --no-precheck)], $old_env, { 0 => $fh }), 'delivered a message for IDLE to kick -watch') or diag "mda error \$?=$?"; diag 'waiting for IMAP IDLE wakeup'; - PublicInbox::DS->SetPostLoopCallback(undef); + @PublicInbox::DS::post_loop_do = (); PublicInbox::DS::event_loop(); diag 'inbox unlocked on IDLE wakeup'; @@ -487,14 +530,15 @@ SKIP: { or BAIL_OUT "git config $?"; $w->kill('HUP'); diag 'waiting for -watch reload + initial fetch'; - tick until (grep(/I: will check/, <$err>)); + + $wait_re->($errw, qr/# will check/); open $fh, '<', 't/psgi_attach.eml' or BAIL_OUT $!; ok(run_script([qw(-mda --no-precheck)], $old_env, { 0 => $fh }), 'delivered a message for -watch PollInterval'); diag 'waiting for PollInterval wakeup'; - PublicInbox::DS->SetPostLoopCallback(undef); + @PublicInbox::DS::post_loop_do = (); PublicInbox::DS::event_loop(); diag 'inbox unlocked (poll)'; $w->kill; @@ -504,19 +548,24 @@ SKIP: { $cfg->each_inbox(sub { shift->unsubscribe_unlock('ident') }); $ii->close; PublicInbox::DS->Reset; - seek($err, 0, 0); - my @err = grep(!/^(?:I:|#)/, <$err>); + open my $errfh, '<', $watcherr or xbail "open: $!"; + my @err = grep(!/^(?:I:|#)/, <$errfh>); is(@err, 0, 'no warnings/errors from -watch'.join(' ', @err)); - if ($ENV{TEST_KILL_IMAPD}) { # not sure how reliable this test can be + SKIP: { # not sure how reliable this test can be + skip 'TEST_KILL_IMAPD not set', 1 if !$ENV{TEST_KILL_IMAPD}; + $^O eq 'linux' or + diag "TEST_KILL_IMAPD may not be reliable under $^O"; xsys(qw(git config), "--file=$home/.public-inbox/config", qw(--unset imap.PollInterval)) == 0 or BAIL_OUT "git config $?"; - truncate($err_wr, 0) or BAIL_OUT $!; + unlink $watcherr or xbail $!; + open my $err_wr, '>>', $watcherr or xbail $!; my @t0 = times; $w = start_script(['-watch'], undef, { 2 => $err_wr }); - seek($err, 0, 0); - tick until (grep(/I: \S+ idling/, <$err>)); + + $wait_re->($errw, qr/# \S+ idling/); + diag 'killing imapd, waiting for CPU spins'; my $delay = 0.11; $td->kill(9); @@ -529,7 +578,8 @@ SKIP: { my $thresh = (0.9 * $delay); diag "c=$c, threshold=$thresh"; ok($c < $thresh, 'did not burn much CPU'); - is_deeply([grep(/ line \d+$/m, <$err>)], [], + open $errfh, '<', $watcherr or xbail "open: $!"; + is_deeply([grep(/ line \d+$/m, <$errfh>)], [], 'no backtraces from errors'); } } @@ -1,8 +1,8 @@ -# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org> +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use v5.10.1; use strict; -use warnings; -use Test::More; use PublicInbox::Eml; use PublicInbox::Smsg; use PublicInbox::Git; @@ -26,11 +26,12 @@ hello world EOF my $v2 = require_git(2.6, 1); -my $smsg = bless {}, 'PublicInbox::Smsg' if $v2; +my $smsg = $v2 ? bless({}, 'PublicInbox::Smsg') : undef; like($im->add($mime, undef, $smsg), qr/\A:[0-9]+\z/, 'added one message'); -if ($v2) { - like($smsg->{blob}, qr/\A[a-f0-9]{40}\z/, 'got last object_id'); +SKIP: { + skip 'git 2.6+ required', 3 if !$v2; + like($smsg->{blob}, qr/\A[a-f0-9]{40,64}\z/, 'got last object_id'); my @cmd = ('git', "--git-dir=$git->{git_dir}", qw(hash-object --stdin)); open my $in, '+<', undef or BAIL_OUT "open(+<): $!"; print $in $mime->as_string or die "write failed: $!"; @@ -97,7 +98,8 @@ ok($@, 'Import->add fails on non-existent dir'); my @cls = qw(PublicInbox::Eml); SKIP: { - require_mods('PublicInbox::MIME', 1); + require_mods('Email::MIME', 1); + require PublicInbox::MIME; push @cls, 'PublicInbox::MIME'; }; diff --git a/t/inbox_idle.t b/t/inbox_idle.t index 51379764..0ccffab7 100644 --- a/t/inbox_idle.t +++ b/t/inbox_idle.t @@ -1,10 +1,8 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use v5.10.1; +use v5.12; use PublicInbox::TestCommon; -use PublicInbox::Config; require_git 2.6; require_mods(qw(DBD::SQLite)); require PublicInbox::SearchIdx; @@ -26,10 +24,11 @@ for my $V (1, 2) { $sidx->idx_release; # allow watching on lockfile }; my $obj = InboxIdleTestObj->new; - my $pi_cfg = PublicInbox::Config->new(\<<EOF); -publicinbox.inbox-idle.inboxdir=$inboxdir -publicinbox.inbox-idle.indexlevel=basic -publicinbox.inbox-idle.address=$ibx->{-primary_address} + my $pi_cfg = cfg_new $tmpdir, <<EOF; +[publicinbox "inbox-idle"] + inboxdir = $inboxdir + indexlevel = basic + address = $ibx->{-primary_address} EOF my $ident = 'whatever'; $pi_cfg->each_inbox(sub { shift->subscribe_unlock($ident, $obj) }); diff --git a/t/index-git-times.t b/t/index-git-times.t index 52173396..eac2d650 100644 --- a/t/index-git-times.t +++ b/t/index-git-times.t @@ -1,16 +1,16 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; -use Test::More; use PublicInbox::TestCommon; use PublicInbox::Config; use PublicInbox::Admin; use PublicInbox::Import; use File::Path qw(remove_tree); +require PublicInbox::InboxWritable; -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(DBD::SQLite Xapian)); use_ok 'PublicInbox::Over'; my ($tmpdir, $for_destroy) = tmpdir(); @@ -58,7 +58,7 @@ my $smsg; { my $cfg = PublicInbox::Config->new; my $ibx = $cfg->lookup($addr); - my $lvl = PublicInbox::Admin::detect_indexlevel($ibx); + my $lvl = PublicInbox::InboxWritable::detect_indexlevel($ibx); is($lvl, 'medium', 'indexlevel detected'); is($ibx->{-skip_docdata}, 1, '--skip-docdata flag set on -index'); $smsg = $ibx->over->get_art(1); @@ -74,14 +74,14 @@ my $smsg; is($res->[0]->{ds}, $smsg->{ds}, 'Xapian search on datestamp'); } SKIP: { - require_git(2.6, 1) or skip('git 2.6+ required for v2', 10); + require_git(2.6, 10); my $v2dir = "$tmpdir/v2"; run_script(['-convert', $v1dir, $v2dir]) or die 'v2 conversion failed'; my $check_v2 = sub { my $ibx = PublicInbox::Inbox->new({inboxdir => $v2dir, address => $addr}); - my $lvl = PublicInbox::Admin::detect_indexlevel($ibx); + my $lvl = PublicInbox::InboxWritable::detect_indexlevel($ibx); is($lvl, 'medium', 'indexlevel detected after convert'); is($ibx->{-skip_docdata}, 1, '--skip-docdata preserved after convert'); diff --git a/t/indexlevels-mirror.t b/t/indexlevels-mirror.t index ac85643d..c852f72c 100644 --- a/t/indexlevels-mirror.t +++ b/t/indexlevels-mirror.t @@ -5,7 +5,7 @@ use strict; use v5.10.1; use PublicInbox::TestCommon; use PublicInbox::Eml; -use PublicInbox::Inbox; +use PublicInbox::InboxWritable; require PublicInbox::Admin; my $PI_TEST_VERSION = $ENV{PI_TEST_VERSION} || 2; require_git('2.6') if $PI_TEST_VERSION == 2; @@ -41,7 +41,7 @@ my $import_index_incremental = sub { inboxdir => $ibx->{inboxdir}, indexlevel => $level }); - my $msgs = $ro_master->recent; + my $msgs = $ro_master->over->recent; is(scalar(@$msgs), 1, 'only one message in master, so far'); is($msgs->[0]->{mid}, 'm@1', 'first message in master indexed'); @@ -71,7 +71,7 @@ my $import_index_incremental = sub { inboxdir => $mirror, indexlevel => $level, }); - $msgs = $ro_mirror->recent; + $msgs = $ro_mirror->over->recent; is(scalar(@$msgs), 1, 'only one message, so far'); is($msgs->[0]->{mid}, 'm@1', 'read first message'); @@ -83,7 +83,7 @@ my $import_index_incremental = sub { # mirror updates is(xsys('git', "--git-dir=$fetch_dir", qw(fetch -q)), 0, 'fetch OK'); ok(run_script([qw(-index -j0), $mirror]), "v$v index mirror again OK"); - $msgs = $ro_mirror->recent; + $msgs = $ro_mirror->over->recent; is(scalar(@$msgs), 2, '2nd message seen in mirror'); is_deeply([sort { $a cmp $b } map { $_->{mid} } @$msgs], ['m@1','m@2'], 'got both messages in mirror'); @@ -91,7 +91,7 @@ my $import_index_incremental = sub { # incremental index master (required for v1) ok(run_script([qw(-index -j0), $ibx->{inboxdir}, "-L$level"]), 'index master OK'); - $msgs = $ro_master->recent; + $msgs = $ro_master->over->recent; is(scalar(@$msgs), 2, '2nd message seen in master'); is_deeply([sort { $a cmp $b } map { $_->{mid} } @$msgs], ['m@1','m@2'], 'got both messages in master'); @@ -110,7 +110,8 @@ my $import_index_incremental = sub { if ($level ne 'basic') { ok(run_script(['-xcpdb', '-q', $mirror]), "v$v xcpdb OK"); - is(PublicInbox::Admin::detect_indexlevel($ro_mirror), $level, + is(PublicInbox::InboxWritable::detect_indexlevel($ro_mirror), + $level, 'indexlevel detectable by Admin after xcpdb v' .$v.$level); delete $ro_mirror->{$_} for (qw(over search)); my $mset = $ro_mirror->search->mset('m:m@2'); @@ -120,7 +121,7 @@ my $import_index_incremental = sub { # sync the mirror is(xsys('git', "--git-dir=$fetch_dir", qw(fetch -q)), 0, 'fetch OK'); ok(run_script([qw(-index -j0), $mirror]), "v$v index mirror again OK"); - $msgs = $ro_mirror->recent; + $msgs = $ro_mirror->over->recent; is(scalar(@$msgs), 1, '2nd message gone from mirror'); is_deeply([map { $_->{mid} } @$msgs], ['m@1'], 'message unavailable in mirror'); @@ -152,7 +153,7 @@ my $import_index_incremental = sub { is_deeply(\@rw_nums, \@expect, "v$v master has expected NNTP articles"); is_deeply(\@ro_nums, \@expect, "v$v mirror matches master articles"); - is(PublicInbox::Admin::detect_indexlevel($ro_mirror), $level, + is(PublicInbox::InboxWritable::detect_indexlevel($ro_mirror), $level, 'indexlevel detectable by Admin '.$v.$level); SKIP: { @@ -167,7 +168,7 @@ my $import_index_incremental = sub { $import_index_incremental->($PI_TEST_VERSION, 'basic', $mime); SKIP: { - require_mods(qw(Search::Xapian), 2); + require_mods(qw(Xapian), 2); foreach my $l (qw(medium full)) { $import_index_incremental->($PI_TEST_VERSION, $l, $mime); } @@ -1,11 +1,12 @@ -# Copyright (C) 2014-2021 all contributors <meta@public-inbox.org> +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; -use warnings; -use Test::More; +use v5.10.1; use PublicInbox::Config; use PublicInbox::TestCommon; use PublicInbox::Admin; +use PublicInbox::InboxWritable; my ($tmpdir, $for_destroy) = tmpdir(); sub quiet_fail { my ($cmd, $msg) = @_; @@ -18,7 +19,11 @@ sub quiet_fail { my $cfgfile = "$ENV{PI_DIR}/config"; my $cmd = [ '-init', 'blist', "$tmpdir/blist", qw(http://example.com/blist blist@example.com) ]; + my $umask = umask(070) // xbail "umask: $!"; ok(run_script($cmd), 'public-inbox-init OK'); + umask($umask) // xbail "umask: $!"; + my $mode = (stat($cfgfile))[2]; + is(sprintf('0%03o', $mode & 0777), '0604', 'config respects umask'); is(read_indexlevel('blist'), '', 'indexlevel unset by default'); @@ -102,7 +107,7 @@ sub quiet_fail { umask($umask) // xbail "umask: $!"; ok(-d "$tmpdir/a/b/c/d", 'directory created'); my $desc = "$tmpdir/a/b/c/d/description"; - is(PublicInbox::Inbox::try_cat($desc), + is(PublicInbox::IO::try_cat($desc), "public inbox for abcd\@example.com\n", 'description set'); my $mode = (stat($desc))[2]; is(sprintf('0%03o', $mode & 0777), '0644', @@ -116,8 +121,8 @@ sub quiet_fail { } SKIP: { - require_mods(qw(DBD::SQLite Search::Xapian), 2); - require_git(2.6, 1) or skip "git 2.6+ required", 2; + require_mods(qw(DBD::SQLite Xapian), 2); + require_git(2.6, 2); use_ok 'PublicInbox::Msgmap'; local $ENV{PI_DIR} = "$tmpdir/.public-inbox/"; local $ENV{PI_EMERGENCY} = "$tmpdir/.public-inbox/emergency"; @@ -147,7 +152,7 @@ SKIP: { ok(run_script($cmd), "-init -L $lvl"); is(read_indexlevel("v2$lvl"), $lvl, "indexlevel set to '$lvl'"); my $ibx = PublicInbox::Inbox->new({ inboxdir => $dir }); - is(PublicInbox::Admin::detect_indexlevel($ibx), $lvl, + is(PublicInbox::InboxWritable::detect_indexlevel($ibx), $lvl, 'detected expected level w/o config'); ok(!$ibx->{-skip_docdata}, 'docdata written by default'); } @@ -159,7 +164,7 @@ SKIP: { "$name\@example.com" ]; ok(run_script($cmd), "-init -V$v --skip-docdata"); my $ibx = PublicInbox::Inbox->new({ inboxdir => $dir }); - is(PublicInbox::Admin::detect_indexlevel($ibx), 'full', + is(PublicInbox::InboxWritable::detect_indexlevel($ibx), 'full', "detected default indexlevel -V$v"); ok($ibx->{-skip_docdata}, "docdata skip set -V$v"); ok($ibx->search->has_threadid, 'has_threadid flag set on new inbox'); @@ -211,6 +216,14 @@ SKIP: { is($n, 13, 'V1 NNTP article numbers skipped via --skip-artnum'); } +{ + local $ENV{PI_DIR} = "$tmpdir/.public-inbox/"; + my $cmd = [ qw(-init -C), "$tmpdir", qw(chdirlist chdirlist), + qw(http://example.com/chdirlist chdirlist@example.com)]; + ok(run_script($cmd), '-init with -C (chdir)'); + ok(-d "$tmpdir/chdirlist", '-C processed correctly'); +} + done_testing(); sub read_indexlevel { diff --git a/t/inotify3.t b/t/inotify3.t new file mode 100644 index 00000000..c25c0f42 --- /dev/null +++ b/t/inotify3.t @@ -0,0 +1,17 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use v5.12; use PublicInbox::TestCommon; +plan skip_all => 'inotify is Linux-only' if $^O ne 'linux'; +use_ok 'PublicInbox::Inotify3'; +my $in = PublicInbox::Inotify3->new; +my $tmpdir = tmpdir; +my $w = $in->watch("$tmpdir", PublicInbox::Inotify3::IN_ALL_EVENTS()); +$in->blocking(0); +is_xdeeply [ $in->read ], [], 'non-blocking has no events, yet'; +undef $tmpdir; +my @list = $in->read; +ok scalar(@list), 'got events'; +ok $w->cancel, 'watch canceled'; + +done_testing; @@ -0,0 +1,35 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use v5.12; +use PublicInbox::TestCommon; +my $tmpdir = tmpdir; +use_ok 'PublicInbox::IO'; +use PublicInbox::Spawn qw(which run_qx); + +# test failures: +SKIP: { +my $strace = strace_inject; +my $env = { PERL5LIB => join(':', @INC) }; +my $opt = { 1 => \my $out, 2 => \my $err }; +my $dst = "$tmpdir/dst"; +my $tr = "$tmpdir/tr"; +my $cmd = [ $strace, "-o$tr", "-P$dst", + '-e', 'inject=writev,write:error=EIO', + $^X, qw(-w -MPublicInbox::IO=write_file -e), + q[write_file '>', $ARGV[0], 'hello world'], $dst ]; +xsys($cmd, $env, $opt); +isnt($?, 0, 'write failed'); +like($err, qr/\bclose\b/, 'close error noted'); +is(-s $dst, 0, 'file created and empty after EIO'); +} # /SKIP + +PublicInbox::IO::write_file '>:unix', "$tmpdir/f", "HI\n"; +is(-s "$tmpdir/f", 3, 'write_file works w/ IO layer'); +PublicInbox::IO::write_file '>>', "$tmpdir/f", "HI\n"; +is(-s "$tmpdir/f", 6, 'write_file can append'); + +is PublicInbox::IO::try_cat("$tmpdir/non-existent"), '', + "try_cat on non-existent file returns `'"; + +done_testing; @@ -1,19 +1,17 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use v5.10.1; -use Test::More; +use v5.12; use PublicInbox::TestCommon; use Fcntl qw(SEEK_SET); -use Digest::SHA qw(sha1_hex); +use PublicInbox::SHA qw(sha1_hex); require_mods(qw(Storable||Sereal)); require_ok 'PublicInbox::IPC'; my ($tmpdir, $for_destroy) = tmpdir(); state $once = eval <<''; package PublicInbox::IPC; use strict; -use Digest::SHA qw(sha1_hex); +use PublicInbox::SHA qw(sha1_hex); sub test_array { qw(test array) } sub test_scalar { 'scalar' } sub test_scalarref { \'scalarref' } @@ -90,7 +88,6 @@ $test->('local'); defined($pid) or BAIL_OUT 'no spawn, no test'; is($ipc->ipc_do('test_pid'), $pid, 'worker pid returned'); $test->('worker'); - $ipc->ipc_lock_init("$tmpdir/lock"); is($ipc->ipc_do('test_pid'), $pid, 'worker pid returned'); $ipc->ipc_worker_stop; ok(!kill(0, $pid) && $!{ESRCH}, 'worker stopped'); @@ -109,7 +106,9 @@ open my $agpl, '<', 'COPYING' or BAIL_OUT "AGPL-3 missing: $!"; my $big = do { local $/; <$agpl> } // BAIL_OUT "read: $!"; close $agpl or BAIL_OUT "close: $!"; -for my $t ('local', 'worker', 'worker again') { +for my $t ('worker', 'worker again') { + my $ppid = $ipc->wq_workers_start('wq', 1); + push(@ppids, $ppid); $ipc->wq_io_do('test_write_each_fd', [ $wa, $wb, $wc ], 'hello world'); my $i = 0; for my $fh ($ra, $rb, $rc) { @@ -133,14 +132,19 @@ for my $t ('local', 'worker', 'worker again') { $exp = sha1_hex($bigger)."\n"; is(readline($rb), $exp, "SHA WQWorker limit ($t)"); } - my $ppid = $ipc->wq_workers_start('wq', 1); - push(@ppids, $ppid); + SKIP: { + $ENV{TEST_EXPENSIVE} or skip 'TEST_EXPENSIVE not set', 1; + my $bigger = $big x 75000; # over 2G to trigger partial sendmsg + $ipc->wq_io_do('test_sha', [ $wa, $wb ], $bigger); + my $exp = sha1_hex($bigger)."\n"; + is(readline($rb), $exp, "SHA WQWorker sendmsg limit ($t)"); + } } # wq_io_do works across fork (siblings can feed) SKIP: { skip 'Socket::MsgHdr or Inline::C missing', 3 if !$ppids[0]; - is_deeply(\@ppids, [$$, undef, undef], + is_xdeeply(\@ppids, [$$, undef], 'parent pid returned in wq_workers_start'); my $pid = fork // BAIL_OUT $!; if ($pid == 0) { @@ -174,10 +178,9 @@ SKIP: { skip 'Socket::MsgHdr or Inline::C missing', 11 if !$ppids[0]; seek($warn, 0, SEEK_SET) or BAIL_OUT; my @warn = <$warn>; - is(scalar(@warn), 3, 'warned 3 times'); - like($warn[0], qr/ wq_io_do: /, '1st warned from wq_do'); - like($warn[1], qr/ wq_worker: /, '2nd warned from wq_worker'); - is($warn[2], $warn[1], 'worker did not die'); + is(scalar(@warn), 2, 'warned 3 times'); + like($warn[0], qr/ wq_worker: /, '2nd warned from wq_worker'); + is($warn[0], $warn[1], 'worker did not die'); $SIG{__WARN__} = 'DEFAULT'; is($ipc->wq_workers_start('wq', 2), $$, 'workers started again'); diff --git a/t/kqnotify.t b/t/kqnotify.t index 902ce0f1..add477a4 100644 --- a/t/kqnotify.t +++ b/t/kqnotify.t @@ -1,37 +1,67 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> # # Ensure KQNotify can pick up rename(2) and link(2) operations # used by Maildir writing tools -use strict; -use Test::More; +use v5.12; use PublicInbox::TestCommon; -plan skip_all => 'KQNotify is only for *BSD systems' if $^O !~ /bsd/; +use autodie; +require_bsd; require_mods('IO::KQueue'); use_ok 'PublicInbox::KQNotify'; my ($tmpdir, $for_destroy) = tmpdir(); -mkdir "$tmpdir/new" or BAIL_OUT "mkdir: $!"; -open my $fh, '>', "$tmpdir/tst" or BAIL_OUT "open: $!"; -close $fh or BAIL_OUT "close: $!"; +mkdir "$tmpdir/new"; my $kqn = PublicInbox::KQNotify->new; my $mask = PublicInbox::KQNotify::MOVED_TO_OR_CREATE(); my $w = $kqn->watch("$tmpdir/new", $mask); -rename("$tmpdir/tst", "$tmpdir/new/tst") or BAIL_OUT "rename: $!"; +open my $fh, '>', "$tmpdir/tst"; +close $fh; +rename("$tmpdir/tst", "$tmpdir/new/tst"); my $hit = [ map { $_->fullname } $kqn->read ]; -is_deeply($hit, ["$tmpdir/new/tst"], 'rename(2) detected (via NOTE_EXTEND)'); +is_deeply($hit, ["$tmpdir/new/tst"], + 'rename(2) detected (via NOTE_EXTEND)') + or diag explain($hit); -open $fh, '>', "$tmpdir/tst" or BAIL_OUT "open: $!"; -close $fh or BAIL_OUT "close: $!"; -link("$tmpdir/tst", "$tmpdir/new/link") or BAIL_OUT "link: $!"; -$hit = [ grep m!/link$!, map { $_->fullname } $kqn->read ]; -is_deeply($hit, ["$tmpdir/new/link"], 'link(2) detected (via NOTE_WRITE)'); +open $fh, '>', "$tmpdir/tst"; +close $fh; +link("$tmpdir/tst", "$tmpdir/new/link"); +my @read = map { $_->fullname } $kqn->read; +$hit = [ grep(m!/link$!, @read) ]; +is_deeply($hit, ["$tmpdir/new/link"], 'link(2) detected (via NOTE_WRITE)') + or diag explain(\@read); + +{ + my $d = "$tmpdir/new/ANOTHER"; + mkdir $d; + $hit = [ map { $_->fullname } $kqn->read ]; + is_xdeeply($hit, [ $d ], 'mkdir detected'); + rmdir $d; + # TODO: should we always watch for directory removals? +} $w->cancel; -link("$tmpdir/new/tst", "$tmpdir/new/link2") or BAIL_OUT "link: $!"; +link("$tmpdir/new/tst", "$tmpdir/new/link2"); $hit = [ map { $_->fullname } $kqn->read ]; is_deeply($hit, [], 'link(2) not detected after cancel'); +# rearm: +my $GONE = PublicInbox::KQNotify::NOTE_DELETE() | + PublicInbox::KQNotify::NOTE_REVOKE() | + PublicInbox::KQNotify::NOTE_ATTRIB() | + PublicInbox::KQNotify::NOTE_WRITE() | + PublicInbox::KQNotify::NOTE_RENAME(); +$w = $kqn->watch("$tmpdir/new", $mask|$GONE); +my @unlink = sort glob("$tmpdir/new/*"); +unlink(@unlink); +$hit = [ sort(map { $_->fullname } $kqn->read) ]; +is_xdeeply($hit, \@unlink, 'unlinked files match'); + +# this is unreliable on Dragonfly tmpfs (fixed post-6.4) +rmdir "$tmpdir/new"; +$hit = [ sort(map { $_->fullname } $kqn->read) ]; +is(scalar(@$hit), 1, 'detected self removal') or check_broken_tmpfs; + done_testing; diff --git a/t/lei-auto-watch.t b/t/lei-auto-watch.t index f871188d..1e190316 100644 --- a/t/lei-auto-watch.t +++ b/t/lei-auto-watch.t @@ -4,10 +4,10 @@ use strict; use v5.10.1; use PublicInbox::TestCommon; use File::Basename qw(basename); plan skip_all => "TEST_FLAKY not enabled for $0" if !$ENV{TEST_FLAKY}; -my $have_fast_inotify = eval { require Linux::Inotify2 } || +my $have_fast_inotify = eval { require PublicInbox::Inotify } || eval { require IO::KQueue }; $have_fast_inotify or - diag("$0 IO::KQueue or Linux::Inotify2 missing, test will be slow"); + diag("$0 IO::KQueue or inotify missing, test will be slow"); test_lei(sub { my ($ro_home, $cfg_path) = setup_public_inboxes; diff --git a/t/lei-convert.t b/t/lei-convert.t index e1849ff7..4670e47f 100644 --- a/t/lei-convert.t +++ b/t/lei-convert.t @@ -1,12 +1,16 @@ #!perl -w -# Copyright (C) 2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; use v5.10.1; use PublicInbox::TestCommon; +use v5.12; use PublicInbox::TestCommon; use PublicInbox::MboxReader; use PublicInbox::MdirReader; use PublicInbox::NetReader; use PublicInbox::Eml; use IO::Uncompress::Gunzip; +use File::Path qw(remove_tree); +use PublicInbox::Spawn qw(which run_qx); +use File::Compare; +use autodie qw(open); require_mods(qw(lei -imapd -nntpd Mail::IMAPClient Net::NNTP)); my ($tmpdir, $for_destroy) = tmpdir; my $sock = tcp_server; @@ -25,8 +29,36 @@ test_lei({ tmpdir => $tmpdir }, sub { my $d = $ENV{HOME}; lei_ok('convert', '-o', "mboxrd:$d/foo.mboxrd", "imap://$imap_host_port/t.v2.0"); + my ($nc0) = ($lei_err =~ /converted (\d+) messages/); ok(-f "$d/foo.mboxrd", 'mboxrd created from imap://'); + lei_ok qw(convert -o), "v2:$d/v2-test", "mboxrd:$d/foo.mboxrd"; + my ($nc) = ($lei_err =~ /converted (\d+) messages/); + is $nc, $nc0, 'converted all messages messages'; + lei_ok qw(q z:0.. -f jsonl --only), "$d/v2-test"; + is(scalar(split(/^/sm, $lei_out)), $nc, 'got all messages in v2-test'); + + lei_ok qw(convert -o), "mboxrd:$d/from-v2.mboxrd", "$d/v2-test"; + like $lei_err, qr/converted $nc messages/; + is(compare("$d/foo.mboxrd", "$d/from-v2.mboxrd"), 0, + 'convert mboxrd -> v2 ->mboxrd roundtrip') or + diag run_qx([qw(git diff --no-index), + "$d/foo.mboxrd", "$d/from-v2.mboxrd"]); + + lei_ok [qw(convert -F eml -o), "$d/v2-test"], undef, + { 0 => \<<'EOM', %$lei_opt }; +From: f@example.com +To: t@example.com +Subject: append-to-v2-on-convert +Message-ID: <append-to-v2-on-convert@example> +Date: Fri, 02 Oct 1993 00:00:00 +0000 +EOM + like $lei_err, qr/converted 1 messages/, 'only one message added'; + lei_ok qw(q z:0.. -f jsonl --only), "$d/v2-test"; + is(scalar(split(/^/sm, $lei_out)), $nc + 1, + 'got expected number of messages after append convert'); + like $lei_out, qr/append-to-v2-on-convert/; + lei_ok('convert', '-o', "mboxrd:$d/nntp.mboxrd", "nntp://$nntp_host_port/t.v2"); ok(-f "$d/nntp.mboxrd", 'mboxrd created from nntp://'); @@ -125,5 +157,65 @@ test_lei({ tmpdir => $tmpdir }, sub { like($md[0], qr/:2,S\z/, "`seen' flag set in Maildir"); lei_ok(qw(convert -o mboxrd:/dev/stdout), "$d/md2"); like($lei_out, qr/^Status: RO/sm, "`seen' flag preserved"); + + SKIP: { + my $ok; + for my $x (($ENV{GZIP}//''), qw(pigz gzip)) { + $x && (`$x -h 2>&1`//'') =~ /--rsyncable\b/s or next; + $ok = $x; + last; + } + skip 'pigz || gzip do not support --rsyncable', 1 if !$ok; + lei_ok qw(convert --rsyncable), "mboxrd:$d/qp.gz", + '-o', "mboxcl2:$d/qp2.gz"; + undef $fh; # necessary to make IO::Uncompress::Gunzip happy + open $fh, '<', "$d/qp2.gz"; + $fh = IO::Uncompress::Gunzip->new($fh, MultiStream => 1); + my @tmp; + PublicInbox::MboxReader->mboxcl2($fh, sub { + my ($eml) = @_; + $eml->header_set($_) for qw(Content-Length Lines); + push @tmp, $eml; + }); + is_deeply(\@tmp, \@bar, 'read rsyncable-gzipped mboxcl2'); + } + my $cp = which('cp') or xbail 'cp(1) not available (WTF?)'; + for my $v (1, 2) { + my $ibx_dir = "$ro_home/t$v"; + lei_ok qw(convert -f mboxrd), $ibx_dir, + \"dump v$v inbox to mboxrd"; + my $out = $lei_out; + lei_ok qw(convert -f mboxrd), "v$v:$ibx_dir", + \"dump v$v inbox to mboxrd w/ v$v:// prefix"; + is $out, $lei_out, "v$v:// prefix accepted"; + open my $fh, '<', \$out; + my (@mb, @md, @md2); + PublicInbox::MboxReader->mboxrd($fh, sub { + $_[0]->header_set('Status'); + push @mb, $_[0]->as_string; + }); + undef $out; + ok(scalar(@mb), 'got messages output'); + my $mdir = "$d/v$v-mdir"; + lei_ok qw(convert -o), $mdir, $ibx_dir, + \"dump v$v inbox to Maildir"; + PublicInbox::MdirReader->new->maildir_each_eml($mdir, sub { + push @md, $_[2]->as_string; + }); + @md = sort { $a cmp $b } @md; + @mb = sort { $a cmp $b } @mb; + is_deeply(\@mb, \@md, 'got matching inboxes'); + xsys_e([$cp, '-Rp', $ibx_dir, "$d/tv$v" ]); + remove_tree($mdir, "$d/tv$v/public-inbox", + glob("$d/tv$v/xap*")); + + lei_ok qw(convert -o), $mdir, "$d/tv$v", + \"dump u indexed v$v inbox to Maildir"; + PublicInbox::MdirReader->new->maildir_each_eml($mdir, sub { + push @md2, $_[2]->as_string; + }); + @md2 = sort { $a cmp $b } @md2; + is_deeply(\@md, \@md2, 'got matching inboxes even unindexed'); + } }); done_testing; diff --git a/t/lei-daemon.t b/t/lei-daemon.t index e11105bc..d97e494a 100644 --- a/t/lei-daemon.t +++ b/t/lei-daemon.t @@ -2,7 +2,7 @@ # Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use PublicInbox::TestCommon; -use Socket qw(AF_UNIX SOCK_SEQPACKET MSG_EOR pack_sockaddr_un); +use Socket qw(AF_UNIX SOCK_SEQPACKET pack_sockaddr_un); test_lei({ daemon_only => 1 }, sub { my $send_cmd = PublicInbox::Spawn->can('send_cmd4') // do { @@ -21,6 +21,7 @@ test_lei({ daemon_only => 1 }, sub { is($lei_err, '', 'no error from daemon-pid'); like($lei_out, qr/\A[0-9]+\n\z/s, 'pid returned') or BAIL_OUT; chomp(my $pid = $lei_out); + no_pollerfd($pid); ok(kill(0, $pid), 'pid is valid'); ok(-S $sock, 'sock created'); is(-s $err_log, 0, 'nothing in errors.log'); @@ -31,7 +32,7 @@ test_lei({ daemon_only => 1 }, sub { SKIP: { skip 'only testing open files on Linux', 1 if $^O ne 'linux'; my $d = "/proc/$pid/fd"; - skip "no $d on Linux" unless -d $d; + skip "no $d on Linux", 1 unless -d $d; my @before = sort(glob("$d/*")); my $addr = pack_sockaddr_un($sock); open my $null, '<', '/dev/null' or BAIL_OUT "/dev/null: $!"; @@ -40,7 +41,7 @@ test_lei({ daemon_only => 1 }, sub { socket(my $c, AF_UNIX, SOCK_SEQPACKET, 0) or BAIL_OUT "socket: $!"; connect($c, $addr) or BAIL_OUT "connect: $!"; - $send_cmd->($c, \@fds, 'hi', MSG_EOR); + $send_cmd->($c, \@fds, 'hi', 0); } lei_ok('daemon-pid'); chomp($pid = $lei_out); diff --git a/t/lei-externals.t b/t/lei-externals.t index 284be1b9..4f2dd6ba 100644 --- a/t/lei-externals.t +++ b/t/lei-externals.t @@ -4,7 +4,7 @@ use strict; use v5.10.1; use PublicInbox::TestCommon; use Fcntl qw(SEEK_SET); require_git 2.6; -require_mods(qw(json DBD::SQLite Search::Xapian)); +require_mods(qw(json DBD::SQLite Xapian)); use POSIX qw(WTERMSIG WIFSIGNALED SIGPIPE); my @onions = map { "http://$_.onion/meta/" } qw( @@ -48,6 +48,7 @@ SKIP: { $tp->join; ok(WIFSIGNALED($?), "signaled @$out"); is(WTERMSIG($?), SIGPIPE, "got SIGPIPE @$out"); + no_coredump; seek($err, 0, 0); my @err = <$err>; is_deeply(\@err, [], "no errors @$out"); @@ -66,6 +67,7 @@ SKIP: { tick(); } ok(!$alive, 'daemon-kill worked'); + no_coredump; } } # /SKIP }; # /sub diff --git a/t/lei-import-nntp.t b/t/lei-import-nntp.t index eb1ae312..14c644e0 100644 --- a/t/lei-import-nntp.t +++ b/t/lei-import-nntp.t @@ -1,9 +1,9 @@ #!perl -w -# Copyright (C) 2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use PublicInbox::TestCommon; require_git 2.6; -require_mods(qw(json DBD::SQLite Search::Xapian Net::NNTP)); +require_mods(qw(lei json DBD::SQLite Xapian Net::NNTP)); my ($ro_home, $cfg_path) = setup_public_inboxes; my ($tmpdir, $for_destroy) = tmpdir; my $sock = tcp_server; @@ -43,7 +43,8 @@ test_lei({ tmpdir => $tmpdir }, sub { lei_ok 'ls-mail-sync'; like($lei_out, qr!\A\Q$url\E\n\z!, 'ls-mail-sync output as-expected'); - ok(!lei(qw(import), "$url/12-1"), 'backwards range rejected'); + ok(!lei(qw(import), "$url/12-1"), 'backwards range rejected') or + diag $lei_err; # new home local $ENV{HOME} = "$tmpdir/h2"; diff --git a/t/lei-import.t b/t/lei-import.t index 6e9a853c..89eb1492 100644 --- a/t/lei-import.t +++ b/t/lei-import.t @@ -1,14 +1,17 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; use v5.10.1; use PublicInbox::TestCommon; +use v5.12; use PublicInbox::TestCommon; +use PublicInbox::DS qw(now); +use PublicInbox::IO qw(write_file); +use autodie qw(open close truncate); test_lei(sub { ok(!lei(qw(import -F bogus), 't/plack-qp.eml'), 'fails with bogus format'); like($lei_err, qr/\bis `eml', not --in-format/, 'gave error message'); lei_ok(qw(q s:boolean), \'search miss before import'); unlike($lei_out, qr/boolean/i, 'no results, yet'); -open my $fh, '<', 't/data/0001.patch' or BAIL_OUT $!; +open my $fh, '<', 't/data/0001.patch'; lei_ok([qw(import -F eml -)], undef, { %$lei_opt, 0 => $fh }, \'import single file from stdin') or diag $lei_err; close $fh; @@ -18,7 +21,7 @@ lei_ok(qw(q s:boolean -f mboxrd), \'blob accessible after import'); my $expect = [ eml_load('t/data/0001.patch') ]; require PublicInbox::MboxReader; my @cmp; - open my $fh, '<', \$lei_out or BAIL_OUT "open :scalar: $!"; + open my $fh, '<', \$lei_out; PublicInbox::MboxReader->mboxrd($fh, sub { my ($eml) = @_; $eml->header_set('Status'); @@ -110,6 +113,119 @@ $res = json_utf8->decode($lei_out); is_deeply($res->[0]->{kw}, ['seen'], 'keyword set'); is_deeply($res->[0]->{L}, ['inbox'], 'label set'); +# idempotent import can add label +lei_ok([qw(import -F eml - +L:boombox)], + undef, { %$lei_opt, 0 => \$eml_str }); +lei_ok(qw(q m:inbox@example.com)); +$res = json_utf8->decode($lei_out); +is_deeply($res->[0]->{kw}, ['seen'], 'keyword remains set'); +is_deeply($res->[0]->{L}, [qw(boombox inbox)], 'new label added'); + +# idempotent import can add keyword +lei_ok([qw(import -F eml - +kw:answered)], + undef, { %$lei_opt, 0 => \$eml_str }); +lei_ok(qw(q m:inbox@example.com)); +$res = json_utf8->decode($lei_out); +is_deeply($res->[0]->{kw}, [qw(answered seen)], 'keyword added'); +is_deeply($res->[0]->{L}, [qw(boombox inbox)], 'labels preserved'); + +# +kw:seen is not a location +open my $null, '<', '/dev/null'; +ok(!lei([qw(import -F eml +kw:seen)], undef, { %$lei_opt, 0 => $null }), + 'import fails w/ only kw arg'); +like($lei_err, qr/\bLOCATION\.\.\. or --stdin must be set/s, 'error message'); + +lei_ok([qw(import -F eml +kw:flagged)], # no lone dash (`-') + undef, { %$lei_opt, 0 => \$eml_str }, + 'import succeeds with implicit --stdin'); +lei_ok(qw(q m:inbox@example.com)); +$res = json_utf8->decode($lei_out); +is_deeply($res->[0]->{kw}, [qw(answered flagged seen)], 'keyword added'); +is_deeply($res->[0]->{L}, [qw(boombox inbox)], 'labels preserved'); + +lei_ok qw(import --commit-delay=1 +L:bin -F eml t/data/binary.patch); +lei_ok 'ls-label'; +unlike($lei_out, qr/\bbin\b/, 'commit-delay delays label'); +my $end = now + 10; +my $n = 1; +diag 'waiting for lei/store commit...'; +do { + tick $n; + $n = 0.1; +} until (!lei('ls-label') || $lei_out =~ /\bbin\b/ || now > $end); +like($lei_out, qr/\bbin\b/, 'commit-delay eventually commits'); + +SKIP: { + my $strace = strace_inject(1); # skips if strace is old or non-Linux + my $tmpdir = tmpdir; + my $tr = "$tmpdir/tr"; + my $cmd = [ $strace, '-q', "-o$tr", '-f', + "-P", File::Spec->rel2abs('t/plack-qp.eml'), + '-e', 'inject=readv,read:error=EIO']; + lei_ok qw(daemon-pid); + chomp(my $daemon_pid = $lei_out); + push @$cmd, '-p', $daemon_pid; + require PublicInbox::Spawn; + require PublicInbox::AutoReap; + my $pid = PublicInbox::Spawn::spawn($cmd, \%ENV); + my $ar = PublicInbox::AutoReap->new($pid); + tick; # wait for strace to attach + ok(!lei(qw(import -F eml t/plack-qp.eml)), + '-F eml import fails on pathname error injection'); + my $IO = '[Ii](?:nput)?/[Oo](?:utput)?'; + like($lei_err, qr!error reading t/plack-qp\.eml: .*?$IO error!, + 'EIO noted in stderr'); + open $fh, '<', 't/plack-qp.eml'; + ok(!lei(qw(import -F eml -), undef, { %$lei_opt, 0 => $fh }), + '-F eml import fails on stdin error injection'); + like($lei_err, qr!error reading .*?: .*?$IO error!, + 'EIO noted in stderr'); +} + +{ + local $ENV{PI_CONFIG} = "$ENV{HOME}/pi_config"; + write_file '>', $ENV{PI_CONFIG}, <<EOM; +[publicinboxImport] + dropUniqueUnsubscribe +EOM + my $in = <<EOM; +List-Unsubscribe: <https://example.com/some-UUID-here/test> +List-Unsubscribe-Post: List-Unsubscribe=One-Click +Message-ID: <unsubscribe-1\@example> +Subject: unsubscribe-1 example +From: u\@example.com +To: 2\@example.com +Date: Fri, 02 Oct 1993 00:00:00 +0000 + +EOM + lei_ok [qw(import -F eml +L:unsub)], undef, { %$lei_opt, 0 => \$in }, + 'import succeeds w/ List-Unsubscribe'; + lei_ok qw(q L:unsub -f mboxrd); + like $lei_out, qr/some-UUID-here/, + 'Unsubscribe header preserved despite PI_CONFIG dropping'; + lei_ok qw(q L:unsub -o), "v2:$ENV{HOME}/v2-1"; + lei_ok qw(q s:unsubscribe -f mboxrd --only), "$ENV{HOME}/v2-1"; + unlike $lei_out, qr/some-UUID-here/, + 'Unsubscribe header dropped w/ dropUniqueUnsubscribe'; + like $lei_out, qr/Message-ID: <unsubscribe-1\@example>/, + 'wrote expected message to v2 output'; + + # the default for compatibility: + truncate $ENV{PI_CONFIG}, 0; + lei_ok qw(q L:unsub -o), "v2:$ENV{HOME}/v2-2"; + lei_ok qw(q s:unsubscribe -f mboxrd --only), "$ENV{HOME}/v2-2"; + like $lei_out, qr/some-UUID-here/, + 'Unsubscribe header preserved by default :<'; + + # ensure we can fail + write_file '>', $ENV{PI_CONFIG}, <<EOM; +[publicinboxImport] + dropUniqueUnsubscribe = bogus +EOM + ok(!lei(qw(q L:unsub -o), "v2:$ENV{HOME}/v2-3"), 'bad config fails'); + like $lei_err, qr/is not boolean/, 'non-booleaness noted in stderr'; + ok !-d "$ENV{HOME}/v2-3", 'v2 directory not created'; +} # see t/lei_to_mail.t for "import -F mbox*" }); diff --git a/t/lei-index.t b/t/lei-index.t index aab8f7e6..2b28f1be 100644 --- a/t/lei-index.t +++ b/t/lei-index.t @@ -1,5 +1,5 @@ #!perl -w -# Copyright (C) 2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use PublicInbox::TestCommon; use File::Spec; @@ -48,9 +48,10 @@ symlink(File::Spec->rel2abs('t/mda-mime.eml'), "$tmpdir/md1/cur/x:2,S") or test_lei({ tmpdir => $tmpdir }, sub { my $store_path = "$ENV{HOME}/.local/share/lei/store/"; - lei_ok('index', "$tmpdir/md"); + lei_ok qw(index +L:md), "$tmpdir/md"; lei_ok(qw(q mid:qp@example.com)); my $res_a = json_utf8->decode($lei_out); + is_deeply $res_a->[0]->{L}, [ 'md' ], 'label set on index'; my $blob = $res_a->[0]->{'blob'}; like($blob, qr/\A[0-9a-f]{40,}\z/, 'got blob from qp@example'); lei_ok(qw(-C / blob), $blob); @@ -85,6 +86,10 @@ test_lei({ tmpdir => $tmpdir }, sub { lei_ok qw(q m:multipart-html-sucks@11); is_deeply(json_utf8->decode($lei_out)->[0]->{'kw'}, ['seen'], 'keyword set'); + lei_ok 'reindex'; + lei_ok qw(q m:multipart-html-sucks@11); + is_deeply(json_utf8->decode($lei_out)->[0]->{'kw'}, + ['seen'], 'keyword still set after reindex'); $srv->{nntpd} and lei_ok('index', "nntp://$srv->{nntp_host_port}/t.v2"); @@ -104,6 +109,12 @@ test_lei({ tmpdir => $tmpdir }, sub { my $t = xqx(['git', "--git-dir=$store_path/ALL.git", qw(cat-file -t), $res_b->{blob}]); is($t, "blob\n", 'got blob'); + + lei_ok('reindex'); + lei_ok qw(q m:multipart-html-sucks@11); + $res_a = json_utf8->decode($lei_out)->[0]; + is_deeply($res_a->{'kw'}, ['seen'], + 'keywords still set after reindex'); }); done_testing; diff --git a/t/lei-mail-diff.t b/t/lei-mail-diff.t new file mode 100644 index 00000000..1a896e51 --- /dev/null +++ b/t/lei-mail-diff.t @@ -0,0 +1,15 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use v5.12; use PublicInbox::TestCommon; + +test_lei(sub { + ok(!lei('mail-diff', 't/data/0001.patch', 't/data/binary.patch'), + 'different messages are different'); + like($lei_out, qr/^\+/m, 'diff shown'); + unlike $lei_out, qr/No newline at end of file/; + lei_ok('mail-diff', 't/data/0001.patch', 't/data/0001.patch'); + is($lei_out, '', 'no output if identical'); +}); + +done_testing; diff --git a/t/lei-mirror.t b/t/lei-mirror.t index 32a5b039..76041b73 100644 --- a/t/lei-mirror.t +++ b/t/lei-mirror.t @@ -1,10 +1,12 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; use v5.10.1; use PublicInbox::TestCommon; +use v5.12; use PublicInbox::TestCommon; use PublicInbox::Inbox; require_mods(qw(-httpd lei DBD::SQLite)); require_cmd('curl'); +require_git_http_backend; +use PublicInbox::Spawn qw(which); require PublicInbox::Msgmap; my $sock = tcp_server(); my ($tmpdir, $for_destroy) = tmpdir(); @@ -22,9 +24,16 @@ test_lei({ tmpdir => $tmpdir }, sub { lei_ok('add-external', $t1, '--mirror', "$http/t1/", \'--mirror v1'); my $mm_dup = "$t1/public-inbox/msgmap.sqlite3"; ok(-f $mm_dup, 't1-mirror indexed'); - is(PublicInbox::Inbox::try_cat("$t1/description"), + is(PublicInbox::IO::try_cat("$t1/description"), "mirror of $http/t1/\n", 'description set'); ok(-f "$t1/Makefile", 'convenience Makefile added (v1)'); + SKIP: { + my $make = require_cmd('make', 1); + delete local @ENV{qw(MFLAGS MAKEFLAGS MAKELEVEL)}; + is(xsys([$make, 'help'], undef, { -C => $t1, 1 => \(my $help) }), + 0, "$make handled Makefile without errors"); + isnt($help, '', 'make help worked'); + } ok(-f "$t1/inbox.config.example", 'inbox.config.example downloaded'); is((stat(_))[9], $created{v1}, 'inbox.config.example mtime is ->created_at'); @@ -43,7 +52,7 @@ test_lei({ tmpdir => $tmpdir }, sub { ok(-f $mm_dup, 't2-mirror indexed'); ok(-f "$t2/description", 't2 description'); ok(-f "$t2/Makefile", 'convenience Makefile added (v2)'); - is(PublicInbox::Inbox::try_cat("$t2/description"), + is(PublicInbox::IO::try_cat("$t2/description"), "mirror of $http/t2/\n", 'description set'); $tb = PublicInbox::Msgmap->new_file($mm_dup)->created_at; is($tb, $created{v2}, 'created_at matched in v2 mirror'); @@ -199,14 +208,14 @@ $td->join; my $exp = "mirror of https://example.com/src/\n"; my $f = "$tmpdir/description"; PublicInbox::LeiMirror::set_description($mrr); - is(PublicInbox::Inbox::try_cat($f), $exp, 'description set on ENOENT'); + is(PublicInbox::IO::try_cat($f), $exp, 'description set on ENOENT'); my $fh; (open($fh, '>', $f) and close($fh)) or xbail $!; PublicInbox::LeiMirror::set_description($mrr); - is(PublicInbox::Inbox::try_cat($f), $exp, 'description set on empty'); + is(PublicInbox::IO::try_cat($f), $exp, 'description set on empty'); (open($fh, '>', $f) and print $fh "x\n" and close($fh)) or xbail $!; - is(PublicInbox::Inbox::try_cat($f), "x\n", + is(PublicInbox::IO::try_cat($f), "x\n", 'description preserved if non-default'); } diff --git a/t/lei-p2q.t b/t/lei-p2q.t index bf40a43b..44f37d19 100644 --- a/t/lei-p2q.t +++ b/t/lei-p2q.t @@ -3,7 +3,7 @@ # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use PublicInbox::TestCommon; require_git 2.6; -require_mods(qw(json DBD::SQLite Search::Xapian)); +require_mods(qw(json DBD::SQLite Xapian)); test_lei(sub { ok(!lei(qw(p2q this-better-cause-format-patch-to-fail)), diff --git a/t/lei-q-kw.t b/t/lei-q-kw.t index 4edee72a..63e46037 100644 --- a/t/lei-q-kw.t +++ b/t/lei-q-kw.t @@ -1,5 +1,5 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use PublicInbox::TestCommon; use POSIX qw(mkfifo); @@ -9,6 +9,8 @@ use IO::Compress::Gzip qw(gzip); use PublicInbox::MboxReader; use PublicInbox::LeiToMail; use PublicInbox::Spawn qw(popen_rd); +use File::Path qw(make_path); +use PublicInbox::IO qw(write_file); my $exp = { '<qp@example.com>' => eml_load('t/plack-qp.eml'), '<testmessage@example.com>' => eml_load('t/utf8.eml'), @@ -42,6 +44,19 @@ lei_ok(qw(q -o), "maildir:$o", qw(m:qp@example.com)); @fn = glob("$o/cur/*:2,S"); is(scalar(@fn), 1, "`seen' flag (but not `replied') set on Maildir file"); +{ + $o = "$ENV{HOME}/dst-existing"; + make_path(map { "$o/$_" } qw(new cur tmp)); + my $bp = eml_load('t/data/binary.patch'); + write_file '>', "$o/cur/binary-patch:2,S", $bp->as_string; + lei_ok qw(q --no-import-before m:qp@example.com -o), $o; + my @g = glob("$o/*/*"); + is scalar(@g), 1, 'only newly imported message left'; + is eml_load($g[0])->header_raw('Message-ID'), '<qp@example.com>'; + lei qw(q m:binary-patch-test@example); + is $lei_out, "[null]\n", 'old message not imported'; +} + SKIP: { $o = "$ENV{HOME}/fifo"; mkfifo($o, 0600) or skip("mkfifo not supported: $!", 1); @@ -51,7 +66,7 @@ SKIP: { '--import-before fails on non-seekable output'); like($lei_err, qr/not seekable/, 'unseekable noted in error'); is(do { local $/; <$cat> }, '', 'no output on FIFO'); - close $cat; + $cat->close; $cat = popen_rd(['cat', $o]); lei_ok(qw(q m:qp@example.com -o), "mboxrd:$o"); my $buf = do { local $/; <$cat> }; @@ -80,9 +95,7 @@ my $write_file = sub { if ($_[0] =~ /\.gz\z/) { gzip(\($_[1]), $_[0]) or BAIL_OUT 'gzip'; } else { - open my $fh, '>', $_[0] or BAIL_OUT $!; - print $fh $_[1] or BAIL_OUT $!; - close $fh or BAIL_OUT; + write_file '>', $_[0], $_[1]; } }; diff --git a/t/lei-q-remote-import.t b/t/lei-q-remote-import.t index 92d8c9b6..885fa3e1 100644 --- a/t/lei-q-remote-import.t +++ b/t/lei-q-remote-import.t @@ -1,7 +1,8 @@ #!perl -w -# Copyright (C) 2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; use v5.10.1; use PublicInbox::TestCommon; +use v5.12; use PublicInbox::TestCommon; +use autodie qw(open close unlink); require_mods(qw(lei -httpd)); require_cmd 'curl'; use PublicInbox::MboxReader; @@ -16,7 +17,7 @@ my $url = "http://$host_port/t2/"; my $exp1 = [ eml_load('t/plack-qp.eml') ]; my $exp2 = [ eml_load('t/iso-2202-jp.eml') ]; my $slurp_emls = sub { - open my $fh, '<', $_[0] or BAIL_OUT "open: $!"; + open my $fh, '<', $_[0]; my @eml; PublicInbox::MboxReader->mboxrd($fh, sub { my $eml = shift; @@ -31,33 +32,33 @@ test_lei({ tmpdir => $tmpdir }, sub { my @cmd = ('q', '-o', "mboxrd:$o", 'm:qp@example.com'); lei_ok(@cmd); ok(-f $o && !-s _, 'output exists but is empty'); - unlink $o or BAIL_OUT $!; + unlink $o; lei_ok(@cmd, '-I', $url); is_deeply($slurp_emls->($o), $exp1, 'got results after remote search'); - unlink $o or BAIL_OUT $!; + unlink $o; lei_ok(@cmd); ok(-f $o && -s _, 'output exists after import but is not empty') or diag $lei_err; is_deeply($slurp_emls->($o), $exp1, 'got results w/o remote search'); - unlink $o or BAIL_OUT $!; + unlink $o; $cmd[-1] = 'm:199707281508.AAA24167@hoyogw.example'; lei_ok(@cmd, '-I', $url, '--no-import-remote'); is_deeply($slurp_emls->($o), $exp2, 'got another after remote search'); - unlink $o or BAIL_OUT $!; + unlink $o; lei_ok(@cmd); ok(-f $o && !-s _, '--no-import-remote did not memoize'); open my $fh, '>', "$o.lock"; $cmd[-1] = 'm:qp@example.com'; - unlink $o or xbail("unlink $o $! cwd=".Cwd::getcwd()); + unlink $o; lei_ok(@cmd, '--lock=none'); ok(-f $o && -s _, '--lock=none respected') or diag $lei_err; - unlink $o or xbail("unlink $o $! cwd=".Cwd::getcwd()); + unlink $o; ok(!lei(@cmd, '--lock=dotlock,timeout=0.000001'), 'dotlock fails'); like($lei_err, qr/dotlock timeout/, 'timeout noted'); ok(-f $o && !-s _, 'nothing output on lock failure'); - unlink "$o.lock" or BAIL_OUT $!; + unlink "$o.lock"; lei_ok(@cmd, '--lock=dotlock,timeout=0.000001', \'succeeds after lock removal'); @@ -76,8 +77,8 @@ test_lei({ tmpdir => $tmpdir }, sub { 'm:testmessage@example.com'); is($lei_out, '', 'message not imported when in local external'); - open $fh, '>', $o or BAIL_OUT; - print $fh <<'EOF' or BAIL_OUT; + open $fh, '>', $o; + print $fh <<'EOF'; From a@z Mon Sep 17 00:00:00 2001 From: nobody@localhost Date: Sat, 13 Mar 2021 18:23:01 +0600 @@ -86,7 +87,7 @@ Status: OR whatever EOF - close $fh or BAIL_OUT; + close $fh; lei_ok(qw(q -o), "mboxrd:$o", 'm:testmessage@example.com'); is_deeply($slurp_emls->($o), [$exp], 'got expected result after clobber') or diag $lei_err; @@ -103,5 +104,11 @@ EOF lei_ok([qw(edit-search), "$ENV{HOME}/md"], $edit_env); like($lei_out, qr/^\Q[external "$url"]\E\n\s*lastresult = \d+/sm, 'lastresult set'); + + unlink $o; + lei_ok qw(q --no-save -q m:never2exist@example.com -o), "mboxrd:$o", + '--only', $url, + \'404 curl exit (22) does not influence lei(1)'; + is(-s $o, 0, 'empty result'); }); done_testing; diff --git a/t/lei-q-save.t b/t/lei-q-save.t index 3d09fe37..0970bc3c 100644 --- a/t/lei-q-save.t +++ b/t/lei-q-save.t @@ -1,7 +1,8 @@ #!perl -w -# Copyright (C) 2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; use v5.10.1; use PublicInbox::TestCommon; +use v5.12; use PublicInbox::TestCommon; +use autodie qw(close open unlink); use PublicInbox::Smsg; use List::Util qw(sum); use File::Path qw(remove_tree); @@ -12,9 +13,10 @@ my $doc2 = eml_load('t/utf8.eml'); $doc2->header_set('Date', PublicInbox::Smsg::date({ds => time - (86400 * 4)})); my $doc3 = eml_load('t/msg_iter-order.eml'); $doc3->header_set('Date', PublicInbox::Smsg::date({ds => time - (86400 * 4)})); - +my $cat_env = { VISUAL => 'cat', EDITOR => 'cat' }; my $pre_existing = <<'EOF'; From x Mon Sep 17 00:00:00 2001 +From: <x@example.com> Message-ID: <import-before@example.com> Subject: pre-existing Date: Sat, 02 Oct 2010 00:00:00 +0000 @@ -88,7 +90,7 @@ test_lei(sub { like($lei_out, qr!^\Q$home/mbcl2\E$!sm, 'complete got mbcl2 output'); like($lei_out, qr!^\Q$home/md\E$!sm, 'complete got maildir output'); - unlink("$home/mbcl2") or xbail "unlink $!"; + unlink("$home/mbcl2"); lei_ok qw(_complete lei up); like($lei_out, qr!^\Q$home/mbcl2\E$!sm, 'mbcl2 output shown despite unlink'); @@ -96,24 +98,24 @@ test_lei(sub { ok(-f "$home/mbcl2" && -s _ == 0, 'up recreates on missing output'); # no --augment - open my $mb, '>', "$home/mbrd" or xbail "open $!"; + open my $mb, '>', "$home/mbrd"; print $mb $pre_existing; - close $mb or xbail "close: $!"; + close $mb; lei_ok(qw(q -o mboxrd:mbrd m:qp@example.com -C), $home); - open $mb, '<', "$home/mbrd" or xbail "open $!"; + open $mb, '<', "$home/mbrd"; is_deeply([grep(/pre-existing/, <$mb>)], [], 'pre-existing messsage gone w/o augment'); - close $mb; + undef $mb; lei_ok(qw(q m:import-before@example.com)); is(json_utf8->decode($lei_out)->[0]->{'s'}, 'pre-existing', '--save imported before clobbering'); # --augment - open $mb, '>', "$home/mbrd-aug" or xbail "open $!"; + open $mb, '>', "$home/mbrd-aug"; print $mb $pre_existing; - close $mb or xbail "close: $!"; + close $mb; lei_ok(qw(q -a -o mboxrd:mbrd-aug m:qp@example.com -C), $home); - open $mb, '<', "$home/mbrd-aug" or xbail "open $!"; + open $mb, '<', "$home/mbrd-aug"; $mb = do { local $/; <$mb> }; like($mb, qr/pre-existing/, 'pre-existing message preserved w/ -a'); like($mb, qr/<qp\@example\.com>/, 'new result written w/ -a'); @@ -183,7 +185,12 @@ test_lei(sub { lei_ok(qw(q z:0.. -o), "v2:$v2"); like($lei_err, qr/^# ([1-9][0-9]*) written to \Q$v2\E/sm, 'non-zero write output to stderr'); - lei_ok(qw(q z:0.. -o), "mboxrd:$home/before", '--only', $v2, '-j1,1'); + lei_ok('-C', $v2, qw(q z:0.. -o), "mboxrd:$home/before", + '--only', '.', '-j1,1'); + lei_ok(['edit-search', "$home/before"], $cat_env); + like($lei_out, qr/^\tonly = \Q$v2\E$/sm, + 'relative --only saved to absolute path'); + open my $fh, '<', "$home/before"; PublicInbox::MboxReader->mboxrd($fh, sub { push @before, $_[0] }); isnt(scalar(@before), 0, 'initial v2 written'); @@ -207,7 +214,7 @@ test_lei(sub { ok($shared < $orig, 'fewer bytes stored with --shared') or diag "shared=$shared orig=$orig"; - lei_ok([qw(edit-search), $v2s], { VISUAL => 'cat', EDITOR => 'cat' }); + lei_ok([qw(edit-search), $v2s], $cat_env); like($lei_out, qr/^\[lei/sm, 'edit-search can cat'); lei_ok('-C', "$home/v2s", qw(q -q -o ../s m:testmessage@example.com)); @@ -222,16 +229,14 @@ test_lei(sub { my @lss = glob("$home/" . '.local/share/lei/saved-searches/*/lei.saved-search'); my $out = xqx([qw(git config -f), $lss[0], 'lei.q.output']); - xsys($^X, qw(-i -p -e), "s/\\[/\\0/", $lss[0]) - and xbail "-ipe $lss[0]: $?"; + xsys_e($^X, qw(-w -i -p -e), "s/\\[/\\0/", $lss[0]); lei_ok qw(ls-search); like($lei_err, qr/bad config line.*?\Q$lss[0]\E/, 'git config parse error shown w/ lei ls-search'); lei_ok qw(up --all), \'up works with bad config'; like($lei_err, qr/bad config line.*?\Q$lss[0]\E/, 'git config parse error shown w/ lei up'); - xsys($^X, qw(-i -p -e), "s/\\0/\\[/", $lss[0]) - and xbail "-ipe $lss[0]: $?"; + xsys_e($^X, qw(-w -i -p -e), "s/\\0/\\[/", $lss[0]); lei_ok qw(ls-search); is($lei_err, '', 'no errors w/ fixed config'); @@ -243,17 +248,17 @@ test_lei(sub { my $d = "$home/d"; lei_ok [qw(import -q -F eml)], undef, - {0 => \"Subject: do not call\n\n"}; + {%$lei_opt, 0 => \"Subject: do not call\n\n"}; lei_ok qw(q -o), $d, 's:do not call'; my @orig = glob("$d/*/*"); is(scalar(@orig), 1, 'got one message via argv'); lei_ok [qw(import -q -Feml)], undef, - {0 => \"Subject: do not ever call\n\n"}; + {%$lei_opt, 0 => \"Subject: do not ever call\n\n"}; lei_ok 'up', $d; is_deeply([glob("$d/*/*")], \@orig, 'nothing written'); lei_ok [qw(import -q -Feml)], undef, - {0 => \"Subject: do not call, ever\n\n"}; + {%$lei_opt, 0 => \"Subject: do not call, ever\n\n"}; lei_ok 'up', $d; @after = glob("$d/*/*"); is(scalar(@after), 2, '2 total, messages, now'); @@ -264,14 +269,15 @@ test_lei(sub { 'up retrieved correct message'); $d = "$home/d-stdin"; - lei_ok [ qw(q -q -o), $d ], undef, { 0 => \'s:"do not ever call"' }; + lei_ok [ qw(q -q -o), $d ], undef, + { %$lei_opt, 0 => \'s:"do not ever call"' }; @orig = glob("$d/*/*"); is(scalar(@orig), 1, 'got one message via stdin'); lei_ok [qw(import -q -Feml)], undef, - {0 => \"Subject: do not fall or ever call\n\n"}; + {%$lei_opt, 0 => \"Subject: do not fall or ever call\n\n"}; lei_ok [qw(import -q -Feml)], undef, - {0 => \"Subject: do not ever call, again\n\n"}; + {%$lei_opt, 0 => \"Subject: do not ever call, again\n\n"}; lei_ok 'up', $d; @new = glob("$d/new/*"); is(scalar(@new), 1, "new message written to `new'") or do { @@ -281,5 +287,25 @@ test_lei(sub { is(eml_load($new[0])->header('Subject'), 'do not ever call, again', 'up retrieved correct message'); + # --thread expansion + $d = "$home/thread-expand"; + lei_ok(qw(q --no-external m:import-before@example.com -t -o), $d); + @orig = glob("$d/{new,cur}/*"); + is(scalar(@orig), 1, 'one result so far'); + lei_ok [ qw(import -Feml) ], undef, { %$lei_opt, 0 => \<<'EOM' }; +Date: Sun, 02 Oct 2023 00:00:00 +0000 +From: <x@example.com> +In-Reply-To: <import-before@example.com> +Message-ID: <reply1@example.com> +Subject: reply1 +EOM + + lei_ok qw(up), $d; + @new = glob("$d/{new,cur}/*"); + is(scalar(@new), 2, 'got new message'); + is_xdeeply([grep { $_ eq $orig[0] } @new], \@orig, + 'original message preserved on up w/ threads'); + lei_ok 'up', "$home/md", $d, \'multiple maildir up'; + unlike $lei_err, qr! line \d+!s, 'no warnings'; }); done_testing; diff --git a/t/lei-q-thread.t b/t/lei-q-thread.t index 26d06eec..72d3a565 100644 --- a/t/lei-q-thread.t +++ b/t/lei-q-thread.t @@ -3,7 +3,7 @@ # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use PublicInbox::TestCommon; require_git 2.6; -require_mods(qw(json DBD::SQLite Search::Xapian)); +require_mods(qw(json DBD::SQLite Xapian)); use PublicInbox::LeiToMail; my ($ro_home, $cfg_path) = setup_public_inboxes; test_lei(sub { diff --git a/t/lei-refresh-mail-sync.t b/t/lei-refresh-mail-sync.t index ea83a513..8ccc68c6 100644 --- a/t/lei-refresh-mail-sync.t +++ b/t/lei-refresh-mail-sync.t @@ -5,17 +5,20 @@ use strict; use v5.10.1; use PublicInbox::TestCommon; require_mods(qw(lei)); use File::Path qw(remove_tree); require Socket; +use Fcntl qw(F_SETFD); + +pipe(my ($stop_r, $stop_w)) or xbail "pipe: $!"; +fcntl($stop_w, F_SETFD, 0) or xbail "F_SETFD: $!"; my $stop_daemon = sub { # needed since we don't have inotify + close $stop_w or xbail "close \$stop_w: $!"; lei_ok qw(daemon-pid); chomp(my $pid = $lei_out); $pid > 0 or xbail "bad pid: $pid"; kill('TERM', $pid) or xbail "kill: $!"; - for (0..10) { - tick; - kill(0, $pid) or last; - } - kill(0, $pid) and xbail "daemon still running (PID:$pid)"; + is(sysread($stop_r, my $buf, 1), 0, 'daemon stop pipe read EOF'); + pipe($stop_r, $stop_w) or xbail "pipe: $!"; + fcntl($stop_w, F_SETFD, 0) or xbail "F_SETFD: $!"; }; test_lei({ daemon_only => 1 }, sub { @@ -88,7 +91,8 @@ SKIP: { $sock_cls //= ref($s); my $cmd = [ "-$x", '-W0', "--stdout=$home/$x.out", "--stderr=$home/$x.err" ]; - my $td = start_script($cmd, $env, { 3 => $s }) or xbail("-$x"); + my $opt = { 3 => $s, -CLOFORK => [ $stop_w ] }; + my $td = start_script($cmd, $env, $opt) or xbail("-$x"); my $addr = tcp_host_port($s); $srv->{$x} = { addr => $addr, td => $td, cmd => $cmd, s => $s }; } @@ -133,14 +137,18 @@ SKIP: { my $ar = PublicInbox::AutoReap->new($pid); ok(!(lei 'refresh-mail-sync', $url), 'URL fails on dead -imapd'); ok(!(lei 'refresh-mail-sync', '--all'), '--all fails on dead -imapd'); - $ar->kill for qw(avoid sig wake miss-no signalfd or EVFILT_SIG); - $ar->join('TERM'); + { + local $SIG{CHLD} = sub { $ar->join('TERM'); undef $ar }; + do { + eval { $ar->kill and tick(0.01) } + } while (defined($ar)); + } my $cmd = $srv->{imapd}->{cmd}; my $s = $srv->{imapd}->{s}; $s->blocking(0); - $srv->{imapd}->{td} = start_script($cmd, $env, { 3 => $s }) or - xbail "@$cmd"; + my $opt = { 3 => $s, -CLOFORK => [ $stop_w ] }; + $srv->{imapd}->{td} = start_script($cmd, $env, $opt) or xbail "@$cmd"; lei_ok 'refresh-mail-sync', '--all'; lei_ok 'inspect', "blob:$oid"; is($lei_out, $before, 'no changes when server was down'); diff --git a/t/lei-reindex.t b/t/lei-reindex.t new file mode 100644 index 00000000..73346ee8 --- /dev/null +++ b/t/lei-reindex.t @@ -0,0 +1,12 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use v5.12; use PublicInbox::TestCommon; +require_mods(qw(lei)); +my ($tmpdir, $for_destroy) = tmpdir; +test_lei(sub { + ok(!lei('reindex'), 'reindex fails w/o store'); + like $lei_err, qr/nothing indexed/, "`nothing indexed' noted"; +}); + +done_testing; diff --git a/t/lei-sigpipe.t b/t/lei-sigpipe.t index 55c208e2..b9fd88a6 100644 --- a/t/lei-sigpipe.t +++ b/t/lei-sigpipe.t @@ -6,46 +6,56 @@ use v5.10.1; use PublicInbox::TestCommon; use POSIX qw(WTERMSIG WIFSIGNALED SIGPIPE); use PublicInbox::OnDestroy; +use PublicInbox::Syscall qw($F_SETPIPE_SZ); +use autodie qw(close open pipe seek sysread); +use PublicInbox::IO qw(write_file); +my $inboxdir = $ENV{GIANT_INBOX_DIR}; +SKIP: { + $inboxdir // skip 'GIANT_INBOX_DIR unset to test large results', 1; + require PublicInbox::Inbox; + my $ibx = PublicInbox::Inbox->new({ + name => 'unconfigured-test', + address => [ "test\@example.com" ], + inboxdir => $inboxdir, + }); + $ibx->search or xbail "GIANT_INBOX_DIR=$inboxdir has no search"; +} # undo systemd (and similar) ignoring SIGPIPE, since lei expects to be run # from an interactive terminal: # https://public-inbox.org/meta/20220227080422.gyqowrxomzu6gyin@sourcephile.fr/ my $oldSIGPIPE = $SIG{PIPE}; $SIG{PIPE} = 'DEFAULT'; -my $cleanup = PublicInbox::OnDestroy->new($$, sub { - $SIG{PIPE} = $oldSIGPIPE; -}); +my $cleanup = on_destroy(sub { $SIG{PIPE} = $oldSIGPIPE }); test_lei(sub { my $f = "$ENV{HOME}/big.eml"; my $imported; for my $out ([], [qw(-f mboxcl2)], [qw(-f text)]) { - pipe(my ($r, $w)) or BAIL_OUT $!; - my $size = 65536; - if ($^O eq 'linux' && fcntl($w, 1031, 4096)) { - $size = 4096; - } + pipe(my $r, my $w); + my $size = $F_SETPIPE_SZ && fcntl($w, $F_SETPIPE_SZ, 4096) ? + 4096 : 65536; unless (-f $f) { - open my $fh, '>', $f or xbail "open $f: $!"; - print $fh <<'EOM' or xbail; + my $fh = write_file '>', $f, <<'EOM'; From: big@example.com Message-ID: <big@example.com> EOM print $fh 'Subject:'; print $fh (' '.('x' x 72)."\n") x (($size / 73) + 1); print $fh "\nbody\n"; - close $fh or xbail "close: $!"; + close $fh; } lei_ok(qw(import), $f) if $imported++ == 0; - open my $errfh, '+>>', "$ENV{HOME}/stderr.log" or xbail $!; + open my $errfh, '+>>', "$ENV{HOME}/stderr.log"; my $opt = { run_mode => 0, 2 => $errfh, 1 => $w }; my $cmd = [qw(lei q -q -t), @$out, 'z:1..']; + push @$cmd, '--only='.$inboxdir if defined $inboxdir; my $tp = start_script($cmd, undef, $opt); close $w; vec(my $rvec = '', fileno($r), 1) = 1; if (!select($rvec, undef, undef, 30)) { - seek($errfh, 0, 0) or xbail $!; + seek($errfh, 0, 0); my $s = do { local $/; <$errfh> }; xbail "lei q had no output after 30s, stderr=$s"; } @@ -54,7 +64,7 @@ EOM $tp->join; ok(WIFSIGNALED($?), "signaled @$out"); is(WTERMSIG($?), SIGPIPE, "got SIGPIPE @$out"); - seek($errfh, 0, 0) or xbail $!; + seek($errfh, 0, 0); my $s = do { local $/; <$errfh> }; is($s, '', "quiet after sigpipe @$out"); } diff --git a/t/lei-store-fail.t b/t/lei-store-fail.t new file mode 100644 index 00000000..1e83e383 --- /dev/null +++ b/t/lei-store-fail.t @@ -0,0 +1,57 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +# ensure we detect errors in lei/store +use v5.12; +use PublicInbox::TestCommon; +use autodie qw(pipe open close seek); +use Fcntl qw(SEEK_SET); +use File::Path qw(remove_tree); + +my $start_home = $ENV{HOME}; # bug guard +my $utf8_oid = '9bf1002c49eb075df47247b74d69bcd555e23422'; +test_lei(sub { + lei_ok qw(import -q t/plack-qp.eml); # start the store + ok(!lei(qw(blob --mail), $utf8_oid), 't/utf8.eml not imported, yet'); + + my $opt; + pipe($opt->{0}, my $in_w); + open $opt->{1}, '+>', undef; + open $opt->{2}, '+>', undef; + $opt->{-CLOFORK} = [ $in_w ]; + my $cmd = [ qw(lei import -q -F mboxrd) ]; + my $tp = start_script($cmd, undef, $opt); + close $opt->{0}; + $in_w->autoflush(1); + print $in_w <<EOM or xbail "print: $!"; +From k\@y Fri Oct 2 00:00:00 1993 +From: <k\@example.com> +Date: Sat, 02 Oct 2010 00:00:00 +0000 +Subject: hi +Message-ID: <0\@t> + +will this save? +EOM + # import another message w/ delay while mboxrd import is still running + lei_ok qw(import -q --commit-delay=300 t/utf8.eml); + lei_ok qw(blob --mail), $utf8_oid, + \'blob immediately available despite --commit-delay'; + lei_ok qw(q m:testmessage@example.com); + is($lei_out, "[null]\n", 'delayed commit is unindexed'); + + # make immediate ->sto_barrier_request fail from mboxrd import: + remove_tree("$ENV{HOME}/.local/share/lei/store"); + # subsequent lei commands are undefined behavior, + # but we need to make sure the current lei command fails: + + close $in_w; # should trigger ->done + $tp->join; + isnt($?, 0, 'lei import -F mboxrd error code set on failure'); + is(-s $opt->{1}, 0, 'nothing in stdout'); + isnt(-s $opt->{2}, 0, 'stderr not empty'); + seek($opt->{2}, 0, SEEK_SET); + my @err = readline($opt->{2}); + ok(grep(!/^#/, @err), 'noted error in stderr') or diag "@err"; +}); + +done_testing; diff --git a/t/lei-tag.t b/t/lei-tag.t index 5941cd0f..7278dfcd 100644 --- a/t/lei-tag.t +++ b/t/lei-tag.t @@ -1,9 +1,10 @@ #!perl -w # Copyright (C) 2021 all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; use v5.10.1; use PublicInbox::TestCommon; +use v5.12; use PublicInbox::TestCommon; require_git 2.6; -require_mods(qw(json DBD::SQLite Search::Xapian)); +require_mods(qw(json DBD::SQLite Xapian)); +use PublicInbox::DS qw(now); my ($ro_home, $cfg_path) = setup_public_inboxes; my $check_kw = sub { my ($exp, %opt) = @_; @@ -101,5 +102,20 @@ test_lei(sub { if (0) { # TODO label+kw search w/ externals lei_ok(qw(q L:qp), "mid:$mid", '--only', "$ro_home/t2"); } + lei_ok qw(tag +L:nope -F eml t/data/binary.patch); + like $lei_err, qr/\b1 unimported messages/, 'noted unimported' + or diag $lei_err; + + lei_ok qw(tag -F eml --commit-delay=1 t/utf8.eml +L:utf8); + lei_ok 'ls-label'; + unlike($lei_out, qr/\butf8\b/, 'commit-delay delays label'); + my $end = now + 10; + my $n = 1; + diag 'waiting for lei/store commit...'; + do { + tick $n; + $n = 0.1; + } until (!lei('ls-label') || $lei_out =~ /\butf8\b/ || now > $end); + like($lei_out, qr/\butf8\b/, 'commit-delay eventually commits'); }); done_testing; @@ -5,39 +5,50 @@ use strict; use v5.10.1; use PublicInbox::TestCommon; use IO::Uncompress::Gunzip qw(gunzip $GunzipError); test_lei(sub { my ($ro_home, $cfg_path) = setup_public_inboxes; - my $s = eml_load('t/plack-qp.eml')->as_string; + my $home = $ENV{HOME}; + my $qp = eml_load('t/plack-qp.eml'); + my $s = $qp->as_string; lei_ok [qw(import -q -F eml -)], undef, { 0 => \$s, %$lei_opt }; - lei_ok qw(q z:0.. -f mboxcl2 -o), "$ENV{HOME}/a.mbox.gz"; - lei_ok qw(q z:0.. -f mboxcl2 -o), "$ENV{HOME}/b.mbox.gz"; - lei_ok qw(q z:0.. -f mboxcl2 -o), "$ENV{HOME}/a"; - lei_ok qw(q z:0.. -f mboxcl2 -o), "$ENV{HOME}/b"; + lei_ok qw(q z:0.. -f mboxcl2 -o), "$home/a.mbox.gz"; + lei_ok qw(q z:0.. -f mboxcl2 -o), "$home/b.mbox.gz"; + lei_ok qw(q z:0.. -f mboxcl2 -o), "$home/a"; + lei_ok qw(q z:0.. -f mboxcl2 -o), "$home/b"; + my $uc; + for my $x (qw(a b)) { + gunzip("$home/$x.mbox.gz" => \$uc, MultiStream => 1) or + xbail "gunzip $GunzipError"; + ok(index($uc, $qp->body_raw) >= 0, + "original mail in $x.mbox.gz") or diag $uc; + open my $fh, '<', "$home/$x" or xbail $!; + $uc = do { local $/; <$fh> } // xbail $!; + ok(index($uc, $qp->body_raw) >= 0, + "original mail in uncompressed $x") or diag $uc; + } lei_ok qw(ls-search); $s = eml_load('t/utf8.eml')->as_string; lei_ok [qw(import -q -F eml -)], undef, { 0 => \$s, %$lei_opt }; lei_ok qw(up --all=local); - open my $fh, "$ENV{HOME}/a.mbox.gz" or xbail "open: $!"; - my $gz = do { local $/; <$fh> }; - my $uc; - gunzip(\$gz => \$uc, MultiStream => 1) or xbail "gunzip $GunzipError"; - open $fh, "$ENV{HOME}/a" or xbail "open: $!"; + gunzip("$home/a.mbox.gz" => \$uc, MultiStream => 1) or + xbail "gunzip $GunzipError"; + + open my $fh, '<', "$home/a" or xbail "open: $!"; my $exp = do { local $/; <$fh> }; is($uc, $exp, 'compressed and uncompressed match (a.gz)'); like($exp, qr/testmessage\@example.com/, '2nd message added'); - open $fh, "$ENV{HOME}/b.mbox.gz" or xbail "open: $!"; - $gz = do { local $/; <$fh> }; undef $uc; - gunzip(\$gz => \$uc, MultiStream => 1) or xbail "gunzip $GunzipError"; + gunzip("$home/b.mbox.gz" => \$uc, MultiStream => 1) or + xbail "gunzip $GunzipError"; is($uc, $exp, 'compressed and uncompressed match (b.gz)'); - open $fh, "$ENV{HOME}/b" or xbail "open: $!"; + open $fh, '<', "$home/b" or xbail "open: $!"; $uc = do { local $/; <$fh> }; is($uc, $exp, 'uncompressed both match'); - lei_ok [ qw(up -q), "$ENV{HOME}/b", "--mua=touch $ENV{HOME}/c" ], + lei_ok [ qw(up -q), "$home/b", "--mua=touch $home/c" ], undef, { run_mode => 0 }; - ok(-f "$ENV{HOME}/c", '--mua works with single output'); + ok(-f "$home/c", '--mua works with single output'); }); done_testing; diff --git a/t/lei-watch.t b/t/lei-watch.t index 24d9f5c8..8ad50d13 100644 --- a/t/lei-watch.t +++ b/t/lei-watch.t @@ -3,17 +3,18 @@ # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use PublicInbox::TestCommon; use File::Path qw(make_path remove_tree); +use PublicInbox::IO qw(write_file); plan skip_all => "TEST_FLAKY not enabled for $0" if !$ENV{TEST_FLAKY}; require_mods('lei'); -my $have_fast_inotify = eval { require Linux::Inotify2 } || +my $have_fast_inotify = eval { require PublicInbox::Inotify } || eval { require IO::KQueue }; $have_fast_inotify or - diag("$0 IO::KQueue or Linux::Inotify2 missing, test will be slow"); + diag("$0 IO::KQueue or inotify missing, test will be slow"); my ($ro_home, $cfg_path) = setup_public_inboxes; test_lei(sub { - my $md = "$ENV{HOME}/md"; + my ($md, $mh1, $mh2) = map { "$ENV{HOME}/$_" } qw(md mh1 mh2); my $cfg_f = "$ENV{HOME}/.config/lei/config"; my $md2 = $md.'2'; lei_ok 'ls-watch'; @@ -45,13 +46,14 @@ test_lei(sub { } # first, make sure tag-ro works - make_path("$md/new", "$md/cur", "$md/tmp"); + make_path("$md/new", "$md/cur", "$md/tmp", $mh1, $mh2); lei_ok qw(add-watch --state=tag-ro), $md; lei_ok 'ls-watch'; like($lei_out, qr/^\Qmaildir:$md\E$/sm, 'maildir shown'); lei_ok qw(q mid:testmessage@example.com -o), $md, '-I', "$ro_home/t1"; my @f = glob("$md/cur/*:2,"); is(scalar(@f), 1, 'got populated maildir with one result'); + rename($f[0], "$f[0]S") or xbail "rename $!"; # set (S)een tick($have_fast_inotify ? 0.2 : 2.2); # always needed for 1 CPU systems lei_ok qw(note-event done); # flushes immediately (instead of 5s) @@ -94,6 +96,12 @@ test_lei(sub { my $cmp = [ <$fh> ]; is_xdeeply($cmp, $ino_contents, 'inotify Maildir watches gone'); }; + + write_file '>', "$mh1/.mh_sequences"; + lei_ok qw(add-watch --state=tag-ro), $mh1, "mh:$mh2"; + lei_ok 'ls-watch', \'refresh watches'; + like $lei_out, qr/^\Qmh:$mh1\E$/sm, 'MH 1 shown'; + like $lei_out, qr/^\Qmh:$mh2\E$/sm, 'MH 2 shown'; }); done_testing; @@ -1,7 +1,8 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use PublicInbox::TestCommon; +require_mods 'lei'; use File::Path qw(rmtree); # this only tests the basic help/config/init/completion bits of lei; @@ -39,10 +40,21 @@ my $test_help = sub { lei_ok(qw(config -h)); like($lei_out, qr! \Q$home\E/\.config/lei/config\b!, 'actual path shown in config -h'); + my $exp_help = qr/\Q$lei_out\E/s; + ok(!lei('config'), 'config w/o args fails'); + like($lei_err, $exp_help, 'config w/o args shows our help in stderr'); lei_ok(qw(config -h), { XDG_CONFIG_HOME => '/XDC' }, \'config with XDG_CONFIG_HOME'); like($lei_out, qr! /XDC/lei/config\b!, 'XDG_CONFIG_HOME in config -h'); is($lei_err, '', 'no errors from config -h'); + + lei_ok(qw(-c foo.bar config dash.c works)); + lei_ok(qw(config dash.c)); + is($lei_out, "works\n", 'config set w/ -c'); + + lei_ok(qw(-c foo.bar config --add dash.c add-works)); + lei_ok(qw(config --get-all dash.c)); + is($lei_out, "works\nadd-works\n", 'config --add w/ -c'); }; my $ok_err_info = sub { @@ -100,9 +112,11 @@ my $test_config = sub { is($lei_out, "tr00\n", "-c string value passed as-is"); lei_ok(qw(-c imap.debug=a -c imap.debug=b config --get-all imap.debug)); is($lei_out, "a\nb\n", '-c and --get-all work together'); - - lei_ok([qw(config -e)], { VISUAL => 'cat', EDITOR => 'cat' }); + my $env = { VISUAL => 'cat', EDITOR => 'cat' }; + lei_ok([qw(config -e)], $env); is($lei_out, "[a]\n\tb = c\n", '--edit works'); + ok(!lei([qw(-c a.b=c config -e)], $env), '-c conflicts with -e'); + like($lei_err, qr/not allowed/, 'error message shown'); }; my $test_completion = sub { @@ -146,9 +160,18 @@ my $test_fail = sub { lei_ok('q', "foo\n"); like($lei_err, qr/trailing `\\n' removed/s, "noted `\\n' removal"); + lei(qw(q from:infinity..)); + is($? >> 8, 22, 'combined query fails on invalid range op'); + lei(qw(q -t from:infinity..)); + is($? >> 8, 22, 'single query fails on invalid range op'); + for my $lk (qw(ei inbox)) { my $d = "$home/newline\n$lk"; - mkdir $d; + my $all = $lk eq 'ei' ? 'ALL' : 'all'; + { # quiet newline warning on older Perls + local $^W = undef if $^V lt v5.22.0; + File::Path::mkpath("$d/$all.git/objects"); + } open my $fh, '>', "$d/$lk.lock" or BAIL_OUT "open $d/$lk.lock"; for my $fl (qw(-I --only)) { ok(!lei('q', $fl, $d, 'whatever'), @@ -159,6 +182,11 @@ my $test_fail = sub { } lei_ok('sucks', \'yes, but hopefully less every day'); like($lei_out, qr/loaded features/, 'loaded features shown'); + + lei_ok([qw(q --stdin -f text)], undef, { 0 => \'', %$lei_opt }); + is($lei_err, '', 'no errors on empty stdin'); + is($lei_out, '', 'no output on empty query'); + SKIP: { skip 'no curl', 3 unless require_cmd('curl', 1); lei(qw(q --only http://127.0.0.1:99999/bogus/ t:m)); diff --git a/t/lei_dedupe.t b/t/lei_dedupe.t index e1944d02..13fc1f3b 100644 --- a/t/lei_dedupe.t +++ b/t/lei_dedupe.t @@ -1,5 +1,5 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; @@ -10,6 +10,8 @@ use PublicInbox::Smsg; require_mods(qw(DBD::SQLite)); use_ok 'PublicInbox::LeiDedupe'; my $eml = eml_load('t/plack-qp.eml'); +my $sameish = eml_load('t/plack-qp.eml'); +$sameish->header_set('Message-ID', '<cuepee@example.com>'); my $mid = $eml->header_raw('Message-ID'); my $different = eml_load('t/msg_iter-order.eml'); $different->header_set('Message-ID', $mid); @@ -47,6 +49,8 @@ for my $strat (undef, 'content') { ok(!$dd->is_dup($different), "different is_dup with $desc dedupe"); ok(!$dd->is_smsg_dup($smsg), "is_smsg_dup pass w/ $desc dedupe"); ok($dd->is_smsg_dup($smsg), "is_smsg_dup reject w/ $desc dedupe"); + ok(!$dd->is_dup($sameish), + "Message-ID accounted for w/ same content otherwise"); } $lei->{opt}->{dedupe} = 'bogus'; eval { PublicInbox::LeiDedupe->new($lei) }; diff --git a/t/lei_external.t b/t/lei_external.t index 51d0af5c..573cbc60 100644 --- a/t/lei_external.t +++ b/t/lei_external.t @@ -1,8 +1,8 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> # internal unit test, see t/lei-externals.t for functional tests -use strict; use v5.10.1; use Test::More; +use v5.12; use Test::More; my $cls = 'PublicInbox::LeiExternal'; require_ok $cls; my $canon = $cls->can('ext_canonicalize'); @@ -16,20 +16,4 @@ is($canon->('/this/path/is/nonexistent/'), '/this/path/is/nonexistent', is($canon->('/this//path/'), '/this/path', 'extra slashes gone'); is($canon->('/ALL/CAPS'), '/ALL/CAPS', 'caps preserved'); -my $glob2re = $cls->can('glob2re'); -is($glob2re->('http://[::1]:1234/foo/'), undef, 'IPv6 URL not globbed'); -is($glob2re->('foo'), undef, 'plain string unchanged'); -is_deeply($glob2re->('[f-o]'), '[f-o]' , 'range accepted'); -is_deeply($glob2re->('*'), '[^/]*?' , 'wildcard accepted'); -is_deeply($glob2re->('{a,b,c}'), '(a|b|c)' , 'braces'); -is_deeply($glob2re->('{,b,c}'), '(|b|c)' , 'brace with empty @ start'); -is_deeply($glob2re->('{a,b,}'), '(a|b|)' , 'brace with empty @ end'); -is_deeply($glob2re->('{a}'), undef, 'ungrouped brace'); -is_deeply($glob2re->('{a'), undef, 'open left brace'); -is_deeply($glob2re->('a}'), undef, 'open right brace'); -is_deeply($glob2re->('*.[ch]'), '[^/]*?\\.[ch]', 'suffix glob'); -is_deeply($glob2re->('{[a-z],9,}'), '([a-z]|9|)' , 'brace with range'); -is_deeply($glob2re->('\\{a,b\\}'), undef, 'escaped brace'); -is_deeply($glob2re->('\\\\{a,b}'), '\\\\\\\\(a|b)', 'fake escape brace'); - done_testing; diff --git a/t/lei_overview.t b/t/lei_overview.t index dd9e2cad..b4181ffd 100644 --- a/t/lei_overview.t +++ b/t/lei_overview.t @@ -6,7 +6,7 @@ use v5.10.1; use Test::More; use PublicInbox::TestCommon; use POSIX qw(_exit); -require_mods(qw(Search::Xapian DBD::SQLite)); +require_mods(qw(Xapian DBD::SQLite)); require_ok 'PublicInbox::LeiOverview'; my $ovv = bless {}, 'PublicInbox::LeiOverview'; diff --git a/t/lei_store.t b/t/lei_store.t index 40ad7800..17ee0729 100644 --- a/t/lei_store.t +++ b/t/lei_store.t @@ -1,11 +1,11 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use Test::More; use PublicInbox::TestCommon; -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(DBD::SQLite Xapian)); require_git 2.6; require_ok 'PublicInbox::LeiStore'; require_ok 'PublicInbox::ExtSearch'; @@ -149,4 +149,7 @@ EOM is($mset->size, 1, 'rt:1.hour.ago.. works w/ local time'); } +is_deeply([glob("$store_dir/local/*.git/info/refs")], [], + 'no info/refs in private lei/store'); + done_testing; diff --git a/t/lei_to_mail.t b/t/lei_to_mail.t index e8958c64..dbd33909 100644 --- a/t/lei_to_mail.t +++ b/t/lei_to_mail.t @@ -1,9 +1,10 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use v5.10.1; -use Test::More; +# tests PublicInbox::LeiToMail internals (unstable API) +# Not as needed now that lei functionality has been ironed out +use v5.12; +use autodie qw(open sysopen unlink); use PublicInbox::TestCommon; use PublicInbox::Eml; use Fcntl qw(SEEK_SET O_RDONLY O_NONBLOCK); @@ -74,7 +75,7 @@ for my $mbox (@MBOX) { my ($tmpdir, $for_destroy) = tmpdir(); local $ENV{TMPDIR} = $tmpdir; -open my $err, '>>', "$tmpdir/lei.err" or BAIL_OUT $!; +open my $err, '>>', "$tmpdir/lei.err"; my $lei = bless { 2 => $err, cmd => 'test' }, 'PublicInbox::LEI'; my $commit = sub { $_[0] = undef; # wcb @@ -114,16 +115,16 @@ my $orig = do { ok(-f $fn && !-s _, 'empty file created'); $wcb->(\(my $dup = $buf), $deadbeef); $commit->($wcb); - open my $fh, '<', $fn or BAIL_OUT $!; + open my $fh, '<', $fn; my $raw = do { local $/; <$fh> }; like($raw, qr/^blah\n/sm, 'wrote content'); - unlink $fn or BAIL_OUT $!; + unlink $fn; $wcb = $wcb_get->($mbox, $fn); ok(-f $fn && !-s _, 'truncated mbox destination'); $wcb->(\($dup = $buf), $deadbeef); $commit->($wcb); - open $fh, '<', $fn or BAIL_OUT $!; + open $fh, '<', $fn; is(do { local $/; <$fh> }, $raw, 'wrote identical content'); $raw; }; @@ -162,7 +163,7 @@ for my $zsfx (qw(gz bz2 xz)) { my $uncompressed = xqx([@$dc_cmd, $f]); is($uncompressed, $orig, "$zsfx works unlocked"); - unlink $f or BAIL_OUT "unlink $!"; + unlink $f; $wcb = $wcb_get->($mbox, $f); $wcb->(\($dup = $buf), { %$deadbeef }); $commit->($wcb); @@ -201,14 +202,14 @@ my $as_orig = sub { $eml->as_string; }; -unlink $fn or BAIL_OUT $!; +unlink $fn; if ('default deduplication uses content_hash') { my $wcb = $wcb_get->('mboxo', $fn); $deadbeef->{kw} = []; $wcb->(\(my $x = $buf), $deadbeef) for (1..2); $commit->($wcb); my $cmp = ''; - open my $fh, '<', $fn or BAIL_OUT $!; + open my $fh, '<', $fn; PublicInbox::MboxReader->mboxo($fh, sub { $cmp .= $as_orig->(@_) }); is($cmp, $buf, 'only one message written'); @@ -216,7 +217,7 @@ if ('default deduplication uses content_hash') { $wcb = $wcb_get->('mboxo', $fn); $wcb->(\($x = $buf . "\nx\n"), $deadbeef) for (1..2); $commit->($wcb); - open $fh, '<', $fn or BAIL_OUT $!; + open $fh, '<', $fn; my @x; PublicInbox::MboxReader->mboxo($fh, sub { push @x, $as_orig->(@_) }); is(scalar(@x), 2, 'augmented mboxo'); @@ -225,12 +226,12 @@ if ('default deduplication uses content_hash') { } { # stdout support - open my $tmp, '+>', undef or BAIL_OUT $!; + open my $tmp, '+>', undef; local $lei->{1} = $tmp; my $wcb = $wcb_get->('mboxrd', '/dev/stdout'); $wcb->(\(my $x = $buf), $deadbeef); $commit->($wcb); - seek($tmp, 0, SEEK_SET) or BAIL_OUT $!; + seek($tmp, 0, SEEK_SET); my $cmp = ''; PublicInbox::MboxReader->mboxrd($tmp, sub { $cmp .= $as_orig->(@_) }); is($cmp, $buf, 'message written to stdout'); @@ -240,7 +241,7 @@ SKIP: { # FIFO support use POSIX qw(mkfifo); my $fn = "$tmpdir/fifo"; mkfifo($fn, 0600) or skip("mkfifo not supported: $!", 1); - sysopen(my $cat, $fn, O_RDONLY|O_NONBLOCK) or BAIL_OUT $!; + sysopen(my $cat, $fn, O_RDONLY|O_NONBLOCK); my $wcb = $wcb_get->('mboxo', $fn); $wcb->(\(my $x = $buf), $deadbeef); $commit->($wcb); @@ -260,7 +261,7 @@ SKIP: { # FIFO support my @f; $mdr->maildir_each_file($md, sub { push @f, shift }); - open my $fh, $f[0] or BAIL_OUT $!; + open my $fh, '<', $f[0]; is(do { local $/; <$fh> }, $buf, 'wrote to Maildir'); $wcb = $wcb_get->('maildir', $md); @@ -271,7 +272,7 @@ SKIP: { # FIFO support $mdr->maildir_each_file($md, sub { push @x, shift }); is(scalar(@x), 1, 'wrote one new file'); ok(!-f $f[0], 'old file clobbered'); - open $fh, $x[0] or BAIL_OUT $!; + open $fh, '<', $x[0]; is(do { local $/; <$fh> }, $buf."\nx\n", 'wrote new file to Maildir'); local $lei->{opt}->{augment} = 1; @@ -283,9 +284,9 @@ SKIP: { # FIFO support is(scalar grep(/\A\Q$x[0]\E\z/, @f), 1, 'old file still there'); my @new = grep(!/\A\Q$x[0]\E\z/, @f); is(scalar @new, 1, '1 new file written (b4dc0ffee skipped)'); - open $fh, $x[0] or BAIL_OUT $!; + open $fh, '<', $x[0]; is(do { local $/; <$fh> }, $buf."\nx\n", 'old file untouched'); - open $fh, $new[0] or BAIL_OUT $!; + open $fh, '<', $new[0]; is(do { local $/; <$fh> }, $buf."\ny\n", 'new file written'); } diff --git a/t/lei_xsearch.t b/t/lei_xsearch.t index d9ddb297..977fb1e9 100644 --- a/t/lei_xsearch.t +++ b/t/lei_xsearch.t @@ -6,7 +6,7 @@ use v5.10.1; use List::Util qw(shuffle); use PublicInbox::TestCommon; use PublicInbox::Eml; -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(DBD::SQLite Xapian)); require PublicInbox::ExtSearchIdx; require_git 2.6; require_ok 'PublicInbox::LeiXSearch'; @@ -61,7 +61,7 @@ for my $mi ($mset->items) { } is(scalar(@msgs), $nr, 'smsgs retrieved for all'); -$mset = $lxs->recent(undef, { limit => 1 }); +$mset = $lxs->mset('z:1..', { relevance => -2, limit => 1 }); is($mset->size, 1, 'one result'); my @ibxish = $lxs->locals; diff --git a/t/linkify.t b/t/linkify.t index e42e1efe..9280fd91 100644 --- a/t/linkify.t +++ b/t/linkify.t @@ -144,4 +144,9 @@ href="http://www.$hc.example.com/">http://www.$hc.example.com/</a>}; is($s, $expect, 'IDN message escaped properly'); } +{ + my $false_positive = 'LINKIFY'.('A' x 40); + is(PublicInbox::Linkify->new->to_html($false_positive), + $false_positive, 'false-positive left as-is'); +} done_testing(); diff --git a/t/mbox_lock.t b/t/mbox_lock.t index c2fee0d4..1fc828aa 100644 --- a/t/mbox_lock.t +++ b/t/mbox_lock.t @@ -2,6 +2,7 @@ # Copyright (C) 2021 all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use PublicInbox::TestCommon; +use autodie qw(chdir); use POSIX qw(_exit); use PublicInbox::DS qw(now); use Errno qw(EAGAIN); @@ -18,11 +19,11 @@ ok(!-f "$f.lock", 'no dotlock with none'); undef $mbl; { opendir my $cur, '.' or BAIL_OUT $!; - my $od = PublicInbox::OnDestroy->new(sub { chdir $cur }); - chdir $tmpdir or BAIL_OUT; + my $od = on_destroy \&chdir, $cur; + chdir $tmpdir; my $abs = "$tmpdir/rel.lock"; my $rel = PublicInbox::MboxLock->acq('rel', 1, ['dotlock']); - chdir '/' or BAIL_OUT; + chdir '/'; ok(-f $abs, 'lock with abs path created'); undef $rel; ok(!-f $abs, 'lock gone despite being in the wrong dir'); diff --git a/t/mbox_reader.t b/t/mbox_reader.t index 87e8f397..14248a2d 100644 --- a/t/mbox_reader.t +++ b/t/mbox_reader.t @@ -113,10 +113,10 @@ EOM SKIP: { use PublicInbox::Spawn qw(popen_rd); - my $fh = popen_rd([ $^X, '-E', <<'' ]); -say "From x@y Fri Oct 2 00:00:00 1993"; + my $fh = popen_rd([ $^X, qw(-w -Mv5.12 -e), <<'' ]); +say 'From x@y Fri Oct 2 00:00:00 1993'; print "a: b\n\n", "x" x 70000, "\n\n"; -say "From x@y Fri Oct 2 00:00:00 2010"; +say 'From x@y Fri Oct 2 00:00:00 2010'; print "Final: bit\n\n", "Incomplete\n\n"; exit 1 @@ -1,14 +1,15 @@ -# Copyright (C) 2014-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use warnings; -use Test::More; use Cwd qw(getcwd); use PublicInbox::MID qw(mid2path); use PublicInbox::Git; use PublicInbox::InboxWritable; use PublicInbox::TestCommon; use PublicInbox::Import; +use PublicInbox::IO qw(write_file); +use File::Path qw(remove_tree); my ($tmpdir, $for_destroy) = tmpdir(); my $home = "$tmpdir/pi-home"; my $pi_home = "$home/.public-inbox"; @@ -49,13 +50,11 @@ my $fail_bad_header = sub ($$$) { is(1, mkdir($pi_home, 0755), "setup ~/.public-inbox"); PublicInbox::Import::init_bare($maindir); - open my $fh, '>>', $pi_config or die; - print $fh <<EOF or die; + write_file '>>', $pi_config, <<EOF; [publicinbox "test"] address = $addr inboxdir = $maindir EOF - close $fh or die; } local $ENV{GIT_COMMITTER_NAME} = eval { @@ -83,6 +82,13 @@ die $@ if $@; local $ENV{PI_EMERGENCY} = $faildir; local $ENV{HOME} = $home; local $ENV{ORIGINAL_RECIPIENT} = $addr; + ok(run_script([qw(-mda --help)], undef, + { 1 => \my $out, 2 => \my $err }), '-mda --help'); + like $out, qr/usage:/, 'usage shown w/ --help'; + ok(!run_script([qw(-mda --bogus)], undef, + { 1 => \$out, 2 => \$err }), '-mda --bogus fails'); + like $err, qr/usage:/, 'usage shown on bogus switch'; + my $in = <<EOF; From: Me <me\@example.com> To: You <you\@example.com> @@ -92,12 +98,23 @@ Subject: hihi Date: Thu, 01 Jan 1970 00:00:00 +0000 EOF + { + local $ENV{PATH} = $main_path; + ok(!run_script(['-mda'], { ORIGINAL_RECIPIENT => undef }, + { 0 => \$in, 2 => \$err }), + 'missing ORIGINAL_RECIPIENT fails'); + is($? >> 8, 67, 'got EX_NOUSER'); + like $err, qr/\bORIGINAL_RECIPIENT\b/, + 'ORIGINAL_RECIPIENT noted in stderr'; + is unlink(glob("$faildir/*/*")), 1, 'unlinked failed message'; + } + # ensure successful message delivery { local $ENV{PATH} = $main_path; ok(run_script(['-mda'], undef, { 0 => \$in })); my $rev = $git->qx(qw(rev-list HEAD)); - like($rev, qr/\A[a-f0-9]{40}/, "good revision committed"); + like($rev, qr/\A[a-f0-9]{40,64}/, "good revision committed"); chomp $rev; my $cmt = $git->cat_file($rev); like($$cmt, qr/^author Me <me\@example\.com> 0 \+0000\n/m, @@ -306,10 +323,79 @@ EOF # ensure -learn rm works after inbox address is updated ($out, $err) = ('', ''); xsys(qw(git config --file), $pi_config, "$cfgpfx.address", - 'updated-address@example.com'); + $addr = 'updated-address@example.com'); ok(run_script(['-learn', 'rm'], undef, $rdr), 'rm-ed via -learn'); $cur = $git->qx(qw(diff HEAD~1..HEAD)); like($cur, qr/^-Message-ID: <2lids\@example>/sm, 'changed in git'); + + # ensure we can strip List-Unsubscribe + $in = <<EOF; +To: You <you\@example.com> +List-Id: <$list_id> +Message-ID: <unsubscribe-1\@example> +Subject: unsubscribe-1 +From: user <user\@example.com> +To: $addr +Date: Fri, 02 Oct 1993 00:00:00 +0000 +List-Unsubscribe: <https://example.com/some-UUID-here/listname> +List-Unsubscribe-Post: List-Unsubscribe=One-Click + +List-Unsubscribe should be stripped +EOF + write_file '>>', $pi_config, <<EOM; +[publicinboxImport] + dropUniqueUnsubscribe +EOM + $out = $err = ''; + ok(run_script([qw(-mda)], undef, $rdr), 'mda w/ dropUniqueUnsubscribe'); + $cur = join('', grep(/^\+/, $git->qx(qw(diff HEAD~1..HEAD)))); + like $cur, qr/Message-ID: <unsubscribe-1/, 'imported new message'; + unlike $cur, qr/some-UUID-here/, 'List-Unsubscribe gone'; + unlike $cur, qr/List-Unsubscribe-Post/i, 'List-Unsubscribe-Post gone'; + + $in =~ s/unsubscribe-1/unsubscribe-2/g or xbail 'BUG: s// fail'; + ok(run_script([qw(-learn ham)], undef, $rdr), + 'learn ham w/ dropUniqueUnsubscribe'); + $cur = join('', grep(/^\+/, $git->qx(qw(diff HEAD~1..HEAD)))); + like $cur, qr/Message-ID: <unsubscribe-2/, 'learn ham'; + unlike $cur, qr/some-UUID-here/, 'List-Unsubscribe gone on learn ham'; + unlike $cur, qr/List-Unsubscribe-Post/i, + 'List-Unsubscribe-Post gone on learn ham'; } +SKIP: { + require_mods(qw(DBD::SQLite Xapian), 1); + local $ENV{PI_EMERGENCY} = $faildir; + local $ENV{HOME} = $home; + local $ENV{PATH} = $main_path; + my $rdr = { 1 => \(my $out = ''), 2 => \(my $err = '') }; + ok(run_script([qw(-index -L medium), $maindir], undef, $rdr), + 'index inbox'); + my $in = <<'EOM'; +From: a@example.com +To: updated-address@example.com +Subject: this is a ham message for learn +Date: Fri, 02 Oct 1993 00:00:00 +0000 +Message-ID: <medium-ham@example> + +yum +EOM + $rdr->{0} = \$in; + ok(run_script([qw(-learn ham)], undef, $rdr), 'learn medium ham'); + is($err, '', 'nothing in stderr after medium -learn'); + my $msg = $git->cat_file('HEAD:'.mid2path('medium-ham@example')); + like($$msg, qr/medium-ham/, 'medium ham added via -learn'); + my @xap = grep(!m!/over\.sqlite3!, + glob("$maindir/public-inbox/xapian*/*")); + ok(remove_tree(@xap), 'rm Xapian files to convert to indexlevel=basic'); + $in =~ s/medium-ham/basic-ham/g or xbail 'BUG: no s//'; + ok(run_script([qw(-learn ham)], undef, $rdr), 'learn basic ham'); + is($err, '', 'nothing in stderr after basic -learn'); + $msg = $git->cat_file('HEAD:'.mid2path('basic-ham@example')); + like($$msg, qr/basic-ham/, 'basic ham added via -learn'); + @xap = grep(!m!/over\.sqlite3!, + glob("$maindir/public-inbox/xapian*/*")); + is_deeply(\@xap, [], 'no Xapian files created by -learn'); +}; + done_testing(); diff --git a/t/mda_filter_rubylang.t b/t/mda_filter_rubylang.t index d05eec25..42fa6101 100644 --- a/t/mda_filter_rubylang.t +++ b/t/mda_filter_rubylang.t @@ -7,7 +7,7 @@ use PublicInbox::Eml; use PublicInbox::Config; use PublicInbox::TestCommon; require_git(2.6); -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(DBD::SQLite Xapian)); use_ok 'PublicInbox::V2Writable'; my ($tmpdir, $for_destroy) = tmpdir(); my $pi_config = "$tmpdir/pi_config"; diff --git a/t/mh_reader.t b/t/mh_reader.t new file mode 100644 index 00000000..95a7be4a --- /dev/null +++ b/t/mh_reader.t @@ -0,0 +1,119 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use PublicInbox::TestCommon; +require_ok 'PublicInbox::MHreader'; +use PublicInbox::IO qw(write_file); +use PublicInbox::Lock; +use PublicInbox::Eml; +use File::Path qw(remove_tree); +use autodie; +opendir my $cwdfh, '.'; + +my $normal = create_dir 'normal', sub { + write_file '>', 3, "Subject: replied a\n\n"; + write_file '>', 4, "Subject: replied b\n\n"; + write_file '>', 1, "Subject: unseen\n\n"; + write_file '>', 2, "Subject: unseen flagged\n\n"; + write_file '>', '.mh_sequences', <<EOM; +unseen: 1 2 +flagged: 2 +replied: 3 4 +EOM +}; + +my $for_sort = create_dir 'size', sub { + for (1..3) { + my $name = 10 - $_; + write_file '>', $name, "Subject: ".($_ x $_)."\n\n"; + } +}; + +my $stale = create_dir 'stale', sub { + write_file '>', 4, "Subject: msg 4\n\n"; + write_file '>', '.mh_sequences', <<EOM; +unseen: 1 2 +EOM +}; + +{ + my $mhr = PublicInbox::MHreader->new("$normal/", $cwdfh); + $mhr->{sort} = [ '' ]; + my @res; + $mhr->mh_each_eml(sub { push @res, \@_; }, [ 'bogus' ]); + is scalar(@res), 4, 'got 4 messages' or diag explain(\@res); + is_deeply [map { $_->[1] } @res], [1, 2, 3, 4], + 'got messages in expected order'; + is scalar(grep { $_->[4]->[0] eq 'bogus' } @res), scalar(@res), + 'cb arg passed to all messages' or diag explain(\@res); + + $mhr = PublicInbox::MHreader->new("$stale/", $cwdfh); + @res = (); + $mhr->mh_each_eml(sub { push @res, \@_; }); + is scalar(@res), 1, 'ignored stale messages'; +} + +test_lei(sub { + lei_ok qw(convert -f mboxrd), $normal; + my @msgs = grep /\S/s, split /^From .[^\n]+\n/sm, $lei_out; + my @eml = map { PublicInbox::Eml->new($_) } @msgs; + my $h = 'Subject'; + @eml = sort { $a->header_raw($h) cmp $b->header_raw($h) } @eml; + my @has = map { scalar $_->header_raw($h) } @eml; + is_xdeeply \@has, + [ 'replied a', 'replied b', 'unseen', 'unseen flagged' ], + 'subjects sorted'; + $h = 'X-Status'; + @has = map { scalar $_->header_raw($h) } @eml; + is_xdeeply \@has, [ 'A', 'A', undef, 'F' ], 'answered and flagged kw'; + $h = 'Status'; + @has = map { scalar $_->header_raw($h) } @eml; + is_xdeeply \@has, ['RO', 'RO', 'O', 'O'], 'read and old'; + lei_ok qw(import +L:normal), $normal; + lei_ok qw(q L:normal -f mboxrd); + @msgs = grep /\S/s, split /^From .[^\n]+\n/sm, $lei_out; + my @eml2 = map { PublicInbox::Eml->new($_) } @msgs; + $h = 'Subject'; + @eml2 = sort { $a->header_raw($h) cmp $b->header_raw($h) } @eml2; + is_xdeeply \@eml2, \@eml, 'import preserved kw'; + + lei_ok 'ls-mail-sync'; + is $lei_out, 'mh:'.File::Spec->rel2abs($normal)."\n", + 'mail sync stored'; + + lei_ok qw(convert -s size -f mboxrd), "mh:$for_sort"; + chomp(my @s = grep /^Subject:/, split(/^/sm, $lei_out)); + s/^Subject: // for @s; + is_xdeeply \@s, [ 1, 22, 333 ], 'sorted by size'; + + for my $s ([], [ 'name' ], [ 'sequence' ]) { + lei_ok qw(convert -f mboxrd), "mh:$for_sort", '-s', @$s; + chomp(@s = grep /^Subject:/, split(/^/sm, $lei_out)); + s/^Subject: // for @s; + my $desc = "@$s" || '(default)'; + is_xdeeply \@s, [ 333, 22, 1 ], "sorted by: $desc"; + } + + lei_ok qw(import +L:sorttest), "MH:$for_sort"; + lei_ok 'ls-mail-sync', $for_sort; + is $lei_out, 'mh:'.File::Spec->rel2abs($for_sort)."\n", + "mail sync stored with `MH' normalized to `mh'"; + lei_ok qw(index), 'mh:'.$stale; + lei qw(q -f mboxrd), 's:msg 4'; + like $lei_out, qr/^Subject: msg 4\nStatus: RO\n\n\n/ms, + "message retrieved after `lei index'"; + + lei_ok qw(convert -s none -f text), "mh:$for_sort", \'--sort=none'; + + # ensure sort works for _input_ when output disallows sort + my $v2out = "$ENV{HOME}/v2-out"; + for my $sort (['--sort=sequence'], []) { # sequence is the default + lei_ok qw(convert), @$sort, "mh:$for_sort", '-o', "v2:$v2out"; + my $g = PublicInbox::Git->new("$v2out/git/0.git"); + chomp(my @l = $g->qx(qw(log --pretty=oneline --format=%s))); + is_xdeeply \@l, [1, 22, 333], 'sequence order preserved for v2'; + File::Path::remove_tree $v2out; + } +}); + +done_testing; @@ -1,10 +1,10 @@ #!perl -w -# Copyright (C) 2017-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # This library is free software; you can redistribute it and/or modify # it under the same terms as Perl itself. # Artistic or GPL-1+ <https://www.gnu.org/licenses/gpl-1.0.txt> +use v5.10.1; # TODO: check unicode_strings w/ v5.12 use strict; -use Test::More; use PublicInbox::TestCommon; use PublicInbox::MsgIter; my @classes = qw(PublicInbox::Eml); diff --git a/t/miscsearch.t b/t/miscsearch.t index 307812a4..ec837153 100644 --- a/t/miscsearch.t +++ b/t/miscsearch.t @@ -5,7 +5,7 @@ use strict; use v5.10.1; use Test::More; use PublicInbox::TestCommon; -require_mods(qw(Search::Xapian DBD::SQLite)); +require_mods(qw(Xapian DBD::SQLite)); use_ok 'PublicInbox::MiscSearch'; use_ok 'PublicInbox::MiscIdx'; diff --git a/t/net_reader-imap.t b/t/net_reader-imap.t index 5de8f92b..7b7f5cbe 100644 --- a/t/net_reader-imap.t +++ b/t/net_reader-imap.t @@ -3,7 +3,7 @@ # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use PublicInbox::TestCommon; require_git 2.6; -require_mods(qw(-imapd Search::Xapian Mail::IMAPClient)); +require_mods(qw(-imapd Xapian Mail::IMAPClient)); use PublicInbox::Config; my ($tmpdir, $for_destroy) = tmpdir; my ($ro_home, $cfg_path) = setup_public_inboxes; @@ -1,72 +1,72 @@ -# Copyright (C) 2015-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use warnings; -use Test::More; +use v5.12; use PublicInbox::TestCommon; use PublicInbox::Eml; -require_mods(qw(DBD::SQLite Data::Dumper)); +require_mods(qw(DBD::SQLite)); use_ok 'PublicInbox::NNTP'; -use_ok 'PublicInbox::Inbox'; use PublicInbox::Config; +use POSIX qw(strftime); +use Data::Dumper; { - sub quote_str { - my (undef, $s) = split(/ = /, Data::Dumper::Dumper($_[0]), 2); + my $quote_str = sub { + my ($orig) = @_; + my (undef, $s) = split(/ = /, Dumper($orig), 2); + $s // diag explain(['$s undefined, $orig = ', $orig]); $s =~ s/;\n//; $s; - } + }; - sub wm_prepare { + my $wm_prepare = sub { my ($wm) = @_; my $orig = qq{'$wm'}; PublicInbox::NNTP::wildmat2re($_[0]); - my $new = quote_str($_[0]); + my $new = $quote_str->($_[0]); ($orig, $new); - } + }; - sub wildmat_like { + my $wildmat_like = sub { my ($str, $wm) = @_; - my ($orig, $new) = wm_prepare($wm); + my ($orig, $new) = $wm_prepare->($wm); like($str, $wm, "$orig matches '$str' using $new"); - } + }; - sub wildmat_unlike { + my $wildmat_unlike = sub { my ($str, $wm, $check_ex) = @_; if ($check_ex) { use re 'eval'; my $re = qr/$wm/; like($str, $re, "normal re with $wm matches, but ..."); } - my ($orig, $new) = wm_prepare($wm); + my ($orig, $new) = $wm_prepare->($wm); unlike($str, $wm, "$orig does not match '$str' using $new"); - } + }; - wildmat_like('[foo]', '[\[foo\]]'); - wildmat_like('any', '*'); - wildmat_unlike('bar.foo.bar', 'foo.*'); + $wildmat_like->('[foo]', '[\[foo\]]'); + $wildmat_like->('any', '*'); + $wildmat_unlike->('bar.foo.bar', 'foo.*'); # no code execution - wildmat_unlike('HI', '(?{"HI"})', 1); - wildmat_unlike('HI', '[(?{"HI"})]', 1); + $wildmat_unlike->('HI', '(?{"HI"})', 1); + $wildmat_unlike->('HI', '[(?{"HI"})]', 1); } { - sub ngpat_like { + my $ngpat_like = sub { my ($str, $pat) = @_; my $orig = $pat; PublicInbox::NNTP::ngpat2re($pat); like($str, $pat, "'$orig' matches '$str' using $pat"); - } + }; - ngpat_like('any', '*'); - ngpat_like('a.s.r', 'a.t,a.s.r'); - ngpat_like('a.s.r', 'a.t,a.s.*'); + $ngpat_like->('any', '*'); + $ngpat_like->('a.s.r', 'a.t,a.s.r'); + $ngpat_like->('a.s.r', 'a.t,a.s.*'); } { - use POSIX qw(strftime); - sub time_roundtrip { + my $time_roundtrip = sub { my ($date, $time, $gmt) = @_; my $m = join(' ', @_); my $ts = PublicInbox::NNTP::parse_time(@_); @@ -77,12 +77,12 @@ use PublicInbox::Config; } is_deeply([$d, $t], [$date, $time], "roundtripped: $m"); $ts; - } - my $x1 = time_roundtrip(qw(20141109 060606 GMT)); - my $x2 = time_roundtrip(qw(141109 060606 GMT)); - my $x3 = time_roundtrip(qw(930724 060606 GMT)); - my $x5 = time_roundtrip(qw(710101 000000)); - my $x6 = time_roundtrip(qw(720101 000000)); + }; + my $x1 = $time_roundtrip->(qw(20141109 060606 GMT)); + my $x2 = $time_roundtrip->(qw(141109 060606 GMT)); + my $x3 = $time_roundtrip->(qw(930724 060606 GMT)); + my $x5 = $time_roundtrip->(qw(710101 000000)); + my $x6 = $time_roundtrip->(qw(720101 000000)); SKIP: { skip('YYMMDD test needs updating', 6) if (time > 0x7fffffff); # our world probably ends in 2038, but if not we'll try to @@ -90,7 +90,7 @@ use PublicInbox::Config; is($x1, $x2, 'YYYYMMDD and YYMMDD parse identically'); is(strftime('%Y', gmtime($x3)), '1993', '930724 was in 1993'); - my $epoch = time_roundtrip(qw(700101 000000 GMT)); + my $epoch = $time_roundtrip->(qw(700101 000000 GMT)); is($epoch, 0, 'epoch parsed correctly'); ok($x6 > $x5, '1972 > 1971'); ok($x5 > $epoch, '1971 > Unix epoch'); diff --git a/t/nntpd-tls.t b/t/nntpd-tls.t index 2a76867a..a16cc015 100644 --- a/t/nntpd-tls.t +++ b/t/nntpd-tls.t @@ -1,8 +1,7 @@ #!perl -w -# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use v5.10.1; +use v5.12; use PublicInbox::TestCommon; use Socket qw(SOCK_STREAM IPPROTO_TCP SOL_SOCKET); # IO::Poll and Net::NNTP are part of the standard library, but @@ -149,10 +148,22 @@ for my $args ( test_lei(sub { lei_ok qw(ls-mail-source), "nntp://$starttls_addr", \'STARTTLS not used by default'; - ok(!lei(qw(ls-mail-source -c nntp.starttls=true), + my $plain_out = $lei_out; + ok(!lei(qw(ls-mail-source -c nntp.starttls), "nntp://$starttls_addr"), 'STARTTLS verify fails'); like $lei_err, qr/STARTTLS requested/, 'STARTTLS noted in stderr'; + unlike $lei_err, qr!W: nntp\.starttls= .*? is not boolean!i, + 'no non-boolean warning'; + lei_ok qw(-c nntp.starttls -c nntp.sslVerify= ls-mail-source), + "nntp://$starttls_addr", + \'disabling nntp.sslVerify works w/ STARTTLS'; + is $lei_out, $plain_out, 'sslVerify=false w/ STARTTLS output'; + + lei_ok qw(ls-mail-source -c nntp.sslVerify=false), + "nntps://$nntps_addr", + \'disabling nntp.sslVerify works w/ nntps://'; + is $lei_out, $plain_out, 'sslVerify=false w/ NNTPS output'; }); SKIP: { @@ -164,10 +175,7 @@ for my $args ( is(unpack('i', $x), 0, 'TCP_DEFER_ACCEPT is 0 on plain NNTP'); }; SKIP: { - skip 'SO_ACCEPTFILTER is FreeBSD-only', 2 if $^O ne 'freebsd'; - if (system('kldstat -m accf_data >/dev/null')) { - skip 'accf_data not loaded? kldload accf_data', 2; - } + require_mods '+accf_data'; require PublicInbox::Daemon; my $x = getsockopt($nntps, SOL_SOCKET, $PublicInbox::Daemon::SO_ACCEPTFILTER); @@ -177,6 +185,14 @@ for my $args ( is($x, undef, 'no BSD accept filter for plain NNTP'); }; + my $s = tcp_connect($nntps); + syswrite($s, '->accept_SSL_ will fail on this!'); + my @r; + do { # some platforms or OpenSSL versions need an extra read + push @r, sysread($s, my $rbuf, 128); + } while ($r[-1] && @r < 2); + ok(!$r[-1], 'EOF or ECONNRESET on ->accept_SSL fail') or + diag explain(\@r); $c = undef; $td->kill; $td->join; @@ -187,6 +203,7 @@ for my $args ( <$fh>; }; unlike($eout, qr/wide/i, 'no Wide character warnings'); + unlike($eout, qr/^E:/, 'no other errors'); } done_testing(); @@ -2,20 +2,19 @@ # Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use PublicInbox::TestCommon; -require_mods(qw(DBD::SQLite)); +require_mods(qw(DBD::SQLite Net::NNTP)); use PublicInbox::Eml; use Socket qw(IPPROTO_TCP TCP_NODELAY); -use Net::NNTP; use Sys::Hostname; use POSIX qw(_exit); -use Digest::SHA; +use PublicInbox::SHA; +use PublicInbox::DS; # t/nntpd-v2.t wraps this for v2 my $version = $ENV{PI_TEST_VERSION} || 1; require_git('2.6') if $version == 2; use_ok 'PublicInbox::Msgmap'; -my $lsof = require_cmd('lsof', 1); -my $fast_idle = eval { require Linux::Inotify2; 1 } // +my $fast_idle = eval { require PublicInbox::Inotify; 1 } // eval { require IO::KQueue; 1 }; my ($tmpdir, $for_destroy) = tmpdir(); @@ -94,6 +93,13 @@ close $cfgfh or BAIL_OUT; is_deeply([$n->group($group)], [ qw(0 1 1), $group ], 'GROUP works'); is_deeply($n->listgroup($group), [1], 'listgroup OK'); # TODO: Net::NNTP::listgroup does not support range at the moment + my $s = tcp_connect($sock); + sysread($s, my $buf, 4096); + is($buf, "201 " . hostname . " ready - post via email\r\n", + 'got greeting'); + syswrite($s, "LISTGROUP $group 1-1\r\n"); + $buf = read_til_dot($s); + like($buf, qr/\r\n1\r\n/s, 'LISTGROUP with range works'); { my $expect = [ qw(Subject: From: Date: Message-ID: @@ -121,8 +127,8 @@ close $cfgfh or BAIL_OUT; 'references' => '<reftabsqueezed>', ); - my $s = tcp_connect($sock); - sysread($s, my $buf, 4096); + $s = tcp_connect($sock); + sysread($s, $buf, 4096); is($buf, "201 " . hostname . " ready - post via email\r\n", 'got greeting'); @@ -298,7 +304,7 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000 my %sums; for (1..$nart) { <$s> =~ /\A220 / or _exit(4); - my $dig = Digest::SHA->new(1); + my $dig = PublicInbox::SHA->new(1); while (my $l = <$s>) { last if $l eq ".\r\n"; $dig->add($l); @@ -321,19 +327,19 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000 } my $noerr = { 2 => \(my $null) }; SKIP: { - if ($INC{'Search/Xapian.pm'} && ($ENV{TEST_RUN_MODE}//2)) { - skip 'Search/Xapian.pm pre-loaded (by t/run.perl?)', 1; + if ($INC{'Search/Xapian.pm'} || $INC{'Xapian.pm'} && + ($ENV{TEST_RUN_MODE} // 2)) { + skip 'Xapian.pm pre-loaded (by xt/check-run.t?)', 1; } - $lsof or skip 'lsof missing', 1; - my @of = xqx([$lsof, '-p', $td->{pid}], undef, $noerr); - skip('lsof broken', 1) if (!scalar(@of) || $?); - my @xap = grep m!Search/Xapian!, @of; - is_deeply(\@xap, [], 'Xapian not loaded in nntpd'); + my @of = lsof_pid $td->{pid}, $noerr; + my @xap = grep m!\bXapian\b!, @of; + is_deeply(\@xap, [], 'Xapian not loaded in nntpd') or + diag explain(\@of); } # -compact requires Xapian SKIP: { - require_mods('Search::Xapian', 2); - have_xapian_compact or skip 'xapian-compact missing', 2; + require_mods('Xapian', 1); + have_xapian_compact 1; is(xsys(qw(git config), "--file=$home/.public-inbox/config", "publicinbox.$group.indexlevel", 'medium'), 0, 'upgraded indexlevel'); @@ -352,23 +358,24 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000 } ok(run_script([qw(-index -c -j0 --reindex), $ibx->{inboxdir}], undef, $noerr), '-compacted'); - select(undef, undef, undef, $fast_idle ? 0.1 : 2.1); + tick($fast_idle ? 0.1 : 2.1); $art = $n->article($ex->header('Message-ID')); ok($art, 'new article retrieved after compact'); - $lsof or skip 'lsof missing', 1; - ($^O =~ /\A(?:linux)\z/) or + $^O eq 'linux' or skip "lsof /(deleted)/ check untested on $^O", 1; - my @lsof = xqx([$lsof, '-p', $td->{pid}], undef, $noerr); - my $d = [ grep(/\(deleted\)/, @lsof) ]; - is_deeply($d, [], 'no deleted files') or diag explain($d); + my $fd = "/proc/$td->{pid}/fd"; + -d $fd or skip '/proc/PID/fd missing', 1; + my @of = map readlink, glob "$fd/*"; + my @d = grep /\(deleted\)/, grep !/batch-command\.err/, @of; + is_deeply(\@d, [], 'no deleted files') or diag explain(\@d); }; SKIP: { test_watch($tmpdir, $host_port, $group) }; { setsockopt($s, IPPROTO_TCP, TCP_NODELAY, 1); syswrite($s, 'HDR List-id 1-'); - select(undef, undef, undef, 0.15); + tick(0.15); ok($td->kill, 'killed nntpd'); - select(undef, undef, undef, 0.15); + tick(0.15); syswrite($s, "\r\n"); $buf = ''; do { @@ -407,7 +414,7 @@ sub test_watch { use_ok 'PublicInbox::Watch'; use_ok 'PublicInbox::InboxIdle'; use_ok 'PublicInbox::Config'; - require_git('1.8.5', 1) or skip('git 1.8.5+ needed for --urlmatch', 4); + require_git('1.8.5', 4); my $old_env = { HOME => $ENV{HOME} }; my $home = "$tmpdir/watch_home"; mkdir $home or BAIL_OUT $!; @@ -430,7 +437,7 @@ sub test_watch { my $cfg = PublicInbox::Config->new; PublicInbox::DS->Reset; my $ii = PublicInbox::InboxIdle->new($cfg); - my $cb = sub { PublicInbox::DS->SetPostLoopCallback(sub {}) }; + my $cb = sub { @PublicInbox::DS::post_loop_do = (sub {}) }; my $obj = bless \$cb, 'PublicInbox::TestCommon::InboxWakeup'; $cfg->each_inbox(sub { $_[0]->subscribe_unlock('ident', $obj) }); my $watcherr = "$tmpdir/watcherr"; diff --git a/t/on_destroy.t b/t/on_destroy.t index 0de67d0b..e8fdf35e 100644 --- a/t/on_destroy.t +++ b/t/on_destroy.t @@ -1,33 +1,44 @@ #!perl -w -use strict; -use v5.10.1; +use v5.12; use Test::More; -require_ok 'PublicInbox::OnDestroy'; +use PublicInbox::OnDestroy; +use POSIX qw(_exit); my @x; -my $od = PublicInbox::OnDestroy->new(sub { push @x, 'hi' }); +my $od = on_destroy sub { push @x, 'hi' }; is_deeply(\@x, [], 'not called, yet'); undef $od; is_deeply(\@x, [ 'hi' ], 'no args works'); -$od = PublicInbox::OnDestroy->new(sub { $x[0] = $_[0] }, 'bye'); +$od = on_destroy sub { $x[0] = $_[0] }, 'bye'; is_deeply(\@x, [ 'hi' ], 'nothing changed while alive'); undef $od; is_deeply(\@x, [ 'bye' ], 'arg passed'); -$od = PublicInbox::OnDestroy->new(sub { @x = @_ }, qw(x y)); +$od = on_destroy sub { @x = @_ }, qw(x y); undef $od; is_deeply(\@x, [ 'x', 'y' ], '2 args passed'); open my $tmp, '+>>', undef or BAIL_OUT $!; $tmp->autoflush(1); -$od = PublicInbox::OnDestroy->new(1, sub { print $tmp "$$ DESTROY\n" }); -undef $od; +$od = on_destroy sub { print $tmp "$$ DESTROY\n" }; +my $pid = PublicInbox::OnDestroy::fork_tmp; +if ($pid == 0) { undef $od; _exit 0; }; +waitpid($pid, 0); +is $?, 0, 'test process exited'; is(-s $tmp, 0, '$tmp is empty on pid mismatch'); -$od = PublicInbox::OnDestroy->new($$, sub { $tmp = $$ }); +$od->cancel; +undef $od; +is(-s $tmp, 0, '$tmp is empty after ->cancel'); +$od = on_destroy sub { $tmp = $$ }; undef $od; is($tmp, $$, '$tmp set to $$ by callback'); +$od = on_destroy sub { $tmp = 'foo' }; +$od->cancel; +$od = undef; +isnt($tmp, 'foo', '->cancel'); + if (my $nr = $ENV{TEST_LEAK_NR}) { for (0..$nr) { - $od = PublicInbox::OnDestroy->new(sub { @x = @_ }, qw(x y)); + $od = on_destroy sub { @x = @_ }, qw(x y); } } @@ -1,5 +1,5 @@ #!perl -w -# Copyright (C) 2014-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; @@ -9,10 +9,11 @@ my @mods = qw(HTTP::Request::Common Plack::Test URI::Escape); require_mods(@mods); foreach my $mod (@mods) { use_ok $mod; } ok(-f $psgi, "psgi example file found"); +my ($tmpdir, $for_destroy) = tmpdir(); my $pfx = 'http://example.com/test'; my $eml = eml_load('t/iso-2202-jp.eml'); # ensure successful message deliveries -my $ibx = create_inbox('test-1', sub { +my $ibx = create_inbox('u8-2', sub { my ($im, $ibx) = @_; my $addr = $ibx->{-primary_address}; $im->add($eml) or xbail '->add'; @@ -38,6 +39,8 @@ EOF # multipart with attached patch + filename $im->add(eml_load('t/plack-attached-patch.eml')) or BAIL_OUT '->add'; + $im->add(eml_load('t/data/attached-mbox-with-utf8.eml')) or xbail 'add'; + # multipart collapsed to single quoted-printable text/plain $im->add(eml_load('t/plack-qp.eml')) or BAIL_OUT '->add'; my $crlf = <<EOF; @@ -71,91 +74,74 @@ EOF close $fh or BAIL_OUT "close: $!"; }); -local $ENV{PI_CONFIG} = "$ibx->{inboxdir}/pi_config"; -my $app = require $psgi; -test_psgi($app, sub { +my $env = { PI_CONFIG => "$ibx->{inboxdir}/pi_config", TMPDIR => $tmpdir }; +local @ENV{keys %$env} = values %$env; +my $c1 = sub { my ($cb) = @_; + my $uri = $ENV{PLACK_TEST_EXTERNALSERVER_URI} // 'http://example.com'; + $pfx = "$uri/test"; + foreach my $u (qw(robots.txt favicon.ico .well-known/foo)) { - my $res = $cb->(GET("http://example.com/$u")); + my $res = $cb->(GET("$uri/$u")); is($res->code, 404, "$u is missing"); } -}); -test_psgi($app, sub { - my ($cb) = @_; - my $res = $cb->(GET('http://example.com/test/crlf@example.com/')); + my $res = $cb->(GET("$uri/test/crlf\@example.com/")); is($res->code, 200, 'retrieved CRLF as HTML'); like($res->content, qr/mailto:me\@example/, 'no %40, per RFC 6068'); unlike($res->content, qr/\r/, 'no CR in HTML'); - $res = $cb->(GET('http://example.com/test/crlf@example.com/raw')); + $res = $cb->(GET("$uri/test/crlf\@example.com/raw")); is($res->code, 200, 'retrieved CRLF raw'); like($res->content, qr/\r/, 'CR preserved in raw message'); - $res = $cb->(GET('http://example.com/test/bogus@example.com/raw')); + $res = $cb->(GET("$uri/test/bogus\@example.com/raw")); is($res->code, 404, 'missing /raw is 404'); -}); -# redirect with newsgroup -test_psgi($app, sub { - my ($cb) = @_; - my $from = 'http://example.com/inbox.test'; - my $to = 'http://example.com/test/'; - my $res = $cb->(GET($from)); + # redirect with newsgroup + my $from = "$uri/inbox.test"; + my $to = "http://example.com/test/"; + $res = $cb->(GET($from)); is($res->code, 301, 'newsgroup name is permanent redirect'); is($to, $res->header('Location'), 'redirect location matches'); $from .= '/'; is($res->code, 301, 'newsgroup name/ is permanent redirect'); is($to, $res->header('Location'), 'redirect location matches'); -}); -# redirect with trailing / -test_psgi($app, sub { - my ($cb) = @_; - my $from = 'http://example.com/test'; - my $to = "$from/"; - my $res = $cb->(GET($from)); + # redirect with trailing / + $from = "$uri/test"; + $to = "$from/"; + $res = $cb->(GET($from)); is(301, $res->code, 'is permanent redirect'); is($to, $res->header('Location'), 'redirect location matches with trailing slash'); -}); -foreach my $t (qw(t T)) { - test_psgi($app, sub { - my ($cb) = @_; + for my $t (qw(T t)) { my $u = $pfx . "/blah\@example.com/$t"; - my $res = $cb->(GET($u)); + $res = $cb->(GET($u)); is(301, $res->code, "redirect for missing /"); my $location = $res->header('Location'); like($location, qr!/\Q$t\E/#u\z!, 'redirected with missing /'); - }); -} -foreach my $t (qw(f)) { - test_psgi($app, sub { - my ($cb) = @_; + } + + for my $t (qw(f)) { # legacy redirect my $u = $pfx . "/blah\@example.com/$t"; - my $res = $cb->(GET($u)); + $res = $cb->(GET($u)); is(301, $res->code, "redirect for legacy /f"); my $location = $res->header('Location'); like($location, qr!/blah\@example\.com/\z!, 'redirected with missing /'); - }); -} + } -test_psgi($app, sub { - my ($cb) = @_; - my $atomurl = 'http://example.com/test/new.atom'; - my $res = $cb->(GET('http://example.com/test/new.html')); + my $atomurl = "$uri/test/new.atom"; + $res = $cb->(GET("$uri/test/new.html")); is(200, $res->code, 'success response received'); like($res->content, qr!href="new\.atom"!, 'atom URL generated'); like($res->content, qr!href="blah\@example\.com/"!, 'index generated'); like($res->content, qr!1993-10-02!, 'date set'); -}); -test_psgi($app, sub { - my ($cb) = @_; - my $res = $cb->(GET($pfx . '/atom.xml')); + $res = $cb->(GET($pfx . '/atom.xml')); is(200, $res->code, 'success response received for atom'); my $body = $res->content; like($body, qr!link\s+href="\Q$pfx\E/blah\@example\.com/"!s, @@ -165,17 +151,17 @@ test_psgi($app, sub { like($body, qr/zzzzzz/, 'body included'); $res = $cb->(GET($pfx . '/description')); like($res->content, qr/test for public-inbox/, 'got description'); -}); -test_psgi($app, sub { - my ($cb) = @_; my $path = '/blah@example.com/'; - my $res = $cb->(GET($pfx . $path)); + $res = $cb->(GET($pfx . $path)); is(200, $res->code, "success for $path"); my $html = $res->content; + like($html, qr!\bhref="\Q../_/text/help/"!, 'help available'); like($html, qr!<title>hihi - Me</title>!, 'HTML returned'); - like($html, qr!<a\nhref="raw"!s, 'raw link present'); + like($html, qr!<a\nhref=raw!s, 'raw link present'); like($html, qr!> quoted text!s, 'quoted text inline'); + unlike($html, qr!thread overview!, + 'thread overview not shown w/o ->over'); $path .= 'f/'; $res = $cb->(GET($pfx . $path)); @@ -196,11 +182,12 @@ test_psgi($app, sub { $res = $cb->(GET($pfx . '/qp@example.com/')); like($res->content, qr/\bhi = bye\b/, "HTML output decoded QP"); -}); -test_psgi($app, sub { - my ($cb) = @_; - my $res = $cb->(GET($pfx . '/blah@example.com/raw')); + $res = $cb->(GET($pfx . '/attached-mbox-with-utf8@example/')); + like($res->content, qr/: Bjørn /, 'UTF-8 in mbox #1'); + like($res->content, qr/: j Żen/, 'UTF-8 in mbox #2'); + + $res = $cb->(GET($pfx . '/blah@example.com/raw')); is(200, $res->code, 'success response received for /*/raw'); like($res->content, qr!^From !sm, "mbox returned"); is($res->header('Content-Type'), 'text/plain; charset=iso-8859-1', @@ -213,75 +200,65 @@ test_psgi($app, sub { $res = $cb->(GET($pfx . '/199707281508.AAA24167@hoyogw.example/raw')); is($res->header('Content-Type'), 'text/plain; charset=ISO-2022-JP', 'ISO-2002-JP returned'); - chomp(my $body = $res->content); + chomp($body = $res->content); my $raw = PublicInbox::Eml->new(\$body); is($raw->body_raw, $eml->body_raw, 'ISO-2022-JP body unmodified'); - $res = $cb->(GET($pfx . '/blah@example.com/t.mbox.gz')); - is(501, $res->code, '501 when overview missing'); - like($res->content, qr!\bOverview\b!, 'overview omission noted'); -}); + for my $u (qw(blah@example.com/t.mbox.gz topics_new.html + topics_active.html)) { + $res = $cb->(GET("$pfx/$u")); + is(501, $res->code, "501 on /$u when overview missing"); + like($res->content, qr!\bOverview\b!, + "overview omission noted for /$u"); + } -# legacy redirects -foreach my $t (qw(m f)) { - test_psgi($app, sub { - my ($cb) = @_; - my $res = $cb->(GET($pfx . "/$t/blah\@example.com.txt")); + # legacy redirects + for my $t (qw(m f)) { + $res = $cb->(GET($pfx . "/$t/blah\@example.com.txt")); is(301, $res->code, "redirect for old $t .txt link"); - my $location = $res->header('Location'); + $location = $res->header('Location'); like($location, qr!/blah\@example\.com/raw\z!, ".txt redirected to /raw"); - }); -} - -my %umap = ( - 'm' => '', - 'f' => '', - 't' => 't/', -); -while (my ($t, $e) = each %umap) { - test_psgi($app, sub { - my ($cb) = @_; - my $res = $cb->(GET($pfx . "/$t/blah\@example.com.html")); + } + + my %umap = ( + 'm' => '', + 'f' => '', + 't' => 't/', + ); + while (my ($t, $e) = each %umap) { + $res = $cb->(GET($pfx . "/$t/blah\@example.com.html")); is(301, $res->code, "redirect for old $t .html link"); - my $location = $res->header('Location'); - like($location, - qr!/blah\@example\.com/$e(?:#u)?\z!, - ".html redirected to new location"); - }); -} -foreach my $sfx (qw(mbox mbox.gz)) { - test_psgi($app, sub { - my ($cb) = @_; - my $res = $cb->(GET($pfx . "/t/blah\@example.com.$sfx")); + $location = $res->header('Location'); + like($location, qr!/blah\@example\.com/$e(?:#u)?\z!, + ".html redirected to new location"); + } + + for my $sfx (qw(mbox mbox.gz)) { + $res = $cb->(GET($pfx . "/t/blah\@example.com.$sfx")); is(301, $res->code, 'redirect for old thread link'); - my $location = $res->header('Location'); + $location = $res->header('Location'); like($location, qr!/blah\@example\.com/t\.mbox(?:\.gz)?\z!, "$sfx redirected to /mbox.gz"); - }); -} -test_psgi($app, sub { - my ($cb) = @_; + } + # for a while, we used to support /$INBOX/$X40/ # when we "compressed" long Message-IDs to SHA-1 # Now we're stuck supporting them forever :< - foreach my $path ('f2912279bd7bcd8b7ab3033234942d58746d56f7') { - my $from = "http://example.com/test/$path/"; - my $res = $cb->(GET($from)); + for my $path ('f2912279bd7bcd8b7ab3033234942d58746d56f7') { + $from = "$uri/test/$path/"; + $res = $cb->(GET($from)); is(301, $res->code, 'is permanent redirect'); like($res->header('Location'), qr!/test/blah\@example\.com/!, 'redirect from x40 MIDs works'); } -}); -# dumb HTTP clone/fetch support -test_psgi($app, sub { - my ($cb) = @_; - my $path = '/test/info/refs'; + # dumb HTTP clone/fetch support + $path = '/test/info/refs'; my $req = HTTP::Request->new('GET' => $path); - my $res = $cb->($req); + $res = $cb->($req); is(200, $res->code, 'refs readable'); my $orig = $res->content; @@ -294,19 +271,14 @@ test_psgi($app, sub { $res = $cb->($req); is(206, $res->code, 'got partial another response'); is($res->content, substr($orig, 5), 'partial body OK past end'); -}); -# things which should fail -test_psgi($app, sub { - my ($cb) = @_; - my $res = $cb->(PUT('/')); + # things which should fail + $res = $cb->(PUT('/')); is(405, $res->code, 'no PUT to / allowed'); $res = $cb->(PUT('/test/')); is(405, $res->code, 'no PUT /$INBOX allowed'); - - # TODO - # $res = $cb->(GET('/')); -}); - -done_testing(); +}; +test_psgi(require $psgi, $c1); +test_httpd($env, $c1); +done_testing; diff --git a/t/pop3d-limit.t b/t/pop3d-limit.t new file mode 100644 index 00000000..f52c8802 --- /dev/null +++ b/t/pop3d-limit.t @@ -0,0 +1,144 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use v5.12; +use PublicInbox::TestCommon; +require_mods(qw(DBD::SQLite Net::POP3 :fcntl_lock)); +use autodie; +my ($tmpdir, $for_destroy) = tmpdir(); +mkdir("$tmpdir/p3state"); +use PublicInbox::Eml; +my $group = 'test.pop3d.limit'; +my $addr = 'pop3d-limit@example.com'; + +my $add_msg = sub { + my ($im, $n) = @_; + $im->add(PublicInbox::Eml->new(<<EOM)) or die 'add dup'; +From: $n\@example.com +Subject: msg $n +To: $addr +Message-ID: <mid-$n\@example.com> +Date: Sat, 02 Oct 2010 00:00:00 +0000 + +body $n +EOM +}; + +my $ibx = create_inbox 'pop3d-limit', -primary_address => $addr, + indexlevel => 'basic', tmpdir => "$tmpdir/ibx", sub { + my ($im, $ibx) = @_; + $add_msg->($im, $_) for (1..3); + $im->done; + diag 'done'; +}; # /create_inbox + +my $pi_config = "$tmpdir/pi_config"; +{ + open my $fh, '>', $pi_config; + print $fh <<EOF; +[publicinbox] + pop3state = $tmpdir/p3state +[publicinbox "pop3"] + inboxdir = $ibx->{inboxdir} + address = $addr + indexlevel = basic + newsgroup = $group +EOF + close $fh; +} + +my $plain = tcp_server(); +my $plain_addr = tcp_host_port($plain); +my $env = { PI_CONFIG => $pi_config }; +my $p3d = start_script([qw(-pop3d -W0), + "--stdout=$tmpdir/out.log", "--stderr=$tmpdir/err.log" ], + $env, { 3 => $plain }); +my @np3args = ($plain->sockhost, Port => $plain->sockport); +my $fetch_delete = sub { + my ($np3) = @_; + map { + my $msg = $np3->get($_); + $np3->delete($_); + PublicInbox::Eml->new(join('', @$msg)); + } sort { $a <=> $b } keys %{$np3->list}; +}; + +my $login_a = ('a'x32)."\@$group?initial_limit=2&limit=1"; +my $login_a0 = ('a'x32)."\@$group.0?initial_limit=2&limit=1"; +my $login_b = ('b'x32)."\@$group?limit=1"; +my $login_b0 = ('b'x32)."\@$group.0?limit=1"; +my $login_c = ('c'x32)."\@$group?limit=10"; +my $login_c0 = ('c'x32)."\@$group.0?limit=10"; +my $login_d = ('d'x32)."\@$group?limit=100000"; +my $login_d0 = ('d'x32)."\@$group.0?limit=100000"; + +for my $login ($login_a, $login_a0) { + my $np3 = Net::POP3->new(@np3args) or xbail "Net::POP3 $!"; + $np3->login($login, 'anonymous') or xbail "login $login ($!)"; + my @msg = $fetch_delete->($np3); + $np3->quit; + is_deeply([ map { $_->header('Message-ID') } @msg ], + [ qw(<mid-2@example.com> <mid-3@example.com>) ], + "initial_limit ($login)") or diag explain(\@msg); +} + +for my $login ($login_b, $login_b0) { + my $np3 = Net::POP3->new(@np3args); + $np3->login($login, 'anonymous') or xbail "login $login ($!)"; + my @msg = $fetch_delete->($np3); + $np3->quit; + is_deeply([ map { $_->header('Message-ID') } @msg ], + [ qw(<mid-3@example.com>) ], + "limit-only ($login)") or diag explain(\@msg); +} + +for my $login ($login_c, $login_c0, $login_d, $login_d0) { + my $np3 = Net::POP3->new(@np3args); + $np3->login($login, 'anonymous') or xbail "login $login ($!)"; + my @msg = $fetch_delete->($np3); + $np3->quit; + is_deeply([ map { $_->header('Message-ID') } @msg ], + [ qw(<mid-1@example.com> <mid-2@example.com> + <mid-3@example.com>) ], + "excessive limit ($login)") or diag explain(\@msg); +} + +{ # add some new messages + my $im = $ibx->importer(0); + $add_msg->($im, $_) for (4..5); + $im->done; +} + +for my $login ($login_a, $login_a0) { + my $np3 = Net::POP3->new(@np3args); + $np3->login($login, 'anonymous') or xbail "login $login ($!)"; + my @msg = $fetch_delete->($np3); + $np3->quit; + is_deeply([ map { $_->header('Message-ID') } @msg ], + [ qw(<mid-5@example.com>) ], + "limit used (initial_limit ignored, $login)") or + diag explain(\@msg); +} + +for my $login ($login_b, $login_b0) { + my $np3 = Net::POP3->new(@np3args); + $np3->login($login, 'anonymous') or xbail "login $login ($!)"; + my @msg = $fetch_delete->($np3); + $np3->quit; + is_deeply([ map { $_->header('Message-ID') } @msg ], + [ qw(<mid-5@example.com>) ], + "limit-only after new messages ($login)") or + diag explain(\@msg); +} + +for my $login ($login_c, $login_c0, $login_d, $login_d0) { + my $np3 = Net::POP3->new(@np3args); + $np3->login($login, 'anonymous') or xbail "login $login ($!)"; + my @msg = $fetch_delete->($np3); + $np3->quit; + is_deeply([ map { $_->header('Message-ID') } @msg ], + [ qw(<mid-4@example.com> <mid-5@example.com>) ], + "excessive limit ($login)") or diag explain(\@msg); +} + +done_testing; @@ -4,10 +4,16 @@ use v5.12; use PublicInbox::TestCommon; use Socket qw(IPPROTO_TCP SOL_SOCKET); +my $cert = 'certs/server-cert.pem'; +my $key = 'certs/server-key.pem'; +unless (-r $key && -r $cert) { + plan skip_all => + "certs/ missing for $0, run $^X ./create-certs.perl in certs/"; +} + # Net::POP3 is part of the standard library, but distros may split it off... -require_mods(qw(DBD::SQLite Net::POP3 IO::Socket::SSL)); -require_git('2.6'); # for v2 -require_mods(qw(File::FcntlLock)) if $^O !~ /\A(?:linux|freebsd)\z/; +require_mods(qw(DBD::SQLite Net::POP3 IO::Socket::SSL :fcntl_lock)); +require_git(v2.6); # for v2 use_ok 'IO::Socket::SSL'; use_ok 'PublicInbox::TLS'; my ($tmpdir, $for_destroy) = tmpdir(); @@ -44,14 +50,6 @@ my $pop3s_addr = tcp_host_port($pop3s); my $stls_addr = tcp_host_port($stls); my $plain_addr = tcp_host_port($plain); my $env = { PI_CONFIG => $pi_config }; -my $cert = 'certs/server-cert.pem'; -my $key = 'certs/server-key.pem'; - -unless (-r $key && -r $cert) { - plan skip_all => - "certs/ missing for $0, run $^X ./create-certs.perl in certs/"; -} - my $old = start_script(['-pop3d', '-W0', "--stdout=$tmpdir/plain.out", "--stderr=$olderr" ], $env, { 3 => $plain }); @@ -60,6 +58,14 @@ my $oldc = Net::POP3->new(@old_args); my $locked_mb = ('e'x32)."\@$group"; ok($oldc->apop("$locked_mb.0", 'anonymous'), 'APOP to old'); +my $dbh = DBI->connect("dbi:SQLite:dbname=$tmpdir/p3state/db.sqlite3",'','', { + AutoCommit => 1, + RaiseError => 1, + PrintError => 0, + sqlite_use_immediate_transaction => 1, + sqlite_see_if_its_a_number => 1, +}); + { # locking within the same process my $x = Net::POP3->new(@old_args); ok(!$x->apop("$locked_mb.0", 'anonymous'), 'APOP lock failure'); @@ -146,11 +152,26 @@ for my $args ( ok(!$np3->apop($mailbox, 'anonymous'), "APOP $mailbox reject"); ok($np3->quit, "QUIT after APOP fail $mailbox"); } + + # we do connect+QUIT bumps to try ensuring non-QUIT disconnects + # get processed below: for my $mailbox ($group, "$group.0") { my $u = ('f'x32)."\@$mailbox"; + undef $np3; + ok(Net::POP3->new(@np3_args)->quit, 'connect+QUIT bump'); $np3 = Net::POP3->new(@np3_args); + my $n0 = $dbh->selectrow_array('SELECT COUNT(*) FROM deletes'); + my $u0 = $dbh->selectrow_array('SELECT COUNT(*) FROM users'); ok($np3->user($u), "UUID\@$mailbox accept"); ok($np3->pass('anonymous'), 'pass works'); + my $n1 = $dbh->selectrow_array('SELECT COUNT(*) FROM deletes'); + is($n1 - $n0, 1, 'deletes bumped while connected'); + ok($np3->quit, 'client QUIT'); + + $n1 = $dbh->selectrow_array('SELECT COUNT(*) FROM deletes'); + is($n1, $n0, 'deletes row gone on no-op after QUIT'); + my $u1 = $dbh->selectrow_array('SELECT COUNT(*) FROM users'); + is($u1, $u0, 'users row gone on no-op after QUIT'); $np3 = Net::POP3->new(@np3_args); ok($np3->user($u), "UUID\@$mailbox accept"); @@ -163,9 +184,32 @@ for my $args ( ok($_ > 0, 'bytes in LIST result') for values %$list; like($_, qr/\A[a-z0-9]{40,}\z/, 'blob IDs in UIDL result') for values %$uidl; + ok($np3->quit, 'QUIT after LIST+UIDL'); + $n1 = $dbh->selectrow_array('SELECT COUNT(*) FROM deletes'); + is($n1, $n0, 'deletes row gone on no-op after LIST+UIDL'); + $n0 = $n1; + + $np3 = Net::POP3->new(@np3_args); + ok($np3->user($u), "UUID\@$mailbox accept"); + ok($np3->pass('anonymous'), 'pass works'); + undef $np3; # QUIT-less disconnect + ok(Net::POP3->new(@np3_args)->quit, 'connect+QUIT bump'); + + $u1 = $dbh->selectrow_array('SELECT COUNT(*) FROM users'); + is($u1, $u0, 'users row gone on QUIT-less disconnect'); + $n1 = $dbh->selectrow_array('SELECT COUNT(*) FROM deletes'); + is($n1, $n0, 'deletes row gone on QUIT-less disconnect'); + $n0 = $n1; $np3 = Net::POP3->new(@np3_args); ok(!$np3->apop($u, 'anonumuss'), 'APOP wrong pass reject'); + $n1 = $dbh->selectrow_array('SELECT COUNT(*) FROM deletes'); + is($n1, $n0, 'deletes row not bumped w/ wrong pass'); + undef $np3; # QUIT-less disconnect + ok(Net::POP3->new(@np3_args)->quit, 'connect+QUIT bump'); + + $n1 = $dbh->selectrow_array('SELECT COUNT(*) FROM deletes'); + is($n1, $n0, 'deletes row not bumped w/ wrong pass'); $np3 = Net::POP3->new(@np3_args); ok($np3->apop($u, 'anonymous'), "APOP UUID\@$mailbox"); @@ -222,16 +266,14 @@ EOF is(unpack('i', $x), 0, 'TCP_DEFER_ACCEPT is 0 on plain POP3'); }; SKIP: { - skip 'SO_ACCEPTFILTER is FreeBSD-only', 2 if $^O ne 'freebsd'; - system('kldstat -m accf_data >/dev/null') and - skip 'accf_data not loaded? kldload accf_data', 2; + require_mods '+accf_data'; require PublicInbox::Daemon; my $x = getsockopt($pop3s, SOL_SOCKET, $PublicInbox::Daemon::SO_ACCEPTFILTER); like($x, qr/\Adataready\0+\z/, 'got dataready accf for pop3s'); $x = getsockopt($stls, IPPROTO_TCP, $PublicInbox::Daemon::SO_ACCEPTFILTER); - is($x, undef, 'no BSD accept filter for plain IMAP'); + is($x, undef, 'no BSD accept filter for plain POP3'); }; $td->kill; diff --git a/t/pop3d_lock.t b/t/pop3d_lock.t new file mode 100644 index 00000000..fb305f96 --- /dev/null +++ b/t/pop3d_lock.t @@ -0,0 +1,16 @@ +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use v5.12; +use PublicInbox::TestCommon; +require_mods(qw(DBD::SQLite Net::POP3 :fcntl_lock)); +use autodie; +my $tmpdir = tmpdir; +require_ok 'PublicInbox::POP3D'; +my $pop3d = bless {}, 'PublicInbox::POP3D'; +open $pop3d->{txn_fh}, '+>>', "$tmpdir/txn.lock"; +use Fcntl qw(F_SETLK F_UNLCK F_WRLCK); + +ok $pop3d->_setlk(l_type => F_WRLCK, l_start => 9, l_len => 1), + 'locked file (check with ktrace/strace)'; + +done_testing; diff --git a/t/psgi_attach.t b/t/psgi_attach.t index 79665d6f..db551696 100644 --- a/t/psgi_attach.t +++ b/t/psgi_attach.t @@ -1,5 +1,5 @@ #!perl -w -# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; @@ -97,19 +97,12 @@ my $client = sub { test_psgi(sub { $www->call(@_) }, $client); SKIP: { - require_mods(qw(DBD::SQLite Plack::Test::ExternalServer), 18); + require_mods(qw(DBD::SQLite), 18); $ibx = create_inbox 'test-indexed', indexlevel => 'basic', $creat_cb; $cfgpath = "$ibx->{inboxdir}/pi_config"; my $env = { PI_CONFIG => $cfgpath }; $www = PublicInbox::WWW->new(PublicInbox::Config->new($cfgpath)); test_psgi(sub { $www->call(@_) }, $client); - my $sock = tcp_server() or die; - my ($tmpdir, $for_destroy) = tmpdir(); - my ($out, $err) = map { "$tmpdir/std$_.log" } qw(out err); - my $cmd = [ qw(-httpd -W0), "--stdout=$out", "--stderr=$err" ]; - my $td = start_script($cmd, $env, { 3 => $sock }); - my ($h, $p) = tcp_host_port($sock); - local $ENV{PLACK_TEST_EXTERNALSERVER_URI} = "http://$h:$p"; - Plack::Test::ExternalServer::test_psgi(client => $client); + test_httpd($env, $client); } done_testing; diff --git a/t/psgi_bad_mids.t b/t/psgi_bad_mids.t index 8e531b54..ac0eb3c3 100644 --- a/t/psgi_bad_mids.t +++ b/t/psgi_bad_mids.t @@ -1,11 +1,9 @@ #!perl -w -# Copyright (C) 2018-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use v5.10.1; +use v5.12; use PublicInbox::TestCommon; use PublicInbox::Eml; -use PublicInbox::Config; my @mods = qw(DBD::SQLite HTTP::Request::Common Plack::Test URI::Escape Plack::Builder); require_git 2.6; @@ -37,12 +35,12 @@ Date: Fri, 02 Oct 1993 00:00:0$i +0000 } }; -my $cfgpfx = "publicinbox.bad-mids"; -my $cfg = <<EOF; -$cfgpfx.address=$ibx->{-primary_address} -$cfgpfx.inboxdir=$ibx->{inboxdir} -EOF -my $config = PublicInbox::Config->new(\$cfg); +my $tmpdir = tmpdir; +my $config = cfg_new $tmpdir, <<EOM; +[publicinbox "bad-mids"] + address = $ibx->{-primary_address} + inboxdir = $ibx->{inboxdir} +EOM my $www = PublicInbox::WWW->new($config); test_psgi(sub { $www->call(@_) }, sub { my ($cb) = @_; diff --git a/t/psgi_mount.t b/t/psgi_mount.t index 7c5487f3..e43b9f2d 100644 --- a/t/psgi_mount.t +++ b/t/psgi_mount.t @@ -1,14 +1,11 @@ #!perl -w -# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use v5.10.1; +use v5.12; use PublicInbox::Eml; use PublicInbox::TestCommon; -use PublicInbox::Config; my ($tmpdir, $for_destroy) = tmpdir(); my $v1dir = "$tmpdir/v1.git"; -my $cfgpfx = "publicinbox.test"; my @mods = qw(HTTP::Request::Common Plack::Test URI::Escape Plack::Builder Plack::App::URLMap); require_mods(@mods); @@ -27,9 +24,10 @@ Date: Thu, 01 Jan 1970 00:00:00 +0000 zzzzzz EOF }; -my $cfg = PublicInbox::Config->new(\<<EOF); -$cfgpfx.address=$ibx->{-primary_address} -$cfgpfx.inboxdir=$v1dir +my $cfg = cfg_new $tmpdir, <<EOF; +[publicinbox "test"] + address = $ibx->{-primary_address} + inboxdir = $v1dir EOF my $www = PublicInbox::WWW->new($cfg); my $app = builder(sub { @@ -69,7 +67,7 @@ test_psgi($app, sub { }); SKIP: { - require_mods(qw(DBD::SQLite Search::Xapian IO::Uncompress::Gunzip), 3); + require_mods(qw(DBD::SQLite Xapian IO::Uncompress::Gunzip), 3); require_ok 'PublicInbox::SearchIdx'; PublicInbox::SearchIdx->new($ibx, 1)->index_sync; test_psgi($app, sub { diff --git a/t/psgi_multipart_not.t b/t/psgi_multipart_not.t index 5f4c06b7..e7c43abf 100644 --- a/t/psgi_multipart_not.t +++ b/t/psgi_multipart_not.t @@ -1,13 +1,11 @@ #!perl -w -# Copyright (C) 2018-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use v5.10.1; +use v5.12; use PublicInbox::TestCommon; use PublicInbox::Eml; -use PublicInbox::Config; require_git 2.6; -my @mods = qw(DBD::SQLite Search::Xapian HTTP::Request::Common +my @mods = qw(DBD::SQLite Xapian HTTP::Request::Common Plack::Test URI::Escape Plack::Builder Plack::Test); require_mods(@mods); use_ok($_) for (qw(HTTP::Request::Common Plack::Test)); @@ -28,12 +26,12 @@ Freed^Wmultipart ain't what it used to be EOF }; -my $cfgpfx = "publicinbox.v2test"; -my $cfg = <<EOF; -$cfgpfx.address=$ibx->{-primary_address} -$cfgpfx.inboxdir=$ibx->{inboxdir} +my $tmpdir = tmpdir; +my $www = PublicInbox::WWW->new(cfg_new($tmpdir, <<EOF)); +[publicinbox "v2test"] + address = $ibx->{-primary_address} + inboxdir = $ibx->{inboxdir} EOF -my $www = PublicInbox::WWW->new(PublicInbox::Config->new(\$cfg)); my ($res, $raw); test_psgi(sub { $www->call(@_) }, sub { my ($cb) = @_; diff --git a/t/psgi_scan_all.t b/t/psgi_scan_all.t index 09e8eaf9..4c28b553 100644 --- a/t/psgi_scan_all.t +++ b/t/psgi_scan_all.t @@ -1,17 +1,15 @@ #!perl -w -# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use v5.10.1; +use v5.12; use PublicInbox::TestCommon; use PublicInbox::Eml; -use PublicInbox::Config; -my @mods = qw(HTTP::Request::Common Plack::Test URI::Escape DBD::SQLite); -require_git 2.6; -require_mods(@mods); -use_ok 'PublicInbox::WWW'; -foreach my $mod (@mods) { use_ok $mod; } -my $cfg = ''; +my @use = qw(HTTP::Request::Common Plack::Test); +my @req = qw(URI::Escape DBD::SQLite); +require_git v2.6; +require_mods(@use, @req, qw(PublicInbox::WWW)); +$_->import for @use; +my $cfgtxt = ''; foreach my $i (1..2) { my $ibx = create_inbox "test-$i", version => 2, indexlevel => 'basic', sub { @@ -26,13 +24,15 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000 hello world EOF }; - my $cfgpfx = "publicinbox.test-$i"; - $cfg .= "$cfgpfx.address=$ibx->{-primary_address}\n"; - $cfg .= "$cfgpfx.inboxdir=$ibx->{inboxdir}\n"; - $cfg .= "$cfgpfx.url=http://example.com/$i\n"; - + $cfgtxt .= <<EOM; +[publicinbox "test-$i"] + address = $ibx->{-primary_address} + inboxdir = $ibx->{inboxdir} + url = http://example.com/$i +EOM } -my $www = PublicInbox::WWW->new(PublicInbox::Config->new(\$cfg)); +my $tmpdir = tmpdir; +my $www = PublicInbox::WWW->new(cfg_new($tmpdir, $cfgtxt)); test_psgi(sub { $www->call(@_) }, sub { my ($cb) = @_; diff --git a/t/psgi_search.t b/t/psgi_search.t index 3da93eda..8c981c6c 100644 --- a/t/psgi_search.t +++ b/t/psgi_search.t @@ -1,14 +1,12 @@ #!perl -w -# Copyright (C) 2017-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use v5.10.1; +use v5.12; use PublicInbox::TestCommon; use IO::Uncompress::Gunzip qw(gunzip); use PublicInbox::Eml; -use PublicInbox::Config; use PublicInbox::Inbox; -my @mods = qw(DBD::SQLite Search::Xapian HTTP::Request::Common Plack::Test +my @mods = qw(DBD::SQLite Xapian HTTP::Request::Common Plack::Test URI::Escape Plack::Builder); require_mods(@mods); use_ok($_) for (qw(HTTP::Request::Common Plack::Test)); @@ -20,7 +18,8 @@ local $ENV{TZ} = 'UTC'; my $digits = '10010260936330'; my $ua = 'Pine.LNX.4.10'; my $mid = "$ua.$digits.2460-100000\@penguin.transmeta.com"; -my $ibx = create_inbox 'git', indexlevel => 'full', tmpdir => "$tmpdir/1", sub { +my $ibx = create_inbox '26-git', indexlevel => 'full', tmpdir => "$tmpdir/1", +sub { my ($im) = @_; # n.b. these headers are not properly RFC2047-encoded $im->add(PublicInbox::Eml->new(<<EOF)) or BAIL_OUT; @@ -51,12 +50,23 @@ From: no subject at all <no-subject-at-all@example.com> To: git@vger.kernel.org EOF + $im->add(PublicInbox::Eml->new(<<'EOF')) or BAIL_OUT; +Message-ID: <ampersand@example.com> +From: <e@example.com> +To: git@vger.kernel.org +Subject: git & ampersand + +hi +++ b/foo +x=y +s'more + +EOF }; -my $cfgpfx = "publicinbox.test"; -my $cfg = PublicInbox::Config->new(\<<EOF); -$cfgpfx.address=git\@vger.kernel.org -$cfgpfx.inboxdir=$ibx->{inboxdir} +my $cfg = cfg_new $tmpdir, <<EOF; +[publicinbox "test"] + address = git\@vger.kernel.org + inboxdir = $ibx->{inboxdir} EOF my $www = PublicInbox::WWW->new($cfg); test_psgi(sub { $www->call(@_) }, sub { @@ -93,6 +103,7 @@ test_psgi(sub { $www->call(@_) }, sub { $res = $cb->(POST('/test/?q=s:bogus&x=m')); is($res->code, 404, 'failed search result gives 404'); + like($res->content, qr/No results found/, "`No results' shown"); is_deeply([], $warn, 'no warnings'); my $mid_re = qr/\Q$mid\E/o; @@ -103,6 +114,11 @@ test_psgi(sub { $www->call(@_) }, sub { like($res->content, $mid_re, 'found mid in response'); chop($digits); } + $res = $cb->(GET("/test/$mid/")); + $html = $res->content; + like($html, qr/\bFrom: Ævar /, + "displayed Ævar's name properly in permalink From:"); + unlike($html, qr/Ã/, 'no raw octets in permalink HTML'); $res = $cb->(GET('/test/')); $html = $res->content; @@ -151,6 +167,19 @@ test_psgi(sub { $www->call(@_) }, sub { is($res->code, 200, 'successful mbox download w/ threads'); gunzip(\($res->content) => \(my $after)); isnt($before, $after); + + $res = $cb->(GET('/test/?q=git+%26+ampersand&x=A')); + is $res->code, 200, 'Atom hit with ampersand'; + unlike $res->content, qr/git\+&\+ampersand/, '& is HTML-escaped'; + + $res = $cb->(GET('/test/?q=%22hi+%2b%2b%2b+b/foo%22&x=A')); + is $res->code, 200, 'slashes and plusses search hit'; + like $res->content, qr!q=%22hi\+(?:%2[bB]){3}\+b/foo%22!, + '+ and " escaped, but slash not escaped in query'; + + $res = $cb->(GET(q{/test/?q=%22s'more%22&x=A})); + is $res->code, 200, 'single quote inside phrase'; + # TODO: more tests and odd cases }); done_testing(); diff --git a/t/psgi_text.t b/t/psgi_text.t index e4613945..25599dd9 100644 --- a/t/psgi_text.t +++ b/t/psgi_text.t @@ -1,8 +1,6 @@ -# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use warnings; -use Test::More; +use v5.12; use PublicInbox::Eml; use PublicInbox::TestCommon; my ($tmpdir, $for_destroy) = tmpdir(); @@ -13,13 +11,12 @@ my @mods = qw(HTTP::Request::Common Plack::Test URI::Escape Plack::Builder); require_mods(@mods, 'IO::Uncompress::Gunzip'); use_ok $_ foreach @mods; use PublicInbox::Import; -use PublicInbox::Git; -use PublicInbox::Config; use_ok 'PublicInbox::WWW'; use_ok 'PublicInbox::WwwText'; -my $config = PublicInbox::Config->new(\<<EOF); -$cfgpfx.address=$addr -$cfgpfx.inboxdir=$maindir +my $config = cfg_new $tmpdir, <<EOF; +[publicinbox "test"] + address = $addr + inboxdir = $maindir EOF PublicInbox::Import::init_bare($maindir); my $www = PublicInbox::WWW->new($config); @@ -43,11 +40,7 @@ test_psgi(sub { $www->call(@_) }, sub { $res = $cb->($req); $content = $res->content; my $olen = $res->header('Content-Length'); - my $f = "$tmpdir/cfg"; - open my $fh, '>', $f or die; - print $fh $content or die; - close $fh or die; - my $cfg = PublicInbox::Config->new($f); + my $cfg = cfg_new $tmpdir, $content; is($cfg->{"$cfgpfx.address"}, $addr, 'got expected address in config'); $req->header('Accept-Encoding' => 'gzip'); diff --git a/t/psgi_v2.t b/t/psgi_v2.t index 7d73b606..2b678fd8 100644 --- a/t/psgi_v2.t +++ b/t/psgi_v2.t @@ -1,18 +1,50 @@ #!perl -w -# Copyright (C) 2018-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use PublicInbox::TestCommon; +use IO::Uncompress::Gunzip qw(gunzip); require_git(2.6); use PublicInbox::Eml; use PublicInbox::Config; use PublicInbox::MID qw(mids); -require_mods(qw(DBD::SQLite Search::Xapian HTTP::Request::Common Plack::Test +use autodie qw(kill rename); +require_mods(qw(DBD::SQLite Xapian HTTP::Request::Common Plack::Test URI::Escape Plack::Builder HTTP::Date)); use_ok($_) for (qw(HTTP::Request::Common Plack::Test)); use_ok 'PublicInbox::WWW'; my ($tmpdir, $for_destroy) = tmpdir(); +my $enc_dup = 'ref-20150309094050.GO3427@x1.example'; + +my $dibx = create_inbox 'v2-dup', version => 2, indexlevel => 'medium', + tmpdir => "$tmpdir/dup", sub { + my ($im, $ibx) = @_; + my $common = <<""; +Date: Mon, 9 Mar 2015 09:40:50 +0000 +From: x\@example.com +To: y\@example.com +Subject: re +Message-ID: <$enc_dup> +MIME-Version: 1.0 + + $im->add(PublicInbox::Eml->new($common.<<EOM)) or BAIL_OUT; +Content-Type: text/plain; charset=utf-8 +Content-Disposition: inline +Content-Transfer-Encoding: 8bit + +cr_mismatch +pipe \x{e2}\x{94}\x{82} or not +EOM + $im->add(PublicInbox::Eml->new($common.<<EOM)) or BAIL_OUT; +Content-Type: text/plain; charset="windows-1252" +Content-Transfer-Encoding: quoted-printable + +cr_mismatch\r +pipe =E2=94=82 or not +EOM +}; + my $eml = PublicInbox::Eml->new(<<'EOF'); From oldbug-pre-a0c07cba0e5d8b6a Fri Oct 2 00:00:00 1993 From: a@example.com @@ -46,6 +78,43 @@ $new_mid //= do { local $/; <$fh>; }; + +my $m2t = create_inbox 'mid2tid-1', version => 2, indexlevel => 'medium', sub { + my ($im, $ibx) = @_; + for my $n (1..3) { + $im->add(PublicInbox::Eml->new(<<EOM)) or xbail 'add'; +Date: Fri, 02 Oct 1993 00:0$n:00 +0000 +Message-ID: <t\@$n> +Subject: tid $n +From: x\@example.com +References: <a-mid\@b> + +$n +EOM + $im->add(PublicInbox::Eml->new(<<EOM)) or xbail 'add'; +Date: Fri, 02 Oct 1993 00:0$n:00 +0000 +Message-ID: <ut\@$n> +Subject: unrelated tid $n +From: x\@example.com +References: <b-mid\@b> + +EOM + } +}; + +my $test_lei_q_threadid = sub { + my ($u) = @_; + test_lei(sub { + lei_ok qw(q -f text --only), $u, qw(-T t@1 s:unrelated); + is $lei_out, '', 'no results on unrelated thread'; + lei_ok qw(q -f text --only), $u, qw(-T t@1 dt:19931002000300..); + my @m = ($lei_out =~ m!^Message-ID: <([^>]+)>\n!gms); + is_deeply \@m, ['t@3'], 'got expected result from -T MSGID'; + }); +}; + +$test_lei_q_threadid->($m2t->{inboxdir}); + my $cfgpath = "$ibx->{inboxdir}/pi_config"; { open my $fh, '>', $cfgpath or BAIL_OUT $!; @@ -53,6 +122,12 @@ my $cfgpath = "$ibx->{inboxdir}/pi_config"; [publicinbox "v2test"] inboxdir = $ibx->{inboxdir} address = $ibx->{-primary_address} +[publicinbox "dup"] + inboxdir = $dibx->{inboxdir} + address = $dibx->{-primary_address} +[publicinbox "m2t"] + inboxdir = $m2t->{inboxdir} + address = $m2t->{-primary_address} EOF close $fh or BAIL_OUT; } @@ -145,20 +220,18 @@ my $client1 = sub { $cfg->each_inbox(sub { $_[0]->search->reopen }); SKIP: { - eval { require IO::Uncompress::Gunzip }; - skip 'IO::Uncompress::Gunzip missing', 6 if $@; my ($in, $out, $status); my $req = GET('/v2test/a-mid@b/raw'); $req->header('Accept-Encoding' => 'gzip'); $res = $cb->($req); is($res->header('Content-Encoding'), 'gzip', 'gzip encoding'); $in = $res->content; - IO::Uncompress::Gunzip::gunzip(\$in => \$out); + gunzip(\$in => \$out); is($out, $raw, 'gzip response matches'); $res = $cb->(GET('/v2test/a-mid@b/t.mbox.gz')); $in = $res->content; - $status = IO::Uncompress::Gunzip::gunzip(\$in => \$out); + $status = gunzip(\$in => \$out); unlike($out, qr/^From oldbug/sm, 'buggy "From_" line omitted'); like($out, qr/^hello world$/m, 'got first in t.mbox.gz'); like($out, qr/^hello world!$/m, 'got second in t.mbox.gz'); @@ -169,7 +242,7 @@ my $client1 = sub { # search interface $res = $cb->(POST('/v2test/?q=m:a-mid@b&x=m')); $in = $res->content; - $status = IO::Uncompress::Gunzip::gunzip(\$in => \$out); + $status = gunzip(\$in => \$out); unlike($out, qr/^From oldbug/sm, 'buggy "From_" line omitted'); like($out, qr/^hello world$/m, 'got first in mbox POST'); like($out, qr/^hello world!$/m, 'got second in mbox POST'); @@ -180,7 +253,7 @@ my $client1 = sub { # all.mbox.gz interface $res = $cb->(GET('/v2test/all.mbox.gz')); $in = $res->content; - $status = IO::Uncompress::Gunzip::gunzip(\$in => \$out); + $status = gunzip(\$in => \$out); unlike($out, qr/^From oldbug/sm, 'buggy "From_" line omitted'); like($out, qr/^hello world$/m, 'got first in all.mbox'); like($out, qr/^hello world!$/m, 'got second in all.mbox'); @@ -209,6 +282,8 @@ my $client1 = sub { local $SIG{__WARN__} = 'DEFAULT'; $res = $cb->(GET('/v2test/a-mid@b/')); $raw = $res->content; + like($raw, qr/WARNING: multiple messages have this Message-ID/, + 'warned about duplicate Message-IDs'); like($raw, qr/^hello world$/m, 'got first message'); like($raw, qr/^hello world!$/m, 'got second message'); like($raw, qr/^hello ghosts$/m, 'got third message'); @@ -218,6 +293,15 @@ my $client1 = sub { like($raw, qr!>\Q$mid\E</a>!s, "Message-ID $mid shown"); } like($raw, qr/\b3\+ messages\b/, 'thread overview shown'); + + $res = $cb->(GET("/dup/$enc_dup/d/")); + is($res->code, 200, '/d/ (diff) endpoint works'); + $raw = $res->content; + like($raw, qr!</span> cr_mismatch\n!s, + 'cr_mismatch is only diff context'); + like($raw, qr!>\-pipe !s, 'pipe diff del line'); + like($raw, qr!>\+pipe !s, 'pipe diff ins line'); + unlike $raw, qr/No newline at end of file/; }; test_psgi(sub { $www->call(@_) }, $client1); @@ -292,8 +376,76 @@ my $client3 = sub { local $SIG{__WARN__} = sub { push @warn, @_ }; $res = $cb->(GET('/v2test/?t=1970'.'01'.'01')); is_deeply(\@warn, [], 'no warnings on YYYYMMDD only'); + + $res = $cb->(POST("/m2t/t\@1/?q=dt:19931002000300..&x=m")); + is($res->code, 200, 'got 200 on mid2tid query'); + gunzip(\(my $in = $res->content) => \(my $out)); + my @m = ($out =~ m!^Message-ID: <([^>]+)>\n!gms); + is_deeply(\@m, ['t@3'], 'only got latest result from query'); + + $res = $cb->(POST("/m2t/t\@1/?q=dt:19931002000400..&x=m")); + is($res->code, 404, '404 on out-of-range mid2tid query'); + + $res = $cb->(POST("/m2t/t\@1/?q=s:unrelated&x=m")); + is($res->code, 404, '404 on cross-thread search'); + + my $rmt = $ENV{PLACK_TEST_EXTERNALSERVER_URI}; + $rmt and $test_lei_q_threadid->("$rmt/m2t/"); }; test_psgi(sub { $www->call(@_) }, $client3); test_httpd($env, $client3, 4); +if ($^O eq 'linux' && -r "/proc/$$/stat") { + my $args; + my $search_xh_pid = sub { + my ($pid) = @_; + for my $f (glob('/proc/*/stat')) { + open my $fh, '<', $f or next; + my @s = split /\s+/, readline($fh) // next; + next if $s[3] ne $pid; # look for matching PPID + open $fh, '<', "/proc/$s[0]/cmdline" or next; + my $cmdline = readline($fh) // next; + if ($cmdline =~ /\0-MPublicInbox::XapHelper\0-e\0/ || + $cmdline =~ m!/xap_helper\0!) { + return $s[0]; + } + } + undef; + }; + my $usr1_test = sub { + my ($cb) = @_; + my $td = $PublicInbox::TestCommon::CURRENT_DAEMON; + my $pid = $td->{pid}; + my $res = $cb->(GET('/v2test/?q=m:a-mid@b')); + is $res->code, 200, '-httpd is running w/ search'; + + $search_xh_pid->($pid); + my $xh_pid = $search_xh_pid->($pid) or + BAIL_OUT "can't find XH pid with $args"; + my $xh_err = readlink "/proc/$xh_pid/fd/2"; + is $xh_err, "$env->{TMPDIR}/stderr.log", + "initial stderr expected ($args)"; + rename "$env->{TMPDIR}/stderr.log", + "$env->{TMPDIR}/stderr.old"; + $xh_err = readlink "/proc/$xh_pid/fd/2"; + is $xh_err, "$env->{TMPDIR}/stderr.old", + "stderr followed rename ($args)"; + kill 'USR1', $pid; + tick; + $res = $cb->(GET('/v2test/?q=m:a-mid@b')); + is $res->code, 200, '-httpd still running w/ search'; + my $new_xh_pid = $search_xh_pid->($pid) or + BAIL_OUT "can't find new XH pid with $args"; + is $new_xh_pid, $xh_pid, "XH pid unchanged ($args)"; + $xh_err = readlink "/proc/$new_xh_pid/fd/2"; + is $xh_err, "$env->{TMPDIR}/stderr.log", + "stderr updated ($args)"; + }; + for my $x ('-X0', '-X1', '-X0 -W1', '-X1 -W1') { + $args = $x; + local $ENV{TEST_DAEMON_XH} = $args; + test_httpd($env, $usr1_test); + } +} + done_testing; @@ -1,8 +1,9 @@ -# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; +use v5.12; use Test::More; use_ok 'PublicInbox::Qspawn'; +use_ok 'PublicInbox::Limiter'; { my $cmd = [qw(sh -c), 'echo >&2 err; echo out']; @@ -20,12 +21,13 @@ use_ok 'PublicInbox::Qspawn'; sub finish_err ($) { my ($qsp) = @_; $qsp->finish; - $qsp->{err}; + $qsp->{qsp_err} && ${$qsp->{qsp_err}}; } -my $limiter = PublicInbox::Qspawn::Limiter->new(1); +my $limiter = PublicInbox::Limiter->new(1); { my $x = PublicInbox::Qspawn->new([qw(true)]); + $x->{qsp_err} = \(my $err = ''); my $run = 0; $x->start($limiter, sub { my ($self) = @_; @@ -37,7 +39,9 @@ my $limiter = PublicInbox::Qspawn::Limiter->new(1); } { + my @err; local $SIG{__WARN__} = sub { push @err, @_ }; my $x = PublicInbox::Qspawn->new([qw(false)]); + $x->{qsp_err} = \(my $err = ''); my $run = 0; $x->start($limiter, sub { my ($self) = @_; @@ -47,10 +51,13 @@ my $limiter = PublicInbox::Qspawn::Limiter->new(1); $run = 1; }); is($run, 1, 'callback ran alright'); + ok(scalar @err, 'got warning'); } foreach my $cmd ([qw(sleep 1)], [qw(sh -c), 'sleep 1; false']) { + my @err; local $SIG{__WARN__} = sub { push @err, @_ }; my $s = PublicInbox::Qspawn->new($cmd); + $s->{qsp_err} = \(my $err = ''); my @run; $s->start($limiter, sub { my ($self) = @_; @@ -70,8 +77,10 @@ foreach my $cmd ([qw(sleep 1)], [qw(sh -c), 'sleep 1; false']) { if ($cmd->[-1] =~ /false\z/) { ok(finish_err($s), 'got error on false after sleep'); + ok(scalar @err, 'got warning'); } else { ok(!finish_err($s), 'no error on sleep'); + is_deeply([], \@err, 'no warnings'); } ok(!finish_err($_->[0]), "true $_->[1] succeeded") foreach @t; is_deeply([qw(sleep 0 1 2)], \@run, 'ran in order'); diff --git a/t/replace.t b/t/replace.t index 626cbe9b..a61c3ca0 100644 --- a/t/replace.t +++ b/t/replace.t @@ -49,7 +49,7 @@ EOF $im->done; my $thread_a = $ibx->over->get_thread('replace@example.com'); - my %before = map {; delete($_->{blob}) => $_ } @{$ibx->recent}; + my %before = map {; delete($_->{blob}) => $_ } @{$ibx->over->recent}; my $reject = PublicInbox::Eml->new($orig->as_string); foreach my $mid (['<replace@example.com>', '<extra@example.com>'], [], ['<replaced@example.com>']) { @@ -126,7 +126,7 @@ EOF } # check overview matches: - my %after = map {; delete($_->{blob}) => $_ } @{$ibx->recent}; + my %after = map {; delete($_->{blob}) => $_ } @{$ibx->over->recent}; my @before_blobs = keys %before; foreach my $blob (@before_blobs) { delete $before{$blob} if delete $after{$blob}; @@ -187,7 +187,7 @@ test_replace(2, 'basic', $opt = { %$opt, post => \&pad_msgs }); test_replace(2, 'basic', $opt = { %$opt, rotate_bytes => 1 }); SKIP: { - require_mods(qw(Search::Xapian), 8); + require_mods(qw(Xapian), 8); for my $l (qw(medium)) { test_replace(2, $l, {}); $opt = { pre => \&pad_msgs }; diff --git a/t/run.perl b/t/run.perl deleted file mode 100755 index cf80a8a1..00000000 --- a/t/run.perl +++ /dev/null @@ -1,265 +0,0 @@ -#!/usr/bin/perl -w -# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org> -# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -# -# Parallel test runner which preloads code and reuses worker processes -# to give a nice speedup over prove(1). It also generates per-test -# .log files (similar to automake tests). -# -# *.t files run by this should not rely on global state. -# -# Usage: $PERL -I lib -w t/run.perl -j4 -# Or via prove(1): prove -lvw t/run.perl :: -j4 -use strict; -use v5.10.1; -use IO::Handle; # ->autoflush -use PublicInbox::TestCommon; -use PublicInbox::Spawn; -use Getopt::Long qw(:config gnu_getopt no_ignore_case auto_abbrev); -use Errno qw(EINTR); -use Fcntl qw(:seek); -use POSIX qw(WNOHANG); -use File::Temp (); -my $jobs = 1; -my $repeat = 1; -$| = 1; -our $log_suffix = '.log'; -my ($shuffle, %pids, @err); -GetOptions('j|jobs=i' => \$jobs, - 'repeat=i' => \$repeat, - 'log=s' => \$log_suffix, - 's|shuffle' => \$shuffle, -) or die "Usage: $0 [-j JOBS] [--log=SUFFIX] [--repeat RUNS]"; -if (($ENV{TEST_RUN_MODE} // 2) == 0) { - die "$0 is not compatible with TEST_RUN_MODE=0\n"; -} -my @tests = scalar(@ARGV) ? @ARGV : glob('t/*.t'); -open my $cwd_fh, '<', '.' or die "open .: $!"; -open my $OLDOUT, '>&STDOUT' or die "dup STDOUT: $!"; -open my $OLDERR, '>&STDERR' or die "dup STDERR: $!"; -$OLDOUT->autoflush(1); -$OLDERR->autoflush(1); - -my ($run_log, $tmp_rl); -my $rl = $ENV{TEST_RUN_LOG}; -unless ($rl) { - $tmp_rl = File::Temp->new(CLEANUP => 1); - $rl = $tmp_rl->filename; -} -open $run_log, '+>>', $rl or die "open $rl: $!"; -$run_log->autoflush(1); # one reader, many writers - -key2sub($_) for @tests; # precache - -my ($for_destroy, $lei_env, $lei_daemon_pid, $owner_pid); - -# TEST_LEI_DAEMON_PERSIST is currently broken. I get ECONNRESET from -# lei even with high kern.ipc.soacceptqueue=1073741823 or SOMAXCONN, not -# sure why. Also, testing our internal inotify usage is unreliable -# because lei-daemon uses a single inotify FD for all clients. -if ($ENV{TEST_LEI_DAEMON_PERSIST} && !$ENV{TEST_LEI_DAEMON_PERSIST_DIR} && - (PublicInbox::Spawn->can('recv_cmd4') || - eval { require Socket::MsgHdr })) { - $lei_env = {}; - ($lei_env->{XDG_RUNTIME_DIR}, $for_destroy) = tmpdir; - $ENV{TEST_LEI_DAEMON_PERSIST_DIR} = $lei_env->{XDG_RUNTIME_DIR}; - run_script([qw(lei daemon-pid)], $lei_env, { 1 => \$lei_daemon_pid }); - chomp $lei_daemon_pid; - $lei_daemon_pid =~ /\A[0-9]+\z/ or die "no daemon pid: $lei_daemon_pid"; - kill(0, $lei_daemon_pid) or die "kill $lei_daemon_pid: $!"; - if (my $t = $ENV{GNU_TAIL}) { - system("$t --pid=$lei_daemon_pid -F " . - "$lei_env->{XDG_RUNTIME_DIR}/lei/errors.log >&2 &"); - } - if (my $strace_cmd = $ENV{STRACE_CMD}) { - system("$strace_cmd -p $lei_daemon_pid &"); - } - $owner_pid = $$; -} - -if ($shuffle) { - require List::Util; -} elsif (open(my $prove_state, '<', '.prove') && eval { require YAML::XS }) { - # reuse "prove --state=save" data to start slowest tests, first - my $state = YAML::XS::Load(do { local $/; <$prove_state> }); - my $t = $state->{tests}; - @tests = sort { - ($t->{$b}->{elapsed} // 0) <=> ($t->{$a}->{elapsed} // 0) - } @tests; -} - -our $tb = Test::More->builder; - -sub DIE (;$) { - print $OLDERR @_; - exit(1); -} - -our ($worker, $worker_test); - -sub test_status () { - $? = 255 if $? == 0 && !$tb->is_passing; - my $status = $? ? 'not ok' : 'ok'; - chdir($cwd_fh) or DIE "fchdir: $!"; - if ($log_suffix ne '') { - my $log = $worker_test; - $log =~ s/\.t\z/$log_suffix/; - my $skip = ''; - if (open my $fh, '<', $log) { - my @not_ok = grep(!/^(?:ok |[ \t]*#)/ms, <$fh>); - my $last = $not_ok[-1] // ''; - pop @not_ok if $last =~ /^[0-9]+\.\.[0-9]+$/; - my $pfx = "# $log: "; - print $OLDERR map { $pfx.$_ } @not_ok; - seek($fh, 0, SEEK_SET) or die "seek: $!"; - - # show unique skip texts and the number of times - # each text was skipped - local $/; - my @sk = (<$fh> =~ m/^ok [0-9]+ (# skip [^\n]+)/mgs); - if (@sk) { - my %nr; - my @err = grep { !$nr{$_}++ } @sk; - print $OLDERR "$pfx$_ ($nr{$_})\n" for @err; - $skip = ' # total skipped: '.scalar(@sk); - } - } else { - print $OLDERR "could not open: $log: $!\n"; - } - print $OLDOUT "$status $worker_test$skip\n"; - } -} - -# Test::Builder or Test2::Hub may call exit() from plan(skip_all => ...) -END { test_status() if (defined($worker_test) && $worker == $$) } - -sub run_test ($) { - my ($test) = @_; - syswrite($run_log, "$$ $test\n"); - my $log_fh; - if ($log_suffix ne '') { - my $log = $test; - $log =~ s/\.[^\.]+\z/$log_suffix/ or DIE "can't log for $test"; - open $log_fh, '>', $log or DIE "open $log: $!"; - $log_fh->autoflush(1); - $tb->output($log_fh); - $tb->failure_output($log_fh); - $tb->todo_output($log_fh); - open STDOUT, '>&', $log_fh or DIE "1>$log: $!"; - open STDERR, '>&', $log_fh or DIE "2>$log: $!"; - } - $worker_test = $test; - run_script([$test]); - test_status(); - $worker_test = undef; - push @err, "$test ($?)" if $?; -} - -sub UINT_SIZE () { 4 } - -# worker processes will SIGUSR1 the producer process when it -# sees EOF on the pipe. On FreeBSD 11.2 and Perl 5.30.0, -# sys/ioctl.ph gives the wrong value for FIONREAD(). -my $producer = $$; -my $eof; # we stop respawning if true - -my $start_worker = sub { - my ($j, $rd, $wr, $todo) = @_; - my $pid = fork // DIE "fork: $!"; - if ($pid == 0) { - close $wr if $wr; - $SIG{USR1} = undef; # undo parent $SIG{USR1} - $worker = $$; - while (1) { - my $r = sysread($rd, my $buf, UINT_SIZE); - if (!defined($r)) { - next if $! == EINTR; - DIE "sysread: $!"; - } - last if $r == 0; - DIE "short read $r" if $r != UINT_SIZE; - my $t = unpack('I', $buf); - run_test($todo->[$t]); - $tb->reset; - } - kill 'USR1', $producer if !$eof; # sets $eof in $producer - if (@err) { # write to run_log for $sigchld handler - syswrite($run_log, "$$ @err\n"); - DIE join('', map { "E: $_\n" } @err); - } - exit(0); - } else { - $pids{$pid} = $j; - } -}; - -# negative $repeat means loop forever: -for (my $i = $repeat; $i != 0; $i--) { - my @todo = $shuffle ? List::Util::shuffle(@tests) : @tests; - - # single-producer, multi-consumer queue relying on POSIX pipe semantics - # POSIX.1-2008 stipulates a regular file should work, but Linux <3.14 - # had broken read(2) semantics according to the read(2) manpage - pipe(my ($rd, $wr)) or DIE "pipe: $!"; - - # fill the queue before forking so children can start earlier - my $n = (POSIX::PIPE_BUF / UINT_SIZE); - if ($n >= $#todo) { - print $wr join('', map { pack('I', $_) } (0..$#todo)) or DIE; - undef $wr; - } else { # write what we can... - $wr->autoflush(1); - print $wr join('', map { pack('I', $_) } (0..$n)) or DIE; - $n += 1; # and send more ($n..$#todo), later - } - $eof = undef; - local $SIG{USR1} = sub { $eof = 1 }; - my $sigchld = sub { - my ($sig) = @_; - my $flags = $sig ? WNOHANG : 0; - while (1) { - my $pid = waitpid(-1, $flags) or return; - return if $pid < 0; - my $j = delete $pids{$pid}; - if (!defined($j)) { - push @err, "reaped unknown $pid ($?)"; - next; - } - if ($?) { - seek($run_log, 0, SEEK_SET); - chomp(my @t = grep(/^$pid /, <$run_log>)); - $t[0] //= "$pid unknown"; - push @err, "job[$j] ($?) PID=$t[-1]"; - } - # skip_all can exit(0), respawn if needed: - if (!$eof) { - print $OLDERR "# respawning job[$j]\n"; - $start_worker->($j, $rd, $wr, \@todo); - } - } - }; - - # start the workers to consume the queue - for (my $j = 0; $j < $jobs; $j++) { - $start_worker->($j, $rd, $wr, \@todo); - } - if ($wr) { - local $SIG{CHLD} = $sigchld; - # too many tests to fit in the pipe before starting workers, - # send the rest now the workers are running - print $wr join('', map { pack('I', $_) } ($n..$#todo)) or DIE; - undef $wr; - } - - $sigchld->(0) while scalar(keys(%pids)); - DIE join('', map { "E: $_\n" } @err) if @err; -} - -print $OLDOUT "1..".($repeat * scalar(@tests))."\n" if $repeat >= 0; -if ($lei_env && $$ == $owner_pid) { - my $opt = { 1 => $OLDOUT, 2 => $OLDERR }; - my $cur_daemon_pid; - run_script([qw(lei daemon-pid)], $lei_env, { 1 => \$cur_daemon_pid }); - run_script([qw(lei daemon-kill)], $lei_env, $opt); - DIE "lei daemon restarted\n" if $cur_daemon_pid != $lei_daemon_pid; -} diff --git a/t/search-thr-index.t b/t/search-thr-index.t index 62745dbc..aecd064f 100644 --- a/t/search-thr-index.t +++ b/t/search-thr-index.t @@ -7,7 +7,7 @@ use Test::More; use PublicInbox::TestCommon; use PublicInbox::MID qw(mids); use PublicInbox::Eml; -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(DBD::SQLite Xapian)); require PublicInbox::SearchIdx; require PublicInbox::Smsg; require PublicInbox::Inbox; @@ -1,10 +1,10 @@ -# Copyright (C) 2015-2021 all contributors <meta@public-inbox.org> +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; -use warnings; -use Test::More; +use v5.10; use PublicInbox::TestCommon; -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(DBD::SQLite Xapian)); require PublicInbox::SearchIdx; require PublicInbox::Inbox; require PublicInbox::InboxWritable; @@ -34,15 +34,11 @@ my $rw_commit = sub { $ibx->search->reopen; }; -sub oct_is ($$$) { - my ($got, $exp, $msg) = @_; - is(sprintf('0%03o', $got), sprintf('0%03o', $exp), $msg); -} - { # git repository perms + use_ok 'PublicInbox::Umask'; oct_is($ibx->_git_config_perm(), - &PublicInbox::InboxWritable::PERM_GROUP, + PublicInbox::Umask::PERM_GROUP(), 'undefined permission is group'); my @t = ( [ '0644', 0022, '644 => umask(0022)' ], @@ -54,8 +50,8 @@ sub oct_is ($$$) { ); for (@t) { my ($perm, $exp, $msg) = @$_; - my $got = PublicInbox::InboxWritable::_umask_for( - PublicInbox::InboxWritable->_git_config_perm($perm)); + my $got = PublicInbox::Umask::_umask_for( + PublicInbox::Umask->_git_config_perm($perm)); oct_is($got, $exp, $msg); } } @@ -436,9 +432,10 @@ $ibx->with_umask(sub { my $all_mask = 07777; my $dir_mask = 02770; -# FreeBSD and apparently OpenBSD does not allow non-root users to set S_ISGID, +# FreeBSD, OpenBSD and NetBSD do not allow non-root users to set S_ISGID, # so git doesn't set it, either (see DIR_HAS_BSD_GROUP_SEMANTICS in git.git) -if ($^O =~ /(?:free|open)bsd/i) { +# Presumably all *BSDs behave the same way. +if (require_bsd) { $all_mask = 0777; $dir_mask = 0770; } @@ -534,7 +531,15 @@ $ibx->with_umask(sub { '20200418222508.GA13918@dcvr', 'Subject search reaches inside message/rfc822'); - $doc_id = $rw->add_message(eml_load('t/data/binary.patch')); + my $eml = eml_load('t/data/binary.patch'); + my $body = $eml->body; + $rw->add_message($eml); + + $body =~ s/^/> /gsm; + $eml = PublicInbox::Eml->new($eml->header_obj->as_string."\n".$body); + $eml->header_set('Message-ID', '<binary-patch-reply@example>'); + $rw->add_message($eml); + $rw->commit_txn_lazy; $ibx->search->reopen; my $res = $query->('HcmV'); @@ -542,8 +547,9 @@ $ibx->with_umask(sub { $res = $query->('IcmZPo000310RR91'); is_deeply($res, [], 'no results against 1-byte binary patch'); $res = $query->('"GIT binary patch"'); - is(scalar(@$res), 1, 'got binary result from "GIT binary patch"'); + is(scalar(@$res), 2, 'got binary results from "GIT binary patch"'); is($res->[0]->{mid}, 'binary-patch-test@example', 'msgid for binary'); + is($res->[1]->{mid}, 'binary-patch-reply@example', 'msgid for reply'); my $s = $query->('"literal 1"'); is_deeply($s, $res, 'got binary result from exact literal size'); $s = $query->('"literal 2"'); @@ -565,10 +571,13 @@ SKIP: { skip 'too close to midnight, time is tricky', 6; } $q = $s->query_argv_to_string($g, [qw(d:20101002 blah)]); - is($q, 'd:20101002..20101003 blah', 'YYYYMMDD expanded to range'); + is($q, 'dt:20101002000000..20101003000000 blah', + 'YYYYMMDD expanded to range'); $q = $s->query_argv_to_string($g, [qw(d:2010-10-02)]); - is($q, 'd:20101002..20101003', 'YYYY-MM-DD expanded to range'); + is($q, 'dt:20101002000000..20101003000000', + 'YYYY-MM-DD expanded to range'); $q = $s->query_argv_to_string($g, [qw(rt:2010-10-02.. yy)]); + diag "q=$q"; $q =~ /\Art:(\d+)\.\. yy/ or fail("rt: expansion failed: $q"); is(strftime('%Y-%m-%d', gmtime($1//0)), '2010-10-02', 'rt: beg expand'); $q = $s->query_argv_to_string($g, [qw(rt:..2010-10-02 zz)]); @@ -615,7 +624,7 @@ SKIP: { $orig = $qs = qq[f:bob "hello world" d:1993-10-02..2010-10-02]; $s->query_approxidate($g, $qs); - is($qs, qq[f:bob "hello world" d:19931002..20101002], + is($qs, qq[f:bob "hello world" dt:19931002000000..20101002000000], 'post-phrase date corrected'); # Xapian uses "" to escape " inside phrases, we don't explictly @@ -627,7 +636,7 @@ SKIP: { is($qs, $orig, 'phrases unchanged \x'.ord($x).'-\x'.ord($y)); $s->query_approxidate($g, my $tmp = "$qs d:..2010-10-02"); - is($tmp, "$orig d:..20101002", + is($tmp, "$orig dt:..20101002000000", 'two phrases did not throw off date parsing'); $orig = $qs = qq[${x}hello d:1993-10-02..$y$x world$y]; @@ -635,7 +644,7 @@ SKIP: { is($qs, $orig, 'phrases unchanged \x'.ord($x).'-\x'.ord($y)); $s->query_approxidate($g, $tmp = "$qs d:..2010-10-02"); - is($tmp, "$orig d:..20101002", + is($tmp, "$orig dt:..20101002000000", 'two phrases did not throw off date parsing'); } @@ -654,7 +663,7 @@ SKIP: { skip 'TEST_EXPENSIVE not set for argv overflow check', 1; my @w; local $SIG{__WARN__} = sub { push @w, @_ }; # for pure Perl version - my @fail = map { 'd:1993-10-02..2010-10-02' } (1..(4096 * 32)); + my @fail = map { 'dt:1993-10-02..2010-10-02' } (1..(4096 * 32)); eval { $s->query_argv_to_string($g, \@fail) }; ok($@, 'exception raised'); } diff --git a/t/select.t b/t/select.t new file mode 100644 index 00000000..e8032c5a --- /dev/null +++ b/t/select.t @@ -0,0 +1,4 @@ +# Copyright (C) all contributors <meta@public-inbox.org> +use v5.12; +local $ENV{TEST_IOPOLLER} = 'PublicInbox::Select'; +require './t/ds-poll.t'; diff --git a/t/sha.t b/t/sha.t new file mode 100644 index 00000000..2e2d5636 --- /dev/null +++ b/t/sha.t @@ -0,0 +1,25 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use v5.12; +use PublicInbox::SHA; +use Test::More; + +{ + my $dig = PublicInbox::SHA->new(1); + open my $fh, '<', 'COPYING' or die "open: $!"; + $dig->add(do { local $/; <$fh> }); + is($dig->hexdigest, '78e50e186b04c8fe1defaa098f1c192181b3d837', + 'AGPL-3 matches'); +} + +SKIP: { + my $n = $ENV{TEST_LEAK_NR} or skip 'TEST_LEAK_NR unset', 1; + for (1..$n) { + PublicInbox::SHA->new(1)->add('hello')->digest; + PublicInbox::SHA->new(1)->add('hello'); + PublicInbox::SHA->new(1); + } +} + +done_testing; @@ -1,11 +1,13 @@ -# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org> -use strict; +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +use v5.12; use Test::More; use IO::Handle; use POSIX qw(:signal_h); use Errno qw(ENOSYS); require_ok 'PublicInbox::Sigfd'; use PublicInbox::DS; +my ($linux_sigfd, $has_sigfd); SKIP: { if ($^O ne 'linux' && !eval { require IO::KQueue }) { @@ -15,17 +17,26 @@ SKIP: { my $old = PublicInbox::DS::block_signals(); my $hit = {}; my $sig = {}; + local $SIG{USR2} = sub { $hit->{USR2}->{normal}++ }; local $SIG{HUP} = sub { $hit->{HUP}->{normal}++ }; local $SIG{TERM} = sub { $hit->{TERM}->{normal}++ }; local $SIG{INT} = sub { $hit->{INT}->{normal}++ }; - for my $s (qw(HUP TERM INT)) { + local $SIG{WINCH} = sub { $hit->{WINCH}->{normal}++ }; + for my $s (qw(USR2 HUP TERM INT WINCH)) { $sig->{$s} = sub { $hit->{$s}->{sigfd}++ }; } - my $sigfd = PublicInbox::Sigfd->new($sig, 0); + kill 'USR2', $$ or die "kill $!"; + ok(!defined($hit->{USR2}), 'no USR2 yet') or diag explain($hit); + PublicInbox::DS->Reset; + ok($PublicInbox::Syscall::SIGNUM{WINCH}, 'SIGWINCH number defined'); + my $sigfd = PublicInbox::Sigfd->new($sig); if ($sigfd) { + $linux_sigfd = 1 if $^O eq 'linux'; + $has_sigfd = 1; ok($sigfd, 'Sigfd->new works'); kill('HUP', $$) or die "kill $!"; kill('INT', $$) or die "kill $!"; + kill('WINCH', $$) or die "kill $!"; my $fd = fileno($sigfd->{sock}); ok($fd >= 0, 'fileno(Sigfd->{sock}) works'); my $rvec = ''; @@ -35,16 +46,23 @@ SKIP: { for my $s (qw(HUP INT)) { is($hit->{$s}->{sigfd}, 1, "sigfd fired $s"); is($hit->{$s}->{normal}, undef, - 'normal $SIG{$s} not fired'); + "normal \$SIG{$s} not fired"); } + SKIP: { + skip 'Linux sigfd-only behavior', 1 if !$linux_sigfd; + is($hit->{USR2}->{sigfd}, 1, + 'USR2 sent before signalfd created received'); + } + ok(!$hit->{USR2}->{normal}, 'USR2 not fired normally'); + PublicInbox::DS->Reset; $sigfd = undef; - my $nbsig = PublicInbox::Sigfd->new($sig, 1); + my $nbsig = PublicInbox::Sigfd->new($sig); ok($nbsig, 'Sigfd->new SFD_NONBLOCK works'); is($nbsig->wait_once, undef, 'nonblocking ->wait_once'); ok($! == Errno::EAGAIN, 'got EAGAIN'); kill('HUP', $$) or die "kill $!"; - PublicInbox::DS->SetPostLoopCallback(sub {}); # loop once + local @PublicInbox::DS::post_loop_do = (sub {}); # loop once PublicInbox::DS::event_loop(); is($hit->{HUP}->{sigfd}, 2, 'HUP sigfd fired in event loop') or diag explain($hit); # sometimes fails on FreeBSD 11.x @@ -54,10 +72,18 @@ SKIP: { PublicInbox::DS->Reset; is($hit->{TERM}->{sigfd}, 1, 'TERM sigfd fired in event loop'); is($hit->{HUP}->{sigfd}, 3, 'HUP sigfd fired in event loop'); + ok($hit->{WINCH}->{sigfd}, 'WINCH sigfd fired in event loop'); } else { skip('signalfd disabled?', 10); } - sigprocmask(SIG_SETMASK, $old) or die "sigprocmask $!"; + ok(!$hit->{USR2}->{normal}, 'USR2 still not fired normally'); + PublicInbox::DS::sig_setmask($old); + SKIP: { + ($has_sigfd && !$linux_sigfd) or + skip 'EVFILT_SIGNAL-only behavior check', 1; + is($hit->{USR2}->{normal}, 1, + "USR2 fired normally after unblocking on $^O"); + } } done_testing; diff --git a/t/solver_git.t b/t/solver_git.t index 1baa012b..db672904 100644 --- a/t/solver_git.t +++ b/t/solver_git.t @@ -1,22 +1,23 @@ #!perl -w -# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use v5.10.1; +use v5.12; use PublicInbox::TestCommon; use Cwd qw(abs_path); -require_git(2.6); +require_git v2.6; use PublicInbox::ContentHash qw(git_sha); -use PublicInbox::Spawn qw(popen_rd); -require_mods(qw(DBD::SQLite Search::Xapian Plack::Util)); -my $git_dir = xqx([qw(git rev-parse --git-dir)], undef, {2 => \(my $null)}); +use PublicInbox::Spawn qw(run_qx); +require_mods(qw(DBD::SQLite Xapian URI::Escape)); +require PublicInbox::SolverGit; +my $rdr = { 2 => \(my $null) }; +my $git_dir = xqx([qw(git rev-parse --git-common-dir)], undef, $rdr); +$git_dir = xqx([qw(git rev-parse --git-dir)], undef, $rdr) if $? != 0; $? == 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); -use_ok "PublicInbox::$_" for (qw(Inbox V2Writable Git SolverGit WWW)); my $patch2 = eml_load 't/solve/0002-rename-with-modifications.patch'; my $patch2_oid = git_sha(1, $patch2)->hexdigest; @@ -28,14 +29,22 @@ my $ibx = create_inbox 'v2', version => 2, $im->add($patch2) or BAIL_OUT; }; my $md = "$tmpdir/md"; -File::Path::mkpath([map { $md.$_ } (qw(/ /cur /new /tmp))]); +File::Path::make_path(map { $md.$_ } (qw(/cur /new /tmp))); symlink(abs_path('t/solve/0001-simple-mod.patch'), "$md/cur/foo:2,") or xbail "symlink: $!"; +my $v1_0_0_rev = '8a918a8523bc9904123460f85999d75f6d604916'; my $v1_0_0_tag = 'cb7c42b1e15577ed2215356a2bf925aef59cdd8d'; my $v1_0_0_tag_short = substr($v1_0_0_tag, 0, 16); my $expect = '69df7d565d49fbaaeb0a067910f03dc22cd52bd0'; my $non_existent = 'ee5e32211bf62ab6531bdf39b84b6920d0b6775a'; +my $stderr_empty = sub { + my ($msg) = @_; + open my $efh, '<', "$tmpdir/stderr.log" or xbail $!; + my @l = <$efh>; + @l = grep(!/reverse ?proxy/i, @l); + is_xdeeply(\@l, [], $msg // 'stderr.log is empty'); +}; test_lei({tmpdir => "$tmpdir/blob"}, sub { lei_ok('blob', '--mail', $patch2_oid, '-I', $ibx->{inboxdir}, @@ -199,10 +208,11 @@ my $hinted = $res; shift @$res; shift @$hinted; is_deeply($res, $hinted, 'hints work (or did not hurt :P'); -my @psgi = qw(HTTP::Request::Common Plack::Test URI::Escape Plack::Builder); +my @psgi = qw(HTTP::Request::Common Plack::Test Plack::Builder); SKIP: { require_mods(@psgi, 7 + scalar(@psgi)); use_ok($_) for @psgi; + require PublicInbox::WWW; my $binfoo = "$ibx->{inboxdir}/binfoo.git"; my $l = "$ibx->{inboxdir}/inbox.lock"; -f $l or BAIL_OUT "BUG: $l missing: $!"; @@ -213,27 +223,48 @@ SKIP: { }; my %bin = (big => $big_size, small => 1); my %oid; # (small|big) => OID - my $lk = bless { lock_path => $l }, 'PublicInbox::Lock'; + require PublicInbox::Lock; + my $lk = PublicInbox::Lock->new($l); my $acq = $lk->lock_for_scope; - my $stamp = "$binfoo/stamp"; + my $stamp = "$binfoo/stamp-"; if (open my $fh, '<', $stamp) { %oid = map { chomp; split(/=/, $_) } (<$fh>); } else { PublicInbox::Import::init_bare($binfoo); my $cmd = [ qw(git hash-object -w --stdin) ]; my $env = { GIT_DIR => $binfoo }; - open my $fh, '>', "$stamp.$$" or BAIL_OUT; while (my ($label, $size) = each %bin) { - pipe(my ($rin, $win)) or BAIL_OUT; - my $rout = popen_rd($cmd , $env, { 0 => $rin }); - $rin = undef; - print { $win } ("\0" x $size) or BAIL_OUT; - close $win or BAIL_OUT; - chomp(my $x = <$rout>); - close $rout or BAIL_OUT "$?"; - print $fh "$label=$x\n" or BAIL_OUT; + my $rdr = { 0 => \("\0" x $size) }; + chomp(my $x = run_qx($cmd , $env, $rdr)); + xbail "@$cmd: \$?=$?" if $?; $oid{$label} = $x; } + + open my $null, '<', '/dev/null' or xbail "open /dev/null: $!"; + my $t = xqx([qw(git mktree)], $env, { 0 => $null }); + xbail "mktree: $?" if $?; + chomp($t); + my $non_utf8 = "K\x{e5}g"; + $env->{GIT_AUTHOR_NAME} = $non_utf8; + $env->{GIT_AUTHOR_EMAIL} = 'e@example.com'; + $env->{GIT_COMMITTER_NAME} = $env->{GIT_AUTHOR_NAME}; + $env->{GIT_COMMITTER_EMAIL} = $env->{GIT_AUTHOR_EMAIL}; + my $in = \"$non_utf8\n\nK\x{e5}g\n"; + my @ct = qw(git -c i18n.commitEncoding=iso-8859-1 commit-tree); + my $c = xqx([@ct, $t], $env, { 0 => $in }); + xbail "commit-tree: $?" if $?; + chomp($c); + $oid{'iso-8859-1'} = $c; + + $c = xqx([@ct, '-p', $c, $t], $env, { 0 => $in }); + xbail "commit-tree: $?" if $?; + chomp($c); + $oid{'8859-parent'} = $c; + + open my $fh, '>', "$stamp.$$" or BAIL_OUT; + while (my ($k, $v) = each %oid) { + print $fh "$k=$v\n" or xbail "print: $!"; + } close $fh or BAIL_OUT; rename("$stamp.$$", $stamp) or BAIL_OUT; } @@ -244,6 +275,8 @@ SKIP: { my $cfgpath = "$tmpdir/httpd-config"; open my $cfgfh, '>', $cfgpath or die; print $cfgfh <<EOF or die; +[coderepo] + snapshots = tar.gz [publicinbox "$name"] address = $ibx->{-primary_address} inboxdir = $ibx->{inboxdir} @@ -258,6 +291,16 @@ SKIP: { cgiturl = http://example.com/binfoo EOF close $cfgfh or die; + my $exp_digest; + { + my $exp = xqx([qw(git archive --format=tar.gz + --prefix=public-inbox-1.0.0/ v1.0.0)], + { GIT_DIR => $git_dir }); + is($?, 0, 'no error from git archive'); + ok(length($exp) > 1024, 'expected archive generated'); + $exp_digest = git_sha(256, \$exp)->hexdigest; + }; + my $cfg = PublicInbox::Config->new($cfgpath); my $www = PublicInbox::WWW->new($cfg); my $client = sub { @@ -278,7 +321,7 @@ EOF is($res->code, 404, 'failure with null OID'); $res = $cb->(GET("/$name/$non_existent/s/")); - is($res->code, 404, 'failure with null OID'); + is($res->code, 404, 'failure with non-existent OID'); $res = $cb->(GET("/$name/$v1_0_0_tag/s/")); is($res->code, 200, 'shows commit (unabbreviated)'); @@ -287,38 +330,144 @@ EOF while (my ($label, $size) = each %bin) { $res = $cb->(GET("/$name/$oid{$label}/s/")); is($res->code, 200, "$label binary file"); - ok(index($res->content, "blob $size bytes") >= 0, + ok(index($res->content, + "blob $oid{$label} $size bytes") >= 0, "showed $label binary blob size"); $res = $cb->(GET("/$name/$oid{$label}/s/raw")); is($res->code, 200, "$label raw binary download"); is($res->content, "\0" x $size, "$label content matches"); } + my $utf8 = 'e022d3377fd2c50fd9931bf96394728958a90bf3'; + $res = $cb->(GET("/$name/$utf8/s/")); + is($res->code, 200, 'shows commit w/ utf8.eml'); + like($res->content, qr/Eléanor/, + 'UTF-8 commit shown properly'); + + # WwwCoderepo + my $olderr; + if (defined $ENV{PLACK_TEST_EXTERNALSERVER_URI}) { + $stderr_empty->('nothing in stderr.log, yet'); + } else { + open $olderr, '>&', \*STDERR or xbail "open: $!"; + open STDERR, '+>>', "$tmpdir/stderr.log" or + xbail "open: $!"; + } + $res = $cb->(GET('/binfoo/')); + defined($ENV{PLACK_TEST_EXTERNALSERVER_URI}) or + open STDERR, '>&', $olderr or xbail "open: $!"; + is($res->code, 200, 'coderepo summary (binfoo)'); + $stderr_empty->(); + + $res = $cb->(GET("/binfoo/$oid{'iso-8859-1'}/s/")); + is($res->code, 200, 'ISO-8859-1 commit'); + like($res->content, qr/Kåg/, 'ISO-8859-1 commit message'); + $stderr_empty->(); + + $res = $cb->(GET("/binfoo/$oid{'8859-parent'}/s/")); + is($res->code, 200, 'commit w/ ISO-8859-parent'); + like($res->content, qr/Kåg/, 'ISO-8859-1 commit message'); + $stderr_empty->(); + + $res = $cb->(GET('/public-inbox/')); + is($res->code, 200, 'coderepo summary (public-inbox)'); + + my $tip = 'invalid-'.int(rand(0xdeadbeef)); + $res = $cb->(GET('/public-inbox/?h='.$tip)); + is($res->code, 200, 'coderepo summary on dead branch'); + like($res->content, qr/no commits in `\Q$tip\E', yet/, + 'lack of commits noted'); + + $res = $cb->(GET('/public-inbox')); + is($res->code, 301, 'redirected'); + + my $fn = 'public-inbox-1.0.0.tar.gz'; + $res = $cb->(GET("/public-inbox/snapshot/$fn")); + is($res->code, 200, 'tar.gz snapshot'); + is($res->header('Content-Disposition'), + qq'inline; filename="$fn"', 'c-d header'); + is($res->header('ETag'), qq'"$v1_0_0_rev"', 'etag header'); + + my $got = $res->content; + is(git_sha(256, \$got)->hexdigest, $exp_digest, + "content matches installed `git archive' output"); + undef $got; + + $fn = 'public-inbox-1.0.2.tar.gz'; + $res = $cb->(GET("/public-inbox/snapshot/$fn")); + is($res->code, 404, '404 on non-existent tag'); + + $fn = 'public-inbox-1.0.0.tar.bz2'; + $res = $cb->(GET("/public-inbox/snapshot/$fn")); + is($res->code, 404, '404 on unconfigured snapshot format'); + + $res = $cb->(GET('/public-inbox/atom/')); + is($res->code, 200, 'Atom feed'); + SKIP: { + require_mods('XML::TreePP', 1); + my $t = eval { XML::TreePP->new->parse($res->content) } + or diag explain($res); + is(scalar @{$t->{feed}->{entry}}, 50, + 'got 50 entries') or diag explain([$t, $res]); + + $res = $cb->(GET('/public-inbox/atom/COPYING')); + is($res->code, 200, 'file Atom feed'); + $t = XML::TreePP->new->parse($res->content); + ok($t->{feed}->{entry}, 'got entry') or + diag explain([ $t, $res ]); + + $res = $cb->(GET('/public-inbox/atom/README.md')); + is($res->code, 404, '404 on missing file Atom feed'); + + $res = $cb->(GET('/public-inbox/atom/?h=gone')); + is($res->code, 404, '404 on missing Atom feed branch'); + } + + $res = $cb->(GET('/public-inbox/tree/')); + is($res->code, 200, 'got 200 for root listing'); + $got = $res->content; + like($got, qr/\bgit ls-tree\b/, 'ls-tree help shown'); + + $res = $cb->(GET('/public-inbox/tree/README')); + is($res->code, 200, 'got 200 for regular file'); + $got = $res->content; + like($got, qr/\bgit show\b/, 'git show help shown'); + + $res = $cb->(GET('/public-inbox/tree/Documentation')); + is($res->code, 200, 'got 200 for a directory'); + $got = $res->content; + like($got, qr/\bgit ls-tree\b/, 'ls-tree help shown'); + + $res = $cb->(GET('/public-inbox/tree/?h=no-branch')); + is($res->code, 404, 'got 404 for non-existent ref root'); + $res = $cb->(GET('/public-inbox/tree/README?h=no-file')); + is($res->code, 404, 'got 404 for non-existent ref README'); + $res = $cb->(GET('/public-inbox/tree/Documentation?h=no-dir')); + is($res->code, 404, 'got 404 for non-existent ref directory'); + + $res = $cb->(GET('/public-inbox/tags.atom')); + is($res->code, 200, 'Atom feed'); + SKIP: { + require_mods('XML::TreePP', 1); + my $t = XML::TreePP->new->parse($res->content); + ok(scalar @{$t->{feed}->{entry}}, 'got tag entries'); + } }; test_psgi(sub { $www->call(@_) }, $client); + my $env = { PI_CONFIG => $cfgpath, TMPDIR => $tmpdir }; + test_httpd($env, $client, 7, sub { SKIP: { - require_mods(qw(Plack::Test::ExternalServer), 7); - my $env = { PI_CONFIG => $cfgpath }; - my $sock = tcp_server() or die; - my ($out, $err) = map { "$tmpdir/std$_.log" } qw(out err); - my $cmd = [ qw(-httpd -W0), "--stdout=$out", "--stderr=$err" ]; - my $td = start_script($cmd, $env, { 3 => $sock }); - my ($h, $p) = tcp_host_port($sock); - my $url = "http://$h:$p"; - local $ENV{PLACK_TEST_EXTERNALSERVER_URI} = $url; - Plack::Test::ExternalServer::test_psgi(client => $client); require_cmd('curl', 1) or skip 'no curl', 1; - mkdir "$tmpdir/ext" // xbail "mkdir $!"; + my $rurl = "$ENV{PLACK_TEST_EXTERNALSERVER_URI}/$name"; test_lei({tmpdir => "$tmpdir/ext"}, sub { - my $rurl = "$url/$name"; lei_ok(qw(blob --no-mail 69df7d5 -I), $rurl); is(git_sha(1, \$lei_out)->hexdigest, $expect, 'blob contents output'); ok(!lei(qw(blob -I), $rurl, $non_existent), 'non-existent blob fails'); }); - } + }}); } done_testing(); @@ -1,11 +1,13 @@ -# Copyright (C) 2015-2021 all contributors <meta@public-inbox.org> +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use warnings; +use v5.12; use Test::More; -use PublicInbox::Spawn qw(which spawn popen_rd); -use PublicInbox::Sigfd; - +use PublicInbox::Spawn qw(which spawn popen_rd run_qx); +require PublicInbox::Sigfd; +require PublicInbox::DS; +use PublicInbox::OnDestroy; +my $rlimit_map = PublicInbox::Spawn->can('rlimit_map'); { my $true = which('true'); ok($true, "'true' command found with which()"); @@ -18,6 +20,17 @@ use PublicInbox::Sigfd; is($?, 0, 'true exited successfully'); } +{ + my $opt = { 0 => \'in', 2 => \(my $e) }; + my $out = run_qx(['sh', '-c', 'echo e >&2; cat'], undef, $opt); + is($e, "e\n", 'captured stderr'); + is($out, 'in', 'stdin read and stdout captured'); + $opt->{0} = \"IN\n3\nLINES"; + my @out = run_qx(['sh', '-c', 'echo E >&2; cat'], undef, $opt); + is($e, "E\n", 'captured stderr clobbers string'); + is_deeply(\@out, [ "IN\n", "3\n", 'LINES' ], 'stdout array'); +} + SKIP: { my $pid = spawn(['true'], undef, { pgid => 0 }); ok($pid, 'spawned process with new pgid'); @@ -38,9 +51,8 @@ SKIP: { $pid = eval { spawn(['true'], undef, { pgid => $wrong_pgid, 2 => $w }) }; close $w; my $err = do { local $/; <$r> }; - # diag "$err ($@)"; if (defined $pid) { - waitpid($pid, 0) if defined $pid; + waitpid($pid, 0); isnt($?, 0, 'child error (pure-Perl)'); } else { ok($@, 'exception raised'); @@ -62,14 +74,14 @@ elsif ($pid > 0) { } EOF my $oldset = PublicInbox::DS::block_signals(); - my $rd = popen_rd([$^X, '-e', $script]); + my $rd = popen_rd([$^X, qw(-w -e), $script]); diag 'waiting for child to reap grandchild...'; chomp(my $line = readline($rd)); - my ($rdy, $pid) = split(' ', $line); + my ($rdy, $pid) = split(/ /, $line); is($rdy, 'RDY', 'got ready signal, waitpid(-1) works in child'); ok(kill('CHLD', $pid), 'sent SIGCHLD to child'); is(readline($rd), "HI\n", '$SIG{CHLD} works in child'); - ok(close $rd, 'popen_rd close works'); + ok($rd->close, 'popen_rd close works'); PublicInbox::DS::sig_setmask($oldset); } @@ -96,39 +108,40 @@ EOF { my $fh = popen_rd([qw(echo hello)]); - ok(fileno($fh) >= 0, 'tied fileno works'); + ok(fileno($fh) >= 0, 'fileno works'); my $l = <$fh>; - is($l, "hello\n", 'tied readline works'); + is($l, "hello\n", 'readline works'); $l = <$fh>; - ok(!$l, 'tied readline works for EOF'); + ok(!$l, 'readline works for EOF'); } { my $fh = popen_rd([qw(printf foo\nbar)]); - ok(fileno($fh) >= 0, 'tied fileno works'); - my $tfh = (tied *$fh)->{fh}; - is($tfh->blocking(0), 1, '->blocking was true'); - is($tfh->blocking, 0, '->blocking is false'); - is($tfh->blocking(1), 0, '->blocking was true'); - is($tfh->blocking, 1, '->blocking is true'); + ok(fileno($fh) >= 0, 'fileno works'); + is($fh->blocking(0), 1, '->blocking was true'); + is($fh->blocking, 0, '->blocking is false'); + is($fh->blocking(1), 0, '->blocking was true'); + is($fh->blocking, 1, '->blocking is true'); my @line = <$fh>; is_deeply(\@line, [ "foo\n", 'bar' ], 'wantarray works on readline'); } { my $fh = popen_rd([qw(echo hello)]); + like($fh->attached_pid, qr/\A[0-9]+\z/, 'have a PID'); my $buf; is(sysread($fh, $buf, 6), 6, 'sysread got 6 bytes'); - is($buf, "hello\n", 'tied gets works'); + is($buf, "hello\n", 'sysread works'); is(sysread($fh, $buf, 6), 0, 'sysread got EOF'); $? = 1; - ok(close($fh), 'close succeeds'); + ok($fh->close, 'close succeeds'); is($?, 0, '$? set properly'); + is($fh->attached_pid, undef, 'attached_pid cleared after close'); } { my $fh = popen_rd([qw(false)]); - ok(!close($fh), 'close fails on false'); + ok(!$fh->close, 'close fails on false'); isnt($?, 0, '$? set properly: '.$?); } @@ -140,26 +153,26 @@ EOF { # ->CLOSE vs ->DESTROY waitpid caller distinction my @c; - my $fh = popen_rd(['true'], undef, { cb => sub { @c = caller } }); - ok(close($fh), '->CLOSE fired and successful'); + my $fh = popen_rd(['true'], undef, undef, sub { @c = caller }); + ok($fh->close, '->CLOSE fired and successful'); ok(scalar(@c), 'callback fired by ->CLOSE'); ok(grep(!m[/PublicInbox/DS\.pm\z], @c), 'callback not invoked by DS'); @c = (); - $fh = popen_rd(['true'], undef, { cb => sub { @c = caller } }); + $fh = popen_rd(['true'], undef, undef, sub { @c = caller }); undef $fh; # ->DESTROY ok(scalar(@c), 'callback fired by ->DESTROY'); - ok(grep(!m[/PublicInbox/ProcessPipe\.pm\z], @c), - 'callback not invoked by ProcessPipe'); + ok(grep(!m[/PublicInbox/IO\.pm\z], @c), + 'callback not invoked by PublicInbox::IO'); } { # children don't wait on siblings use POSIX qw(_exit); pipe(my ($r, $w)) or BAIL_OUT $!; - my $cb = sub { warn "x=$$\n" }; - my $fh = popen_rd(['cat'], undef, { 0 => $r, cb => $cb }); - my $pp = tied *$fh; - my $pid = fork // BAIL_OUT $!; + my @arg; + my $fh = popen_rd(['cat'], undef, { 0 => $r }, + sub { @arg = @_; warn "x=$$\n" }, 'hi'); + my $pid = PublicInbox::OnDestroy::fork_tmp; local $SIG{__WARN__} = sub { _exit(1) }; if ($pid == 0) { local $SIG{__DIE__} = sub { _exit(2) }; @@ -171,30 +184,86 @@ EOF my @w; local $SIG{__WARN__} = sub { push @w, @_ }; close $w; - close $fh; + $fh->close; # may set $? is($?, 0, 'cat exited'); + is(scalar(@arg), 2, 'callback got args'); + is($arg[1], 'hi', 'passed arg'); + like($arg[0], qr/\A\d+\z/, 'PID'); is_deeply(\@w, [ "x=$$\n" ], 'callback fired from owner'); } SKIP: { - eval { - require BSD::Resource; - defined(BSD::Resource::RLIMIT_CPU()) - } or skip 'BSD::Resource::RLIMIT_CPU missing', 3; - my ($r, $w); - pipe($r, $w) or die "pipe: $!"; - my $cmd = ['sh', '-c', 'while true; do :; done']; + if ($rlimit_map) { # Inline::C installed + my %rlim = $rlimit_map->(); + ok defined($rlim{RLIMIT_CPU}), 'RLIMIT_CPU defined'; + } else { + eval { + require BSD::Resource; + defined(BSD::Resource::RLIMIT_CPU()) + } or skip 'BSD::Resource::RLIMIT_CPU missing', 3; + } + my $cmd = [ $^X, qw(-w -e), <<'EOM' ]; +use POSIX qw(:signal_h); +use Time::HiRes qw(time); # gettimeofday +my $have_bsd_resource = eval { require BSD::Resource }; +my $set = POSIX::SigSet->new; +$set->emptyset; # spawn() defaults to blocking all signals +sigprocmask(SIG_SETMASK, $set) or die "SIG_SETMASK: $!"; +my $tot = 0; +$SIG{XCPU} = sub { print "SIGXCPU $tot\n"; exit(1) }; +my $next = time + 1.1; +while (1) { + # OpenBSD needs some syscalls (e.g. `times', `gettimeofday' + # and `write' (via Perl warn)) on otherwise idle systems to + # hit RLIMIT_CPU and fire signals: + # https://marc.info/?i=02A4BB8D-313C-464D-845A-845EB6136B35@gmail.com + my @t = $have_bsd_resource ? BSD::Resource::times() : (0, 0); + $tot = $t[0] + $t[1]; + if (time > $next) { + warn "# T: @t (utime, ctime, cutime, cstime)\n" if @t; + $next = time + 1.1; + } +} +EOM + pipe(my($r, $w)) or die "pipe: $!"; my $fd = fileno($w); - my $opt = { RLIMIT_CPU => [ 1, 1 ], RLIMIT_CORE => [ 0, 0 ], 1 => $fd }; + my $opt = { RLIMIT_CPU => [ 1, 9 ], RLIMIT_CORE => [ 0, 0 ], 1 => $fd }; my $pid = spawn($cmd, undef, $opt); close $w or die "close(w): $!"; my $rset = ''; vec($rset, fileno($r), 1) = 1; ok(select($rset, undef, undef, 5), 'child died before timeout'); is(waitpid($pid, 0), $pid, 'XCPU child process reaped'); - isnt($?, 0, 'non-zero exit status'); + my $line; + like($line = readline($r), qr/SIGXCPU/, 'SIGXCPU handled') or + diag explain($line); + is($? >> 8, 1, 'non-zero exit status'); } -done_testing(); +SKIP: { + require PublicInbox::SpawnPP; + require File::Temp; + my $tmp = File::Temp->newdir('spawnpp-XXXX', TMPDIR => 1); + my $cmd = [ qw(/bin/sh -c), 'echo $HI >foo' ]; + my $env = [ 'HI=hihi' ]; + my $rlim = []; + my $pgid = -1; + my $pid = PublicInbox::SpawnPP::pi_fork_exec([], '/bin/sh', $cmd, $env, + $rlim, "$tmp", $pgid); + is(waitpid($pid, 0), $pid, 'spawned process exited'); + is($?, 0, 'no error'); + open my $fh, '<', "$tmp/foo" or die "open: $!"; + is(readline($fh), "hihi\n", 'env+chdir worked for SpawnPP'); + close $fh; + unlink("$tmp/foo") or die "unlink: $!"; + { + local $ENV{MOD_PERL} = 1; + $pid = PublicInbox::SpawnPP::pi_fork_exec([], + '/bin/sh', $cmd, $env, $rlim, "$tmp", $pgid); + } + is(waitpid($pid, 0), $pid, 'spawned process exited'); + open $fh, '<', "$tmp/foo" or die "open: $!"; + is(readline($fh), "hihi\n", 'env+chdir SpawnPP under (faked) MOD_PERL'); +} -1; +done_testing(); diff --git a/t/tail_notify.t b/t/tail_notify.t new file mode 100644 index 00000000..82480ebc --- /dev/null +++ b/t/tail_notify.t @@ -0,0 +1,38 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use v5.12; +use PublicInbox::TestCommon; +use POSIX qw(_exit); +my ($tmpdir, $for_destroy) = tmpdir(); +use_ok 'PublicInbox::TailNotify'; +my $f = "$tmpdir/log"; +open my $fh, '>>', $f or xbail $!; +my $tn = PublicInbox::TailNotify->new($f); +my @x = $tn->getlines(1); +is_deeply(\@x, [], 'nothing, yet'); +my $pid = fork // xbail "fork: $!"; +if ($pid == 0) { + tick; + syswrite $fh, "hi\n" // xbail "syswrite: $!"; + _exit(0); +} +@x = $tn->getlines; +is_deeply(\@x, [ "hi\n" ], 'got line'); +waitpid($pid, 0) // xbail "waitpid: $!"; +is($?, 0, 'writer done'); + +$pid = fork // xbail "fork: $!"; +if ($pid == 0) { + tick; + unlink $f // xbail "unlink($f): $!"; + open $fh, '>>', $f or xbail $!; + syswrite $fh, "bye\n" // xbail "syswrite: $!"; + _exit(0); +} +@x = $tn->getlines; +is_deeply(\@x, [ "bye\n" ], 'got line after reopen'); +waitpid($pid, 0) // xbail "waitpid: $!"; +is($?, 0, 'writer done'); + +done_testing; diff --git a/t/v1-add-remove-add.t b/t/v1-add-remove-add.t index a94bf7fd..50ff8143 100644 --- a/t/v1-add-remove-add.t +++ b/t/v1-add-remove-add.t @@ -6,7 +6,7 @@ use Test::More; use PublicInbox::Import; use PublicInbox::TestCommon; use PublicInbox::Eml; -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(DBD::SQLite Xapian)); require PublicInbox::SearchIdx; my ($inboxdir, $for_destroy) = tmpdir(); my $ibx = { @@ -32,7 +32,7 @@ ok($im->add($mime), 'message added again'); $im->done; my $rw = PublicInbox::SearchIdx->new($ibx, 1); $rw->index_sync; -my $msgs = $ibx->recent({limit => 10}); +my $msgs = $ibx->over->recent({limit => 10}); is($msgs->[0]->{mid}, 'a-mid@b', 'message exists in history'); is(scalar @$msgs, 1, 'only one message in history'); is($ibx->mm->num_for('a-mid@b'), 2, 'exists with second article number'); diff --git a/t/v1reindex.t b/t/v1reindex.t index f593b323..2d12e3f5 100644 --- a/t/v1reindex.t +++ b/t/v1reindex.t @@ -8,7 +8,7 @@ use File::Path qw(remove_tree); use PublicInbox::TestCommon; use PublicInbox::Eml; require_git(2.6); -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(DBD::SQLite Xapian)); use_ok 'PublicInbox::SearchIdx'; use_ok 'PublicInbox::Import'; use_ok 'PublicInbox::OverIdx'; diff --git a/t/v2-add-remove-add.t b/t/v2-add-remove-add.t index 579cdcb6..ddf8d248 100644 --- a/t/v2-add-remove-add.t +++ b/t/v2-add-remove-add.t @@ -6,7 +6,7 @@ use Test::More; use PublicInbox::Eml; use PublicInbox::TestCommon; require_git(2.6); -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(DBD::SQLite Xapian)); use_ok 'PublicInbox::V2Writable'; my ($inboxdir, $for_destroy) = tmpdir(); my $ibx = { @@ -32,7 +32,7 @@ ok($im->add($mime), 'message added'); ok($im->remove($mime), 'message removed'); ok($im->add($mime), 'message added again'); $im->done; -my $msgs = $ibx->recent({limit => 1000}); +my $msgs = $ibx->over->recent({limit => 1000}); is($msgs->[0]->{mid}, 'a-mid@b', 'message exists in history'); is(scalar @$msgs, 1, 'only one message in history'); @@ -3,15 +3,15 @@ # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use v5.10.1; use strict; -use Test::More; use Fcntl qw(SEEK_SET); use Cwd; use PublicInbox::TestCommon; use PublicInbox::Eml; +use File::Path qw(remove_tree); require_git(2.6); my $V = 2; -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(DBD::SQLite Xapian)); use_ok 'PublicInbox::V2Writable'; my ($tmpdir, $for_destroy) = tmpdir(); my $ibx = { @@ -96,4 +96,29 @@ is($eml->as_string, $mime->as_string, 'injected message'); is($mset->size, 1, 'patchid search works'); } +{ + my @shards = grep(m!/[0-9]+\z!, glob("$ibx->{inboxdir}/xap*/*")); + ok(remove_tree(@shards), 'rm shards to convert to indexlevel=basic'); + $ibx->do_cleanup; + $rdr->{2} = \(my $err = ''); + $rdr->{0} = \<<'EOM'; +From: a@example.com +To: test@example.com +Subject: this is a ham message for learn +Date: Fri, 02 Oct 1993 00:00:00 +0000 +Message-ID: <ham@example> + +yum +EOM + my ($id, $prev); + is($ibx->over->next_by_mid('ham@example', \$id, \$prev), undef, + 'no ham@example, yet'); + ok(run_script([qw(-learn ham)], undef, $rdr), '-learn runs on basic') + or diag $err; + my $smsg = $ibx->over->next_by_mid('ham@example', \$id, \$prev); + ok($smsg, 'ham message learned w/ indexlevel=basic'); + @shards = grep(m!/[0-9]+\z!, glob("$ibx->{inboxdir}/xap*/*")); + is_deeply(\@shards, [], 'not converted to medium/full after learn'); +} + done_testing(); diff --git a/t/v2mirror.t b/t/v2mirror.t index 37d64e83..b8824182 100644 --- a/t/v2mirror.t +++ b/t/v2mirror.t @@ -1,4 +1,4 @@ -# Copyright (C) 2018-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; @@ -14,7 +14,7 @@ use IO::Uncompress::Gunzip qw(gunzip $GunzipError); # Integration tests for HTTP cloning + mirroring require_mods(qw(Plack::Util Plack::Builder - HTTP::Date HTTP::Status Search::Xapian DBD::SQLite)); + HTTP::Date HTTP::Status Xapian DBD::SQLite)); use_ok 'PublicInbox::V2Writable'; use PublicInbox::InboxWritable; use PublicInbox::Eml; @@ -330,12 +330,12 @@ SKIP: { require_mods('Email::MIME', 1); # for legacy revision # using plackup to test old PublicInbox::WWW since -httpd from # back then relied on some packages we no longer depend on - my $plackup = which('plackup') or skip('no plackup in path', 1); + my $plackup = require_cmd('plackup', 1) or skip('no plackup in path', 1); require PublicInbox::Lock; chomp $oldrev; my ($base) = ($0 =~ m!\b([^/]+)\.[^\.]+\z!); my $wt = "t/data-gen/$base.pre-manifest-$oldrev"; - my $lk = bless { lock_path => __FILE__ }, 'PublicInbox::Lock'; + my $lk = PublicInbox::Lock->new(__FILE__); $lk->lock_acquire; my $psgi = "$wt/app.psgi"; if (!-f $psgi) { # checkout a pre-manifest.js.gz version @@ -368,10 +368,11 @@ EOM # wait for plackup socket()+bind()+listen() my %opt = ( Proto => 'tcp', Type => Socket::SOCK_STREAM(), PeerAddr => "$host:$port" ); - for (0..50) { + for (0..100) { tick(); last if IO::Socket::INET->new(%opt); } + IO::Socket::INET->new(%opt) or xbail "connect $host:$port: $!"; my $dst = "$tmpdir/scrape"; @cmd = (qw(-clone -q), "http://$host:$port/v2", $dst); run_script(\@cmd, undef, { 2 => \($err = '') }); diff --git a/t/v2reindex.t b/t/v2reindex.t index cafe8648..8c49e154 100644 --- a/t/v2reindex.t +++ b/t/v2reindex.t @@ -1,11 +1,11 @@ -# Copyright (C) 2018-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use PublicInbox::TestCommon; use PublicInbox::Eml; use PublicInbox::ContentHash qw(content_digest); use File::Path qw(remove_tree); require_git(2.6); -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(DBD::SQLite Xapian)); use_ok 'PublicInbox::V2Writable'; use_ok 'PublicInbox::OverIdx'; my ($inboxdir, $for_destroy) = tmpdir(); @@ -549,9 +549,8 @@ is($err, '', 'no errors from --xapian-only'); undef $for_destroy; SKIP: { skip 'only testing lsof(8) output on Linux', 1 if $^O ne 'linux'; - my $lsof = require_cmd('lsof', 1) or skip 'no lsof in PATH', 1; my $rdr = { 2 => \(my $null_err) }; - my @d = grep(m!/xap[0-9]+/!, xqx([$lsof, '-p', $$], undef, $rdr)); + my @d = grep m!/xap[0-9]+/!, lsof_pid $$, $rdr; is_deeply(\@d, [], 'no deleted index files') or diag explain(\@d); } done_testing(); diff --git a/t/v2writable.t b/t/v2writable.t index 477621e2..1b7e9e7d 100644 --- a/t/v2writable.t +++ b/t/v2writable.t @@ -8,7 +8,7 @@ use PublicInbox::ContentHash qw(content_digest content_hash); use PublicInbox::TestCommon; use Cwd qw(abs_path); require_git(2.6); -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(DBD::SQLite Xapian)); local $ENV{HOME} = abs_path('t'); use_ok 'PublicInbox::V2Writable'; umask 007; @@ -149,7 +149,7 @@ SELECT COUNT(*) FROM over WHERE num > 0 } { - use Net::NNTP; + require_mods('Net::NNTP', 1); my $err = "$inboxdir/stderr.log"; my $out = "$inboxdir/stdout.log"; my $group = 'inbox.comp.test.v2writable'; @@ -283,6 +283,22 @@ EOF is($msgs->[1]->{mid}, 'y'x244, 'stored truncated mid(2)'); } +if ('UTF-8 References') { + my @w; + local $SIG{__WARN__} = sub { push @w, @_ }; + my $msg = <<EOM; +From: a\@example.com +Subject: b +Message-ID: <horrible\@example> +References: <\xc4\x80\@example> + +EOM + ok($im->add(PublicInbox::Eml->new($msg."a\n")), 'UTF-8 References 1'); + ok($im->add(PublicInbox::Eml->new($msg."b\n")), 'UTF-8 References 2'); + $im->done; + ok(!grep(/Wide character/, @w), 'no wide characters') or xbail(\@w); +} + my $tmp = { inboxdir => "$inboxdir/non-existent/subdir", name => 'nope', diff --git a/t/watch_filter_rubylang.t b/t/watch_filter_rubylang.t index 004e794e..f72feb9f 100644 --- a/t/watch_filter_rubylang.t +++ b/t/watch_filter_rubylang.t @@ -1,12 +1,9 @@ -# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use warnings; +use v5.12; use PublicInbox::TestCommon; -use Test::More; use PublicInbox::Eml; -use PublicInbox::Config; -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(DBD::SQLite Xapian)); use_ok 'PublicInbox::Watch'; use_ok 'PublicInbox::Emergency'; my ($tmpdir, $for_destroy) = tmpdir(); @@ -25,7 +22,6 @@ SKIP: { for my $v (@v) { my @warn; local $SIG{__WARN__} = sub { push @warn, @_ }; - my $cfgpfx = "publicinbox.$v"; my $inboxdir = "$tmpdir/$v"; my $maildir = "$tmpdir/md-$v"; my $spamdir = "$tmpdir/spam-$v"; @@ -60,16 +56,16 @@ Date: Sat, 05 Jan 2019 04:19:17 +0000 spam EOF PublicInbox::Emergency->new($maildir)->prepare(\"$spam"); - - my $orig = <<EOF; -$cfgpfx.address=$addr -$cfgpfx.inboxdir=$inboxdir -$cfgpfx.watch=maildir:$maildir -$cfgpfx.filter=PublicInbox::Filter::RubyLang -$cfgpfx.altid=serial:alerts:file=msgmap.sqlite3 -publicinboxwatch.watchspam=maildir:$spamdir -EOF - my $cfg = PublicInbox::Config->new(\$orig); + my $cfg = cfg_new $tmpdir, <<EOM; +[publicinbox "$v"] + address = $addr + inboxdir = $inboxdir + watch = maildir:$maildir + filter = PublicInbox::Filter::RubyLang + altid = serial:alerts:file=msgmap.sqlite3 +[publicinboxwatch] + watchspam = maildir:$spamdir +EOM my $ibx = $cfg->lookup_name($v); $ibx->{-no_fsync} = 1; ok($ibx, 'found inbox by name'); @@ -99,7 +95,10 @@ EOF } $w->scan('full'); - $cfg = PublicInbox::Config->new(\$orig); + # ensure orderly destruction to avoid SQLite segfault: + PublicInbox::DS->Reset; + + $cfg = PublicInbox::Config->new($cfg->{-f}); $ibx = $cfg->lookup_name($v); $ibx->{-no_fsync} = 1; is($ibx->search->reopen->mset('b:spam')->size, 0, 'spam removed'); diff --git a/t/watch_imap.t b/t/watch_imap.t index eeda29eb..26fd5330 100644 --- a/t/watch_imap.t +++ b/t/watch_imap.t @@ -1,16 +1,18 @@ -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use Test::More; -use PublicInbox::Config; +use v5.12; +use PublicInbox::TestCommon; # see t/imapd*.t for tests against a live IMAP server use_ok 'PublicInbox::Watch'; -my $cfg = PublicInbox::Config->new(\<<EOF); -publicinbox.i.address=i\@example.com -publicinbox.i.inboxdir=/nonexistent -publicinbox.i.watch=imap://example.com/INBOX.a -publicinboxlearn.watchspam=imap://example.com/INBOX.spam +my $tmpdir = tmpdir; +my $cfg = cfg_new $tmpdir, <<EOF; +[publicinbox "i"] + address = i\@example.com + inboxdir = /nonexistent + watch = imap://example.com/INBOX.a +[publicinboxlearn] + watchspam = imap://example.com/INBOX.spam EOF my $watch = PublicInbox::Watch->new($cfg); is($watch->{imap}->{'imap://example.com/INBOX.a'}->[0]->{name}, 'i', diff --git a/t/watch_maildir.t b/t/watch_maildir.t index e0719f54..a12ceefd 100644 --- a/t/watch_maildir.t +++ b/t/watch_maildir.t @@ -1,23 +1,21 @@ -# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org> +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use Test::More; +use v5.12; use PublicInbox::Eml; use Cwd; -use PublicInbox::Config; use PublicInbox::TestCommon; use PublicInbox::Import; +use PublicInbox::IO qw(write_file); my ($tmpdir, $for_destroy) = tmpdir(); my $git_dir = "$tmpdir/test.git"; my $maildir = "$tmpdir/md"; my $spamdir = "$tmpdir/spam"; use_ok 'PublicInbox::Watch'; use_ok 'PublicInbox::Emergency'; -my $cfgpfx = "publicinbox.test"; my $addr = 'test-public@example.com'; my $default_branch = PublicInbox::Import::default_branch; PublicInbox::Import::init_bare($git_dir); - my $msg = <<EOF; From: user\@example.com To: $addr @@ -27,6 +25,9 @@ Date: Sat, 18 Jun 2016 00:00:00 +0000 something EOF + +my $ibx_ro = create_inbox 'ro', sub { $_[0]->add(PublicInbox::Eml->new($msg)) }; + PublicInbox::Emergency->new($maildir)->prepare(\$msg); ok(POSIX::mkfifo("$maildir/cur/fifo", 0777), 'create FIFO to ensure we do not get stuck on it :P'); @@ -35,22 +36,21 @@ my $sem = PublicInbox::Emergency->new($spamdir); # create dirs { my @w; local $SIG{__WARN__} = sub { push @w, @_ }; - my $cfg = PublicInbox::Config->new(\<<EOF); -$cfgpfx.address=$addr -$cfgpfx.inboxdir=$git_dir -$cfgpfx.watch=maildir:$spamdir -publicinboxlearn.watchspam=maildir:$spamdir + my $cfg = cfg_new $tmpdir, <<EOF; +[publicinbox "test"] + address = $addr + inboxdir = $git_dir + watch = maildir:$spamdir +[publicinboxlearn] + watchspam = maildir:$spamdir EOF my $wm = PublicInbox::Watch->new($cfg); is(scalar grep(/is a spam folder/, @w), 1, 'got warning about spam'); - is_deeply($wm->{mdmap}, { "$spamdir/cur" => 'watchspam' }, + is_deeply($wm->{d_map}, { "$spamdir/cur" => 'watchspam' }, 'only got the spam folder to watch'); } -my $cfg_path = "$tmpdir/config"; -{ - open my $fh, '>', $cfg_path or BAIL_OUT $!; - print $fh <<EOF or BAIL_OUT $!; +my $cfg = cfg_new $tmpdir, <<EOF; [publicinbox "test"] address = $addr inboxdir = $git_dir @@ -58,11 +58,12 @@ my $cfg_path = "$tmpdir/config"; filter = PublicInbox::Filter::Vger [publicinboxlearn] watchspam = maildir:$spamdir +[publicinbox "test-ro"] + watch = false + inboxdir = $ibx_ro->{inboxdir} + address = ro-test\@example.com EOF - close $fh or BAIL_OUT $!; -} - -my $cfg = PublicInbox::Config->new($cfg_path); +my $cfg_path = $cfg->{-f}; PublicInbox::Watch->new($cfg)->scan('full'); my $git = PublicInbox::Git->new($git_dir); my @list = $git->qx('rev-list', $default_branch); @@ -87,6 +88,10 @@ is(scalar @list, 2, 'two revisions in rev-list'); is(scalar @list, 0, 'tree is empty'); is(unlink(glob("$spamdir/cur/*")), 1, 'unlinked trained spam'); +@list = $ibx_ro->git->qx(qw(ls-tree -r --name-only), $default_branch); +undef $ibx_ro; +is scalar(@list), 1, 'read-only inbox is unchanged'; + # check with scrubbing { $msg .= qq(-- @@ -97,6 +102,7 @@ More majordomo info at http://vger.kernel.org/majordomo-info.html\n); PublicInbox::Watch->new($cfg)->scan('full'); @list = $git->qx('ls-tree', '-r', '--name-only', $default_branch); is(scalar @list, 1, 'tree has one file'); + chomp(@list); my $mref = $git->cat_file('HEAD:'.$list[0]); like($$mref, qr/something\n\z/s, 'message scrubbed on import'); @@ -137,10 +143,7 @@ More majordomo info at http://vger.kernel.org/majordomo-info.html\n); PublicInbox::Watch->new($cfg)->scan('full'); @list = $git->qx('ls-tree', '-r', '--name-only', $default_branch); is(scalar @list, 1, 'tree has one file after spamc checked'); - - # XXX: workaround some weird caching/memoization in cat-file, - # shouldn't be an issue in real-world use, though... - $git = PublicInbox::Git->new($git_dir); + chomp(@list); my $mref = $git->cat_file($default_branch.':'.$list[0]); like($$mref, qr/something\n\z/s, 'message scrubbed on import'); @@ -151,8 +154,13 @@ More majordomo info at http://vger.kernel.org/majordomo-info.html\n); my $env = { PI_CONFIG => $cfg_path }; $git->cleanup; + write_file '>>', $cfg_path, <<EOM; +[publicinboxImport] + dropUniqueUnsubscribe +EOM # n.b. --no-scan is only intended for testing atm my $wm = start_script([qw(-watch --no-scan)], $env); + no_pollerfd($wm->{pid}); my $eml = eml_load('t/data/0001.patch'); $eml->header_set('Cc', $addr); my $em = PublicInbox::Emergency->new($maildir); @@ -170,11 +178,11 @@ More majordomo info at http://vger.kernel.org/majordomo-info.html\n); my $ii = PublicInbox::InboxIdle->new($cfg); my $obj = bless \$cb, 'PublicInbox::TestCommon::InboxWakeup'; $cfg->each_inbox(sub { $_[0]->subscribe_unlock('ident', $obj) }); - PublicInbox::DS->SetPostLoopCallback(sub { $delivered == 0 }); + local @PublicInbox::DS::post_loop_do = (sub { $delivered == 0 }); # wait for -watch to setup inotify watches my $sleep = 1; - if (eval { require Linux::Inotify2 } && -d "/proc/$wm->{pid}/fd") { + if (eval { require PublicInbox::Inotify } && -d "/proc/$wm->{pid}/fd") { my $end = time + 2; my (@ino, @ino_info); do { @@ -201,13 +209,32 @@ More majordomo info at http://vger.kernel.org/majordomo-info.html\n); $em->commit; # wake -watch up diag 'waiting for -watch to import new message'; PublicInbox::DS::event_loop(); + + my $head = $git->qx(qw(cat-file commit HEAD)); + my $subj = $eml->header('Subject'); + like($head, qr/^\Q$subj\E/sm, 'new commit made'); + + # try dropUniqueUnsubscribe + $delivered = 0; + $eml->header_set('Message-ID', '<unsubscribe@example>'); + $eml->header_set('List-Unsubscribe', + '<https://example.com/some-UUID-here/test'); + $eml->header_set('List-Unsubscribe-Post', 'List-Unsubscribe=One-Click'); + $em = PublicInbox::Emergency->new($maildir); + $em->prepare(\($eml->as_string)); + $em->commit; # wake -watch up + diag 'waiting for -watch to import dropUniqueUnsubscribe message'; + PublicInbox::DS::event_loop(); + my $cur = $git->qx(qw(diff HEAD~1..HEAD)); + like $cur, qr/Message-ID: <unsubscribe\@example>/, + 'unsubscribe@example imported'; + unlike $cur, qr/List-Unsubscribe\b/, + 'List-Unsubscribe-* headers gone w/ dropUniqueUnsubscribe'; + $wm->kill; $wm->join; $ii->close; PublicInbox::DS->Reset; - my $head = $git->qx(qw(cat-file commit HEAD)); - my $subj = $eml->header('Subject'); - like($head, qr/^\Q$subj\E/sm, 'new commit made'); } sub is_maildir { diff --git a/t/watch_maildir_v2.t b/t/watch_maildir_v2.t index 7b46232b..fa86f7bf 100644 --- a/t/watch_maildir_v2.t +++ b/t/watch_maildir_v2.t @@ -1,14 +1,12 @@ -# Copyright (C) 2018-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use Test::More; +use v5.12; use PublicInbox::Eml; use Cwd; -use PublicInbox::Config; use PublicInbox::TestCommon; use PublicInbox::Import; require_git(2.6); -require_mods(qw(Search::Xapian DBD::SQLite)); +require_mods(qw(Xapian DBD::SQLite)); require PublicInbox::V2Writable; my ($tmpdir, $for_destroy) = tmpdir(); my $inboxdir = "$tmpdir/v2"; @@ -38,13 +36,15 @@ ok(POSIX::mkfifo("$maildir/cur/fifo", 0777), my $sem = PublicInbox::Emergency->new($spamdir); # create dirs my $orig = <<EOF; -$cfgpfx.address=$addr -$cfgpfx.inboxdir=$inboxdir -$cfgpfx.watch=maildir:$maildir -$cfgpfx.filter=PublicInbox::Filter::Vger -publicinboxlearn.watchspam=maildir:$spamdir +[publicinbox "test"] + address = $addr + inboxdir = $inboxdir + watch = maildir:$maildir + filter = PublicInbox::Filter::Vger +[publicinboxlearn] + watchspam = maildir:$spamdir EOF -my $cfg = PublicInbox::Config->new(\$orig); +my $cfg = cfg_new $tmpdir, $orig; my $ibx = $cfg->lookup_name('test'); ok($ibx, 'found inbox by name'); $ibx->{-no_fsync} = 1; @@ -147,12 +147,13 @@ More majordomo info at http://vger.kernel.org/majordomo-info.html\n); my $v1pfx = "publicinbox.v1"; my $v1addr = 'v1-public@example.com'; PublicInbox::Import::init_bare($v1repo); - my $raw = <<EOF; -$orig$v1pfx.address=$v1addr -$v1pfx.inboxdir=$v1repo -$v1pfx.watch=maildir:$maildir + my $cfg = cfg_new $tmpdir, <<EOF; +$orig +[publicinbox "v1"] + address = $v1addr + inboxdir = $v1repo + watch = maildir:$maildir EOF - my $cfg = PublicInbox::Config->new(\$raw); my $both = <<EOF; From: user\@example.com To: $addr, $v1addr @@ -185,19 +186,22 @@ List-Id: <do.not.want> X-Mailing-List: no@example.com Message-ID: <do.not.want@example.com> EOF - my $raw = $orig."$cfgpfx.listid=i.want.you.to.want.me\n"; PublicInbox::Emergency->new($maildir)->prepare(\$want); PublicInbox::Emergency->new($maildir)->prepare(\$do_not_want); - my $cfg = PublicInbox::Config->new(\$raw); + my $raw = <<EOM; +$orig +[publicinbox "test"] + listid = i.want.you.to.want.me +EOM + my $cfg = cfg_new $tmpdir, $raw; PublicInbox::Watch->new($cfg)->scan('full'); $ibx = $cfg->lookup_name('test'); my $num = $ibx->mm->num_for('do.want@example.com'); ok(defined $num, 'List-ID matched for watch'); $num = $ibx->mm->num_for('do.not.want@example.com'); is($num, undef, 'unaccepted List-ID matched for watch'); - - $raw = $orig."$cfgpfx.watchheader=X-Mailing-List:no\@example.com\n"; - $cfg = PublicInbox::Config->new(\$raw); + $raw .= "\twatchheader = X-Mailing-List:no\@example.com\n"; + $cfg = cfg_new $tmpdir, $raw; PublicInbox::Watch->new($cfg)->scan('full'); $ibx = $cfg->lookup_name('test'); $num = $ibx->mm->num_for('do.not.want@example.com'); diff --git a/t/watch_mh.t b/t/watch_mh.t new file mode 100644 index 00000000..04793750 --- /dev/null +++ b/t/watch_mh.t @@ -0,0 +1,120 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use v5.12; +use PublicInbox::Eml; +use PublicInbox::TestCommon; +use PublicInbox::Import; +use PublicInbox::IO qw(write_file); +use POSIX qw(mkfifo); +use File::Copy qw(cp); +use autodie qw(rename mkdir); + +my $tmpdir = tmpdir; +my $git_dir = "$tmpdir/test.git"; +my $mh = "$tmpdir/mh"; +my $spamdir = "$tmpdir/mh-spam"; +mkdir $_ for ($mh, $spamdir); +use_ok 'PublicInbox::Watch'; +my $addr = 'test-public@example.com'; +my $default_branch = PublicInbox::Import::default_branch; +PublicInbox::Import::init_bare($git_dir); +my $msg = <<EOF; +From: user\@example.com +To: $addr +Subject: spam +Message-ID: <a\@b.com> +Date: Sat, 18 Jun 2016 00:00:00 +0000 + +something +EOF + +cp 't/plack-qp.eml', "$mh/1"; +mkfifo("$mh/5", 0777) or xbail "mkfifo: $!"; # FIFO to ensure no stuckage +my $cfg = cfg_new $tmpdir, <<EOF; +[publicinbox "test"] + address = $addr + inboxdir = $git_dir + watch = mh:$mh +[publicinboxlearn] + watchspam = mh:$spamdir +EOF +PublicInbox::Watch->new($cfg)->scan('full'); +my $git = PublicInbox::Git->new($git_dir); +{ + my @list = $git->qx('rev-list', $default_branch); + is(scalar @list, 1, 'one revision in rev-list'); + $git->cleanup; +} + +# end-to-end test which actually uses inotify/kevent +{ + my $env = { PI_CONFIG => $cfg->{-f} }; + # n.b. --no-scan is only intended for testing atm + my $wm = start_script([qw(-watch --no-scan)], $env); + no_pollerfd($wm->{pid}); + + my $eml = eml_load 't/data/binary.patch'; + $eml->header_set('Cc', $addr); + write_file '>', "$mh/2.tmp", $eml->as_string; + + use_ok 'PublicInbox::InboxIdle'; + use_ok 'PublicInbox::DS'; + my $delivered = 0; + my $cb = sub { + my ($ibx) = @_; + diag "message delivered to `$ibx->{name}'"; + $delivered++; + }; + PublicInbox::DS->Reset; + my $ii = PublicInbox::InboxIdle->new($cfg); + my $obj = bless \$cb, 'PublicInbox::TestCommon::InboxWakeup'; + $cfg->each_inbox(sub { $_[0]->subscribe_unlock('ident', $obj) }); + local @PublicInbox::DS::post_loop_do = (sub { $delivered == 0 }); + + # wait for -watch to setup inotify watches + my $sleep = 1; + if (eval { require PublicInbox::Inotify } && -d "/proc/$wm->{pid}/fd") { + my $end = time + 2; + my (@ino, @ino_info); + do { + @ino = grep { + (readlink($_)//'') =~ /\binotify\b/ + } glob("/proc/$wm->{pid}/fd/*"); + } until (@ino || time > $end || !tick); + if (scalar(@ino) == 1) { + my $ino_fd = (split(m'/', $ino[0]))[-1]; + my $ino_fdinfo = "/proc/$wm->{pid}/fdinfo/$ino_fd"; + while (time < $end && open(my $fh, '<', $ino_fdinfo)) { + @ino_info = grep(/^inotify wd:/, <$fh>); + last if @ino_info >= 2; + tick; + } + $sleep = undef if @ino_info >= 2; + } + } + if ($sleep) { + diag "waiting ${sleep}s for -watch to start up"; + sleep $sleep; + } + rename "$mh/2.tmp", "$mh/2"; + diag 'waiting for -watch to import new message'; + PublicInbox::DS::event_loop(); + + my $subj = $eml->header_raw('Subject'); + my $head = $git->qx(qw(cat-file commit HEAD)); + like $head, qr/^\Q$subj\E/sm, 'new commit made'; + + $wm->kill; + $wm->join; + $ii->close; + PublicInbox::DS->Reset; +} + +my $is_mh = sub { PublicInbox::Watch::is_mh(my $val = shift) }; + +is $is_mh->('mh:/hello//world'), '/hello/world', 'extra slash gone'; +is $is_mh->('MH:/hello/world/'), '/hello/world', 'trailing slash gone'; +is $is_mh->('maildir:/hello/world/'), undef, 'non-MH rejected'; + +done_testing; diff --git a/t/watch_multiple_headers.t b/t/watch_multiple_headers.t index 33ed0770..9585da2b 100644 --- a/t/watch_multiple_headers.t +++ b/t/watch_multiple_headers.t @@ -1,11 +1,9 @@ -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use Test::More; -use PublicInbox::Config; +use v5.12; use PublicInbox::TestCommon; require_git(2.6); -require_mods(qw(Search::Xapian DBD::SQLite)); +require_mods(qw(Xapian DBD::SQLite)); my ($tmpdir, $for_destroy) = tmpdir(); my $inboxdir = "$tmpdir/v2"; my $maildir = "$tmpdir/md"; @@ -54,14 +52,15 @@ PublicInbox::Emergency->new($maildir)->prepare(\$msg_to); PublicInbox::Emergency->new($maildir)->prepare(\$msg_cc); PublicInbox::Emergency->new($maildir)->prepare(\$msg_none); -my $raw = <<EOF; -$cfgpfx.address=$addr -$cfgpfx.inboxdir=$inboxdir -$cfgpfx.watch=maildir:$maildir -$cfgpfx.watchheader=To:$addr -$cfgpfx.watchheader=Cc:$addr +my $cfg = cfg_new $tmpdir, <<EOF; +[publicinbox "test"] + address = $addr + inboxdir = $inboxdir + watch = maildir:$maildir + watchheader = To:$addr + watchheader = Cc:$addr EOF -my $cfg = PublicInbox::Config->new(\$raw); + PublicInbox::Watch->new($cfg)->scan('full'); my $ibx = $cfg->lookup_name('test'); ok($ibx, 'found inbox by name'); diff --git a/t/www_altid.t b/t/www_altid.t index 94a2e807..de1e6ed6 100644 --- a/t/www_altid.t +++ b/t/www_altid.t @@ -1,5 +1,5 @@ #!perl -w -# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use PublicInbox::TestCommon; use PublicInbox::Config; @@ -59,14 +59,7 @@ my $client = sub { }; test_psgi(sub { $www->call(@_) }, $client); SKIP: { - require_mods(qw(Plack::Test::ExternalServer), 4); - my $env = { PI_CONFIG => $cfgpath }; - my $sock = tcp_server() or die; - my ($out, $err) = map { "$tmpdir/std$_.log" } qw(out err); - my $cmd = [ qw(-httpd -W0), "--stdout=$out", "--stderr=$err" ]; - my $td = start_script($cmd, $env, { 3 => $sock }); - my ($h, $p) = tcp_host_port($sock); - local $ENV{PLACK_TEST_EXTERNALSERVER_URI} = "http://$h:$p"; - Plack::Test::ExternalServer::test_psgi(client => $client); + my $env = { PI_CONFIG => $cfgpath, TMPDIR => $tmpdir }; + test_httpd($env, $client); } done_testing; diff --git a/t/www_listing.t b/t/www_listing.t index c556a2d7..0a4c79e8 100644 --- a/t/www_listing.t +++ b/t/www_listing.t @@ -1,11 +1,12 @@ #!perl -w -# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> # manifest.js.gz generation and grok-pull integration test -use strict; use v5.10.1; use PublicInbox::TestCommon; +use v5.12; use PublicInbox::TestCommon; use PublicInbox::Import; use IO::Uncompress::Gunzip qw(gunzip); -require_mods(qw(json URI::Escape Plack::Builder Digest::SHA HTTP::Tiny)); +require_mods(qw(json URI::Escape Plack::Builder HTTP::Tiny)); +require_cmd 'curl'; require PublicInbox::WwwListing; require PublicInbox::ManifestJsGz; use PublicInbox::Config; @@ -76,6 +77,7 @@ sub tiny_test { my $td; SKIP: { + require_git_http_backend 1; my $err = "$tmpdir/stderr.log"; my $out = "$tmpdir/stdout.log"; my $alt = "$tmpdir/alt.git"; @@ -91,6 +93,10 @@ SKIP: { 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, '>', "$v2/description") or xbail "open $v2/description: $!"; + print $fh "a v2 inbox\n" or xbail "print $!"; + close $fh or xbail "write: $v2/description $!"; + open $fh, '>', "$alt/description" or xbail "open $alt/description $!"; print $fh "we're \xc4\x80ll clones\n" or xbail "print $!"; close $fh or xbail "write: $alt/description $!"; @@ -115,10 +121,71 @@ SKIP: { my $env = { PI_CONFIG => $cfgfile }; my $cmd = [ '-httpd', '-W0', "--stdout=$out", "--stderr=$err" ]; + my $psgi = "$tmpdir/pfx.psgi"; + { + open my $psgi_fh, '>', $psgi or xbail "open: $!"; + print $psgi_fh <<'EOM' or xbail "print $!"; +use PublicInbox::WWW; +use Plack::Builder; +my $www = PublicInbox::WWW->new; +builder { + enable 'Head'; + mount '/pfx/' => sub { $www->call(@_) } +} +EOM + close $psgi_fh or xbail "close: $!"; + } + + # ensure prefixed mount full clones work: + $td = start_script([@$cmd, $psgi], $env, { 3 => $sock }); + my $opt = { 2 => \(my $clone_err = '') }; + ok(run_script(['-clone', "http://$host:$port/pfx", "$tmpdir/pfx" ], + undef, $opt), 'pfx clone w/pfx') or diag "clone_err=$clone_err"; + + open my $mh, '<', "$tmpdir/pfx/manifest.js.gz" or xbail "open: $!"; + gunzip(\(do { local $/; <$mh> }) => \(my $mjs = '')); + my $mf = $json->decode($mjs); + is_deeply([sort keys %$mf], [ qw(/alt /bare /v2/git/0.git + /v2/git/1.git /v2/git/2.git) ], + 'manifest saved'); + for (keys %$mf) { ok(-d "$tmpdir/pfx$_", "pfx/$_ cloned") } + open my $desc, '<', "$tmpdir/pfx/v2/description" or xbail "open: $!"; + $desc = <$desc>; + is($desc, "a v2 inbox\n", 'v2 description retrieved'); + + $clone_err = ''; + ok(run_script(['-clone', '--include=*/alt', + "http://$host:$port/pfx", "$tmpdir/incl" ], + undef, $opt), 'clone w/include') or diag "clone_err=$clone_err"; + ok(-d "$tmpdir/incl/alt", 'alt cloned'); + ok(!-d "$tmpdir/incl/v2" && !-d "$tmpdir/incl/bare", 'only alt cloned'); + is(xqx([qw(git config -f), "$tmpdir/incl/alt/config", 'gitweb.owner']), + "lorelei \xc4\x80\n", 'gitweb.owner set by -clone'); + + $clone_err = ''; + ok(run_script(['-clone', '--dry-run', + "http://$host:$port/pfx", "$tmpdir/dry-run" ], + undef, $opt), 'clone --dry-run') or diag "clone_err=$clone_err"; + ok(!-d "$tmpdir/dry-run", 'nothing cloned with --dry-run'); + + undef $td; + + open $mh, '<', "$tmpdir/incl/manifest.js.gz" or xbail "open: $!"; + gunzip(\(do { local $/; <$mh> }) => \($mjs = '')); + $mf = $json->decode($mjs); + is_deeply([keys %$mf], [ '/alt' ], 'excluded keys skipped in manifest'); + $td = start_script($cmd, $env, { 3 => $sock }); # default publicinboxGrokManifest match=domain default tiny_test($json, $host, $port); + + # normal full clone on / + $clone_err = ''; + ok(run_script(['-clone', "http://$host:$port/", "$tmpdir/full" ], + undef, $opt), 'full clone') or diag "clone_err=$clone_err"; + ok(-d "$tmpdir/full/$_", "$_ cloned") for qw(alt v2 bare); + undef $td; print $fh <<"" or xbail "print $!"; @@ -127,9 +194,11 @@ SKIP: { close $fh or xbail "close $!"; $td = start_script($cmd, $env, { 3 => $sock }); - tiny_test($json, $host, $port, 1); undef $sock; + tiny_test($json, $host, $port, 1); + # grok-pull sleeps a long while some places: + # https://lore.kernel.org/tools/20211013110344.GA10632@dcvr/ skip 'TEST_GROK unset', 12 unless $ENV{TEST_GROK}; my $grok_pull = require_cmd('grok-pull', 1) or skip('grok-pull not available', 12); diff --git a/t/xap_helper.t b/t/xap_helper.t new file mode 100644 index 00000000..78be8539 --- /dev/null +++ b/t/xap_helper.t @@ -0,0 +1,287 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use v5.12; +use PublicInbox::TestCommon; +require_mods(qw(DBD::SQLite Xapian +SCM_RIGHTS)); # TODO: FIFO support? +use PublicInbox::Spawn qw(spawn); +use Socket qw(AF_UNIX SOCK_SEQPACKET SOCK_STREAM); +require PublicInbox::AutoReap; +use PublicInbox::IPC; +require PublicInbox::XapClient; +use PublicInbox::DS qw(now); +use autodie; +my ($tmp, $for_destroy) = tmpdir(); + +my $fi_data = './t/git.fast-import-data'; +open my $fi_fh, '<', $fi_data; +open my $dh, '<', '.'; +my $crepo = create_coderepo 'for-cindex', sub { + my ($d) = @_; + xsys_e([qw(git init -q --bare)]); + xsys_e([qw(git fast-import --quiet)], undef, { 0 => $fi_fh }); + chdir($dh); + run_script([qw(-cindex --dangerous -L medium --no-fsync -q -j1), '-g', $d]) + or xbail '-cindex internal'; + run_script([qw(-cindex --dangerous -L medium --no-fsync -q -j3 -d), + "$d/cidx-ext", '-g', $d]) or xbail '-cindex "external"'; +}; +$dh = $fi_fh = undef; + +my $v2 = create_inbox 'v2', indexlevel => 'medium', version => 2, + tmpdir => "$tmp/v2", sub { + my ($im) = @_; + for my $f (qw(t/data/0001.patch t/data/binary.patch + t/data/message_embed.eml + t/solve/0001-simple-mod.patch + t/solve/0002-rename-with-modifications.patch + t/solve/bare.patch)) { + $im->add(eml_load($f)) or BAIL_OUT; + } +}; + +my @ibx_idx = glob("$v2->{inboxdir}/xap*/?"); +my @ibx_shard_args = map { ('-d', $_) } @ibx_idx; +my (@int) = glob("$crepo/public-inbox-cindex/cidx*/?"); +my (@ext) = glob("$crepo/cidx-ext/cidx*/?"); +is(scalar(@ext), 2, 'have 2 external shards') or diag explain(\@ext); +is(scalar(@int), 1, 'have 1 internal shard') or diag explain(\@int); + +my $doreq = sub { + my ($s, @arg) = @_; + my $err = ref($arg[-1]) ? pop(@arg) : \*STDERR; + pipe(my $x, my $y); + my $buf = join("\0", @arg, ''); + my @fds = (fileno($y), fileno($err)); + my $n = $PublicInbox::IPC::send_cmd->($s, \@fds, $buf, 0) // + xbail "send: $!"; + my $exp = length($buf); + $exp == $n or xbail "req @arg sent short ($n != $exp)"; + $x; +}; + +local $SIG{PIPE} = 'IGNORE'; +my $env = { PERL5LIB => join(':', @INC) }; +my $test = sub { + my (@cmd) = @_; + socketpair(my $s, my $y, AF_UNIX, SOCK_SEQPACKET, 0); + my $pid = spawn(\@cmd, $env, { 0 => $y }); + my $ar = PublicInbox::AutoReap->new($pid); + diag "$cmd[-1] running pid=$pid"; + close $y; + my $r = $doreq->($s, qw(test_inspect -d), $ibx_idx[0]); + my %info = map { split(/=/, $_, 2) } split(/ /, do { local $/; <$r> }); + is($info{has_threadid}, '1', 'has_threadid true for inbox'); + like($info{pid}, qr/\A\d+\z/, 'got PID from inbox inspect'); + + $r = $doreq->($s, qw(test_inspect -d), $int[0]); + my %cinfo = map { split(/=/, $_, 2) } split(/ /, do { local $/; <$r> }); + is($cinfo{has_threadid}, '0', 'has_threadid false for cindex'); + is($cinfo{pid}, $info{pid}, 'PID unchanged for cindex'); + + my @dump = (qw(dump_ibx -A XDFID), @ibx_shard_args, qw(13 rt:0..)); + $r = $doreq->($s, @dump); + my @res; + while (sysread($r, my $buf, 512) != 0) { push @res, $buf } + is(grep(/\n\z/s, @res), scalar(@res), 'line buffered'); + + pipe(my $err_rd, my $err_wr); + $r = $doreq->($s, @dump, $err_wr); + close $err_wr; + my $res = do { local $/; <$r> }; + is(join('', @res), $res, 'got identical response w/ error pipe'); + my $stats = do { local $/; <$err_rd> }; + is($stats, "mset.size=6 nr_out=6\n", 'mset.size reported') or + diag "res=$res"; + + return wantarray ? ($ar, $s) : $ar if $cinfo{pid} == $pid; + + # test worker management: + kill('TERM', $cinfo{pid}); + my $tries = 0; + do { + $r = $doreq->($s, qw(test_inspect -d), $ibx_idx[0]); + %info = map { split(/=/, $_, 2) } + split(/ /, do { local $/; <$r> }); + } while ($info{pid} == $cinfo{pid} && ++$tries < 10); + isnt($info{pid}, $cinfo{pid}, 'spawned new worker'); + + my %pids; + $tries = 0; + my @ins = ($s, qw(test_inspect -d), $ibx_idx[0]); + kill('TTIN', $pid); + until (scalar(keys %pids) >= 2 || ++$tries > 100) { + tick; + my @r = map { $doreq->(@ins) } (0..100); + for my $fh (@r) { + my $buf = do { local $/; <$fh> } // die "read: $!"; + $buf =~ /\bpid=(\d+)/ and $pids{$1} = undef; + } + } + is(scalar keys %pids, 2, 'have two pids') or + diag 'pids='.explain(\%pids); + + kill('TTOU', $pid); + %pids = (); + my $delay = $tries * 0.11 * ($ENV{VALGRIND} ? 10 : 1); + $tries = 0; + diag 'waiting '.$delay.'s for SIGTTOU'; + tick($delay); + until (scalar(keys %pids) == 1 || ++$tries > 100) { + %pids = (); + my @r = map { $doreq->(@ins) } (0..100); + for my $fh (@r) { + my $buf = do { local $/; <$fh> } // die "read: $!"; + $buf =~ /\bpid=(\d+)/ and $pids{$1} = undef; + } + } + is(scalar keys %pids, 1, 'have one pid') or diag explain(\%pids); + is($info{pid}, (keys %pids)[0], 'kept oldest PID after TTOU'); + + wantarray ? ($ar, $s) : $ar; +}; + +my @NO_CXX = (1); +unless ($ENV{TEST_XH_CXX_ONLY}) { + my $ar = $test->($^X, qw[-w -MPublicInbox::XapHelper -e + PublicInbox::XapHelper::start('-j0')]); + ($ar, my $s) = $test->($^X, qw[-w -MPublicInbox::XapHelper -e + PublicInbox::XapHelper::start('-j1')]); + no_pollerfd($ar->{pid}); +} +SKIP: { + my $cmd = eval { + require PublicInbox::XapHelperCxx; + PublicInbox::XapHelperCxx::cmd(); + }; + skip "XapHelperCxx build: $@", 1 if $@; + + @NO_CXX = $ENV{TEST_XH_CXX_ONLY} ? (0) : (0, 1); + my $ar = $test->(@$cmd, '-j0'); + $ar = $test->(@$cmd, '-j1'); +}; + +require PublicInbox::CodeSearch; +my $cs_int = PublicInbox::CodeSearch->new("$crepo/public-inbox-cindex"); +my $root2id_file = "$tmp/root2id"; +my @id2root; +{ + open my $fh, '>', $root2id_file; + my $i = -1; + for ($cs_int->all_terms('G')) { + print $fh $_, "\0", ++$i, "\0"; + $id2root[$i] = $_; + } + close $fh; +} + +my $ar; +for my $n (@NO_CXX) { + local $ENV{PI_NO_CXX} = $n; + my $xhc = PublicInbox::XapClient::start_helper('-j0'); + pipe(my $err_r, my $err_w); + + # git patch-id --stable <t/data/0001.patch | awk '{print $1}' + my $dfid = '91ee6b761fc7f47cad9f2b09b10489f313eb5b71'; + my $mid = '20180720072141.GA15957@example'; + my $r = $xhc->mkreq([ undef, $err_w ], qw(dump_ibx -A XDFID -A Q), + (map { ('-d', $_) } @ibx_idx), + 9, "mid:$mid"); + close $err_w; + my $res = do { local $/; <$r> }; + is($res, "$dfid 9\n$mid 9\n", "got expected result ($xhc->{impl})"); + my $err = do { local $/; <$err_r> }; + is($err, "mset.size=1 nr_out=2\n", "got expected status ($xhc->{impl})"); + + pipe($err_r, $err_w); + $r = $xhc->mkreq([ undef, $err_w ], qw(dump_roots -c -A XDFID), + (map { ('-d', $_) } @int), + $root2id_file, 'dt:19700101'.'000000..'); + close $err_w; + my @res = <$r>; + is(scalar(@res), 5, 'got expected rows'); + is(scalar(@res), scalar(grep(/\A[0-9a-f]{40,} [0-9]+\n\z/, @res)), + 'entries match format'); + $err = do { local $/; <$err_r> }; + is $err, "mset.size=6 nr_out=5\n", "got expected status ($xhc->{impl})"; + + $r = $xhc->mkreq([], qw(mset), @ibx_shard_args, + 'dfn:lib/PublicInbox/Search.pm'); + chomp((my $hdr, @res) = readline($r)); + like $hdr, qr/\bmset\.size=1\b/, + "got expected header via mset ($xhc->{impl}"; + is scalar(@res), 1, 'got one result'; + @res = split /\0/, $res[0]; + { + my $doc = $v2->search->xdb->get_document($res[0]); + ok $doc, 'valid document retrieved'; + my @q = PublicInbox::Search::xap_terms('Q', $doc); + is_deeply \@q, [ $mid ], 'docid usable'; + } + ok $res[1] > 0 && $res[1] <= 100, 'pct > 0 && <= 100'; + is scalar(@res), 3, 'only 3 columns in result'; + + $r = $xhc->mkreq([], qw(mset), @ibx_shard_args, + 'dt:19700101'.'000000..'); + chomp(($hdr, @res) = readline($r)); + like $hdr, qr/\bmset\.size=6\b/, + "got expected header via multi-result mset ($xhc->{impl}"; + is(scalar(@res), 6, 'got 6 rows'); + for my $r (@res) { + my ($docid, $pct, $rank, @rest) = split /\0/, $r; + my $doc = $v2->search->xdb->get_document($docid); + ok $pct > 0 && $pct <= 100, + "pct > 0 && <= 100 #$docid ($xhc->{impl})"; + like $rank, qr/\A\d+\z/, 'rank is a digit'; + is scalar(@rest), 0, 'no extra rows returned'; + } + my $nr; + for my $i (7, 8, 39, 40) { + pipe($err_r, $err_w); + $r = $xhc->mkreq([ undef, $err_w ], qw(dump_roots -c -A), + "XDFPOST$i", (map { ('-d', $_) } @int), + $root2id_file, 'dt:19700101'.'000000..'); + close $err_w; + @res = <$r>; + my @err = <$err_r>; + if (defined $nr) { + is scalar(@res), $nr, + "got expected results ($xhc->{impl})"; + } else { + $nr //= scalar @res; + ok $nr, "got initial results ($xhc->{impl})"; + } + my @oids = (join('', @res) =~ /^([a-f0-9]+) /gms); + is_deeply [grep { length == $i } @oids], \@oids, + "all OIDs match expected length ($xhc->{impl})"; + my ($nr_out) = ("@err" =~ /nr_out=(\d+)/); + is $nr_out, scalar(@oids), "output count matches $xhc->{impl}" + or diag explain(\@res, \@err); + } + pipe($err_r, $err_w); + $r = $xhc->mkreq([ undef, $err_w ], qw(dump_ibx -A XDFPOST7), + @ibx_shard_args, qw(13 rt:0..)); + close $err_w; + @res = <$r>; + my @err = <$err_r>; + my ($nr_out) = ("@err" =~ /nr_out=(\d+)/); + my @oids = (join('', @res) =~ /^([a-f0-9]{7}) /gms); + is $nr_out, scalar(@oids), "output count matches $xhc->{impl}" or + diag explain(\@res, \@err); + + if ($ENV{TEST_XH_TIMEOUT}) { + diag 'testing timeouts...'; + for my $j (qw(0 1)) { + my $t0 = now; + $r = $xhc->mkreq(undef, qw(test_sleep -K 1 -d), + $ibx_idx[0]); + is readline($r), undef, 'got EOF'; + my $diff = now - $t0; + ok $diff < 3, "timeout didn't take too long -j$j"; + ok $diff >= 0.9, "timeout didn't fire prematurely -j$j"; + $xhc = PublicInbox::XapClient::start_helper('-j1'); + } + } +} + +done_testing; diff --git a/t/xcpdb-reshard.t b/t/xcpdb-reshard.t index 8516b907..7797aaaf 100644 --- a/t/xcpdb-reshard.t +++ b/t/xcpdb-reshard.t @@ -4,7 +4,7 @@ use strict; use v5.10.1; use PublicInbox::TestCommon; -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(DBD::SQLite Xapian)); require_git('2.6'); use PublicInbox::Eml; require PublicInbox::Search; @@ -43,7 +43,7 @@ my $XapianDatabase = do { for my $R (qw(2 4 1 3 3)) { delete $ibx->{search}; # release old handles my $cmd = [@xcpdb, "-R$R", $ibx->{inboxdir}]; - push @$cmd, '--compact' if $R == 1 && have_xapian_compact; + push @$cmd, '--compact' if $R == 1 && have_xapian_compact(1); ok(run_script($cmd, $env), "xcpdb -R$R"); my @new_shards = grep(m!/\d+\z!, glob("$ibx->{inboxdir}/xap*/*")); is(scalar(@new_shards), $R, 'resharded to two shards'); |