diff options
Diffstat (limited to 't')
168 files changed, 9218 insertions, 2780 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,18 +1,40 @@ -# Copyright (C) 2019-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::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 = "$tmpdir/v1"; -my $v2_dir = "$tmpdir/v2"; +my $git_dir = $v1->{inboxdir}; my ($res, $err, $v); +my $v2ibx; +SKIP: { + require_mods(qw(DBD::SQLite), 5); + require_git(2.6, 5); + $v2ibx = create_inbox 'v2', indexlevel => 'basic', version => 2, + -no_gc => 1, sub { + my ($v2w, $ibx) = @_; + $v2w->idx_init; + $v2w->importer; + }; +}; -PublicInbox::Import::init_bare($git_dir); *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'); @@ -51,22 +73,8 @@ SKIP: { } # v2 -SKIP: { - for my $m (qw(DBD::SQLite)) { - skip "$m missing", 5 unless eval "require $m"; - } - use_ok 'PublicInbox::V2Writable'; - use_ok 'PublicInbox::Inbox'; - my $ibx = PublicInbox::Inbox->new({ - inboxdir => $v2_dir, - name => 'test-v2writable', - version => 2, - -primary_address => 'test@example.com', - indexlevel => 'basic', - }); - PublicInbox::V2Writable->new($ibx, 1)->idx_init; - - ok(-e "$v2_dir/inbox.lock", 'exists'); +if ($v2ibx) { + my $v2_dir = $v2ibx->{inboxdir}; is(resolve_inboxdir($v2_dir), $v2_dir, 'resolve_inboxdir works on v2_dir'); chdir($v2_dir) or BAIL_OUT "chdir v2_dir: $!"; @@ -76,7 +84,6 @@ SKIP: { is($res, $v2_dir, 'detects directory along with version'); # TODO: should work from inside Xapian dirs, and git dirs, here... - PublicInbox::Import::init_bare("$v2_dir/git/0.git"); my $objdir = "$v2_dir/git/0.git/objects"; is($v2_dir, resolve_inboxdir($objdir, \$v), 'at $objdir'); is($v, 2, 'version 2 detected at $objdir'); diff --git a/t/alt.psgi b/t/alt.psgi new file mode 100644 index 00000000..c7f42979 --- /dev/null +++ b/t/alt.psgi @@ -0,0 +1,17 @@ +# 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 warnings; +use Plack::Builder; +my $pi_config = $ENV{PI_CONFIG} // 'unset'; # capture ASAP +my $app = sub { + my ($env) = @_; + $env->{'psgi.errors'}->print("ALT\n"); + [ 200, ['Content-Type', 'text/plain'], [ $pi_config ] ] +}; + +builder { + enable 'ContentLength'; + enable 'Head'; + $app; +} @@ -1,15 +1,13 @@ +#!perl -w # Copyright (C) 2016-2021 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::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'; -use_ok 'PublicInbox::Import'; -use_ok 'PublicInbox::Inbox'; my ($tmpdir, $for_destroy) = tmpdir(); my $git_dir = "$tmpdir/a.git"; my $alt_file = "$tmpdir/another-nntp.sqlite3"; @@ -17,17 +15,16 @@ my $altid = [ "serial:gmane:file=$alt_file" ]; my $ibx; { - my $mm = PublicInbox::Msgmap->new_file($alt_file, 1); + my $mm = PublicInbox::Msgmap->new_file($alt_file, 2); is($mm->mid_set(1234, 'a@example.com'), 1, 'mid_set once OK'); 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'); } { - my $git = PublicInbox::Git->new($git_dir); - my $im = PublicInbox::Import->new($git, 'testbox', 'test@example'); - $im->init_bare; - $im->add(PublicInbox::Eml->new(<<'EOF')); + $ibx = create_inbox 'testbox', tmpdir => $git_dir, sub { + my ($im) = @_; + $im->add(PublicInbox::Eml->new(<<'EOF')); From: a@example.com To: b@example.com Subject: boo! @@ -35,13 +32,9 @@ Message-ID: <a@example.com> hello world gmane:666 EOF - $im->done; -} -{ - $ibx = PublicInbox::Inbox->new({inboxdir => $git_dir}); + }; $ibx->{altid} = $altid; - my $rw = PublicInbox::SearchIdx->new($ibx, 1); - $rw->index_sync; + PublicInbox::SearchIdx->new($ibx, 1)->index_sync; } { @@ -55,12 +48,9 @@ EOF }; { - my $mm = PublicInbox::Msgmap->new_file($alt_file, 1); + my $mm = PublicInbox::Msgmap->new_file($alt_file, 2); my ($min, $max) = $mm->minmax; my $num = $mm->mid_insert('b@example.com'); ok($num > $max, 'auto-increment goes beyond mid_set'); } - -done_testing(); - -1; +done_testing; diff --git a/t/altid_v2.t b/t/altid_v2.t index c6295b2f..6bc90453 100644 --- a/t/altid_v2.t +++ b/t/altid_v2.t @@ -1,37 +1,23 @@ +#!perl -w # Copyright (C) 2016-2021 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::Eml; +use v5.10.1; use PublicInbox::TestCommon; +use PublicInbox::Eml; require_git(2.6); -require_mods(qw(DBD::SQLite Search::Xapian)); -use_ok 'PublicInbox::V2Writable'; -use_ok 'PublicInbox::Inbox'; -my ($tmpdir, $for_destroy) = tmpdir(); -my $inboxdir = "$tmpdir/inbox"; -my $full = "$tmpdir/inbox/another-nntp.sqlite3"; -my $altid = [ 'serial:gmane:file=another-nntp.sqlite3' ]; - -{ - ok(mkdir($inboxdir), 'created repo for msgmap'); - my $mm = PublicInbox::Msgmap->new_file($full, 1); - is($mm->mid_set(1234, 'a@example.com'), 1, 'mid_set once OK'); - 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'); -} - -my $ibx = { - inboxdir => $inboxdir, - name => 'test-v2writable', - version => 2, - -primary_address => 'test@example.com', - altid => $altid, -}; -$ibx = PublicInbox::Inbox->new($ibx); -my $v2w = PublicInbox::V2Writable->new($ibx, 1); -$v2w->add(PublicInbox::Eml->new(<<'EOF')); +require_mods(qw(DBD::SQLite Xapian)); +require PublicInbox::Msgmap; +my $another = 'another-nntp.sqlite3'; +my $altid = [ "serial:gmane:file=$another" ]; +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); + 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 Subject: boo! @@ -39,9 +25,11 @@ Message-ID: <a@example.com> hello world gmane:666 EOF -$v2w->done; - -my $mset = $ibx->search->reopen->mset('gmane:1234'); +}; +my $mm = PublicInbox::Msgmap->new_file("$ibx->{inboxdir}/$another", 2); +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 ]; is_deeply($msgs, ['a@example.com'], 'got one match'); @@ -49,5 +37,3 @@ $mset = $ibx->search->mset('gmane:666'); is($mset->size, 0, 'body did NOT match'); done_testing(); - -1; @@ -5,61 +5,34 @@ use strict; use v5.10.1; use PublicInbox::TestCommon; use IO::Uncompress::Gunzip qw(gunzip); -require_mods(qw(Plack::Handler::CGI Plack::Util)); -require PublicInbox::Eml; -require PublicInbox::Import; -require PublicInbox::Inbox; -require PublicInbox::InboxWritable; -require PublicInbox::Config; +use PublicInbox::Eml; +use IO::Handle; my ($tmpdir, $for_destroy) = tmpdir(); -my $home = "$tmpdir/pi-home"; -my $pi_home = "$home/.public-inbox"; -my $pi_config = "$pi_home/config"; -my $maindir = "$tmpdir/main.git"; -my $addr = 'test-public@example.com'; -PublicInbox::Import::init_bare($maindir); -{ - mkdir($home, 0755) or BAIL_OUT $!; - mkdir($pi_home, 0755) or BAIL_OUT $!; - open my $fh, '>>', $pi_config or BAIL_OUT $!; - print $fh <<EOF or BAIL_OUT $!; -[publicinbox "test"] - address = $addr - inboxdir = $maindir - indexlevel = basic -EOF - close $fh or BAIL_OUT $!; -} - -my $cfg = PublicInbox::Config->new($pi_config); -my $ibx = $cfg->lookup_name('test'); -my $im = PublicInbox::InboxWritable->new($ibx)->importer(0); - -{ - local $ENV{HOME} = $home; - - # inject some messages: - my $mime = PublicInbox::Eml->new(<<EOF); +require_mods(qw(Plack::Handler::CGI Plack::Util)); +my $slashy_mid = 'slashy/asdf@example.com'; +my $ibx = create_inbox 'test', tmpdir => "$tmpdir/test", sub { + my ($im, $ibx) = @_; + mkdir "$ibx->{inboxdir}/home", 0755 or BAIL_OUT; + mkdir "$ibx->{inboxdir}/home/.public-inbox", 0755 or BAIL_OUT; + my $eml = PublicInbox::Eml->new(<<EOF); From: Me <me\@example.com> To: You <you\@example.com> -Cc: $addr +Cc: $ibx->{-primary_address} Message-Id: <blah\@example.com> Subject: hihi Date: Thu, 01 Jan 1970 00:00:00 +0000 zzzzzz EOF - ok($im->add($mime), 'added initial message'); - - $mime->header_set('Message-ID', '<toobig@example.com>'); - $mime->body_set("z\n" x 1024); - ok($im->add($mime), 'added big message'); + $im->add($eml) or BAIL_OUT; + $eml->header_set('Message-ID', '<toobig@example.com>'); + $eml->body_set("z\n" x 1024); + $im->add($eml) or BAIL_OUT; - # deliver a reply, too - $mime = PublicInbox::Eml->new(<<EOF); + $eml = PublicInbox::Eml->new(<<EOF); From: You <you\@example.com> To: Me <me\@example.com> -Cc: $addr +Cc: $ibx->{-primary_address} In-Reply-To: <blah\@example.com> Message-Id: <blahblah\@example.com> Subject: Re: hihi @@ -70,22 +43,31 @@ Me wrote: what? EOF - ok($im->add($mime), 'added reply'); - - my $slashy_mid = 'slashy/asdf@example.com'; - my $slashy = PublicInbox::Eml->new(<<EOF); + $im->add($eml) or BAIL_OUT; + $eml = PublicInbox::Eml->new(<<EOF); From: You <you\@example.com> To: Me <me\@example.com> -Cc: $addr +Cc: $ibx->{-primary_address} Message-Id: <$slashy_mid> Subject: Re: hihi Date: Thu, 01 Jan 1970 00:00:01 +0000 slashy EOF - ok($im->add($slashy), 'added slash'); - $im->done; + $im->add($eml) or BAIL_OUT; +}; # create_inbox +my $home = "$ibx->{inboxdir}/home"; +open my $cfgfh, '>>', "$home/.public-inbox/config" or BAIL_OUT $!; +print $cfgfh <<EOF or BAIL_OUT $!; +[publicinbox "test"] + address = $ibx->{-primary_address} + inboxdir = $ibx->{inboxdir} +EOF +$cfgfh->flush or BAIL_OUT $!; + +{ + local $ENV{HOME} = $home; my $res = cgi_run("/test/slashy/asdf\@example.com/raw"); like($res->{body}, qr/Message-Id: <\Q$slashy_mid\E>/, "slashy mid raw hit"); @@ -98,6 +80,8 @@ SKIP: { my $res = cgi_run($path); like($res->{head}, qr/^Status: 501 /, "search not-yet-enabled"); my $cmd = ['-index', $ibx->{inboxdir}, '--max-size=2k']; + print $cfgfh "\tindexlevel = basic\n" or BAIL_OUT $!; + $cfgfh->flush or BAIL_OUT $!; my $opt = { 2 => \(my $err) }; my $indexed = run_script($cmd, undef, $opt); if ($indexed) { diff --git a/t/check-www-inbox.perl b/t/check-www-inbox.perl index eee8adc2..46f9ce1e 100644 --- a/t/check-www-inbox.perl +++ b/t/check-www-inbox.perl @@ -91,7 +91,7 @@ foreach my $p (1..$nproc) { } } -my ($fh, $tmp) = tempfile('www-check-XXXXXXXX', +my ($fh, $tmp) = tempfile('www-check-XXXX', SUFFIX => '.gdbm', UNLINK => 1, TMPDIR => 1); my $gdbm = tie my %seen, 'GDBM_File', $tmp, &GDBM_WRCREAT, 0600; defined $gdbm or die "gdbm open failed: $!\n"; @@ -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 84f8fb4d..c973c6f0 100644 --- a/t/cmd_ipc.t +++ b/t/cmd_ipc.t @@ -1,23 +1,20 @@ #!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 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(alarm); +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,33 +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); - my $alrm = 0; - local $SIG{ALRM} = sub { $alrm++ }; - alarm(0.001); - @fds = $recv->($s2, $buf, length($src) + 1); - ok($!{EINTR}, "EINTR set by ($desc)"); - is_deeply(\@fds, [ undef ], "EINTR $desc"); - is($alrm, 1, 'SIGALRM hit'); + if ('test ALRM') { + my $alrm = 0; + local $SIG{ALRM} = sub { $alrm++ }; + my $tgt = $$; + my $pid = fork; + if ($pid == 0) { + # need to loop since Perl signals are racy + # (the interpreter doesn't self-pipe) + 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); + waitpid($pid, 0); + 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}, "hit EAGAIN on send $desc"); + 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)); @@ -85,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 @@ -93,8 +107,9 @@ my $do_test = sub { SKIP: { diag "sent $nr, retrying with more"; $nr += 2 * 1024 * 1024; } else { - ok($!{EMSGSIZE}, 'got EMSGSIZE'); - # diag "$nr bytes hits EMSGSIZE"; + ok($!{EMSGSIZE} || $!{ENOBUFS}, + 'got EMSGSIZE or ENOBUFS') or + diag "$nr bytes fails with: $!"; last; } } @@ -108,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: { @@ -117,14 +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: { + require_ok 'PublicInbox::Syscall'; + $send = PublicInbox::Syscall->can('send_cmd4') or + skip "send_cmd4 not defined for $^O arch", 1; + $recv = PublicInbox::Syscall->can('recv_cmd4') or + 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,12 +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 warnings; -use Test::More; -use PublicInbox::Config; +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); @@ -42,7 +61,6 @@ my ($tmpdir, $for_destroy) = tmpdir(); -primary_address => 'meta@public-inbox.org', 'name' => 'meta', -httpbackend_limiter => undef, - nntpserver => undef, }, "lookup matches expected output"); is($cfg->lookup('blah@example.com'), undef, @@ -59,34 +77,35 @@ my ($tmpdir, $for_destroy) = tmpdir(); 'name' => 'test', 'url' => [ 'http://example.com/test' ], -httpbackend_limiter => undef, - nntpserver => undef, }, "lookup matches expected output for test"); } { - 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', @@ -94,39 +113,52 @@ EOF } { - my $pfx = "publicinbox.test"; - my $str = <<EOF; -$pfx.address=test\@example.com -$pfx.inboxdir=/path/to/non/existent -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($ibx->{nntpserver}, 'news.example.com', 'global NNTP server'); + 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.nntpserver=news.alt.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($ibx->{nntpserver}, 'news.alt.example.com','per-inbox NNTP server'); + is_deeply($ibx->nntp_url({ www => { pi_cfg => $cfg }}), + [ 'nntp://news.alt.example.com/inbox.test' ], + 'nntp_url uses per-inbox NNTP server'); + is_deeply($ibx->imap_url({ www => { pi_cfg => $cfg }}), + [ 'imaps://mail.example.com/inbox.test' ], + 'nntp_url uses per-inbox NNTP server'); } # 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, @@ -159,7 +191,7 @@ my $xre = join('|', keys %X); for my $s (@invalid) { my $d = $s; $d =~ s/($xre)/$X{$1}/g; - ok(!PublicInbox::Config::valid_inbox_name($s), "`$d' name rejected"); + ok(!PublicInbox::Config::valid_foo_name($s), "`$d' name rejected"); } # obviously-valid examples @@ -175,7 +207,7 @@ my @valid = qw(a a@example a@example.com); # '!', '$', '=', '+' push @valid, qw[bang! ca$h less< more> 1% (parens) &more eql= +plus], '#hash'; for my $s (@valid) { - ok(PublicInbox::Config::valid_inbox_name($s), "`$s' name accepted"); + ok(PublicInbox::Config::valid_foo_name($s), "`$s' name accepted"); } { @@ -198,21 +230,22 @@ 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'); - is($t1->{-repo_objs}->[0], $t2->{-repo_objs}->[0], + ok $cfg->repo_objs($t1)->[0], 'coderepo parsed'; + is($cfg->repo_objs($t1)->[0], $cfg->repo_objs($t2)->[0], 'inboxes share ::Git object'); } @@ -235,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 cdb9e3f5..b123f17b 100644 --- a/t/convert-compact.t +++ b/t/convert-compact.t @@ -1,31 +1,27 @@ -# Copyright (C) 2018-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::Eml; use PublicInbox::TestCommon; -require_git(2.6); -require_mods(qw(DBD::SQLite Search::Xapian)); -have_xapian_compact or - plan skip_all => 'xapian-compact missing for '.__FILE__; - -use_ok 'PublicInbox::V2Writable'; use PublicInbox::Import; +require_git(2.6); +require_mods(qw(DBD::SQLite Xapian)); +have_xapian_compact; my ($tmpdir, $for_destroy) = tmpdir(); -my $ibx = { - inboxdir => "$tmpdir/v1", - name => 'test-v1', - -primary_address => 'test@example.com', -}; - -PublicInbox::Import::init_bare($ibx->{inboxdir}); -ok(umask(077), 'set restrictive umask'); -xsys_e(qw(git) , "--git-dir=$ibx->{inboxdir}", - qw(config core.sharedRepository 0644)); -$ibx = PublicInbox::Inbox->new($ibx); -my $im = PublicInbox::Import->new($ibx->git, undef, undef, $ibx); -my $mime = PublicInbox::Eml->new(<<'EOF'); +my $ibx = create_inbox 'v1', indexlevel => 'medium', tmpdir => "$tmpdir/v1", + pre_cb => sub { + my ($inboxdir) = @_; + PublicInbox::Import::init_bare($inboxdir); + xsys_e(qw(git) , "--git-dir=$inboxdir", + qw(config core.sharedRepository 0644)); + }, sub { + my ($im, $ibx) = @_; + $im->done; + umask(077) or BAIL_OUT "umask: $!"; + $_[0] = $im = $ibx->importer(0); + my $eml = PublicInbox::Eml->new(<<'EOF'); From: a@example.com To: b@example.com Subject: this is a subject @@ -34,24 +30,19 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000 hello world EOF - -ok($im->add($mime), 'added one message'); -ok($im->remove($mime), 'remove message'); -ok($im->add($mime), 'added message again'); -$im->done; -for (1..2) { - eval { PublicInbox::SearchIdx->new($ibx, 1)->index_sync; }; - is($@, '', 'no errors syncing'); -} - -is(((stat("$ibx->{inboxdir}/public-inbox"))[2]) & 07777, 0755, + $im->add($eml) or BAIL_OUT '->add'; + $im->remove($eml) or BAIL_OUT '->remove'; + $im->add($eml) or BAIL_OUT '->add'; +}; +umask(077) or BAIL_OUT "umask: $!"; +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'); } @@ -64,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 { @@ -80,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'); } @@ -96,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-gen/.gitignore b/t/data-gen/.gitignore new file mode 100644 index 00000000..11e8933b --- /dev/null +++ b/t/data-gen/.gitignore @@ -0,0 +1,2 @@ +# read-only test data generated by create_inbox +* 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/data/binary.patch b/t/data/binary.patch new file mode 100644 index 00000000..58717abe --- /dev/null +++ b/t/data/binary.patch @@ -0,0 +1,20 @@ +From 7a1921ba7bd99c63ad6dc6ec0791691ee80e279a Mon Sep 17 00:00:00 2001 +From: BOFH <bofh@example.com> +Date: Fri, 13 May 2022 23:04:14 +0000 +Subject: [PATCH] binary patch test +Message-ID: <binary-patch-test@example> + +--- + zero | Bin 0 -> 1 bytes + 1 file changed, 0 insertions(+), 0 deletions(-) + create mode 100644 zero + +diff --git a/zero b/zero +new file mode 100644 +index 0000000000000000000000000000000000000000..f76dd238ade08917e6712764a16a22005a50573d +GIT binary patch +literal 1 +IcmZPo000310RR91 + +literal 0 +HcmV?d00001 diff --git a/t/dir_idle.t b/t/dir_idle.t index d62eb5a2..8d085d6e 100644 --- a/t/dir_idle.t +++ b/t/dir_idle.t @@ -1,6 +1,47 @@ #!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 Test::More; +use v5.12; use PublicInbox::TestCommon; +use PublicInbox::DS qw(now); +use File::Path qw(make_path); use_ok 'PublicInbox::DirIdle'; +my ($tmpdir, $for_destroy) = tmpdir(); +make_path("$tmpdir/a/b", "$tmpdir/c"); +my @x; +my $cb = sub { push @x, \@_ }; +my $di = PublicInbox::DirIdle->new($cb); +$di->add_watches(["$tmpdir/a", "$tmpdir/c"], 1); +$PublicInbox::DS::loop_timeout = 1000; +my $end = 3 + now; +local @PublicInbox::DS::post_loop_do = (sub { scalar(@x) == 0 && now < $end }); +rmdir("$tmpdir/a/b") or xbail "rmdir $!"; +PublicInbox::DS::event_loop(); +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); +} + +rmdir("$tmpdir/a") or xbail "rmdir $!"; +@x = (); +$end = 3 + now; +PublicInbox::DS::event_loop(); +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'); +} else { + check_broken_tmpfs; + diag explain(\@x); +} +rename("$tmpdir/c", "$tmpdir/j") or xbail "rmdir $!"; +@x = (); +$end = 3 + now; +PublicInbox::DS::event_loop(); +is(scalar(@x), 1, 'got an event') and + is($x[0]->[0]->fullname, "$tmpdir/c", 'got expected fullname') and + ok($x[0]->[0]->IN_DELETE_SELF || $x[0]->[0]->IN_MOVE_SELF, + 'IN_DELETE_SELF set on move'); + 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 57d9cd72..f39985e0 100644 --- a/t/ds-leak.t +++ b/t/ds-leak.t @@ -1,28 +1,25 @@ -# 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 Test::More; -use PublicInbox::TestCommon; +use v5.12; use PublicInbox::TestCommon; use_ok 'PublicInbox::DS'; if ('close-on-exec for epoll and kqueue') { - use PublicInbox::Spawn qw(spawn which); + use PublicInbox::Spawn qw(spawn); 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); pipe($r, $w) or die "pipe: $!"; PublicInbox::DS::add_timer(0, sub { $pid = spawn([qw(sleep 10)]) }); - PublicInbox::DS->EventLoop; + PublicInbox::DS::event_loop(); ok($pid, 'subprocess spawned'); # wait for execve, we need to ensure lsof sees sleep(1) @@ -32,11 +29,8 @@ if ('close-on-exec for epoll and kqueue') { is($l, undef, 'cloexec works and sleep(1) is running'); SKIP: { - my $lsof = which('lsof') or skip 'lsof missing', 1; my $rdr = { 2 => \(my $null) }; - my @of = grep(/$evfd_re/, xqx([$lsof, '-p', $pid], {}, $rdr)); - my $err = $?; - skip "lsof broken ? (\$?=$err)", 1 if $err; + my @of = grep /$evfd_re/, lsof_pid $pid, $rdr; is_deeply(\@of, [], 'no FDs leaked to subprocess'); }; if (defined $pid) { @@ -57,9 +51,9 @@ SKIP: { } my $cb = sub {}; for my $i (0..$n) { - PublicInbox::DS->SetLoopTimeout(0); - PublicInbox::DS->SetPostLoopCallback($cb); - PublicInbox::DS->EventLoop; + $PublicInbox::DS::loop_timeout = 0; + local @PublicInbox::DS::post_loop_do = ($cb); + PublicInbox::DS::event_loop(); PublicInbox::DS->Reset; } ok(1, "Reset works and doesn't hit RLIMIT_NOFILE ($n)"); 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,42 +1,34 @@ -# Copyright (C) 2019-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> # edit frontend behavior test (t/replace.t for backend) use strict; -use warnings; -use Test::More; +use v5.10.1; use PublicInbox::TestCommon; -require_git(2.6); -require PublicInbox::Inbox; -require PublicInbox::InboxWritable; -require PublicInbox::Config; use PublicInbox::MID qw(mid_clean); +require_git(2.6); require_mods('DBD::SQLite'); my ($tmpdir, $for_destroy) = tmpdir(); my $inboxdir = "$tmpdir/v2"; -my $ibx = PublicInbox::Inbox->new({ - inboxdir => $inboxdir, - name => 'test-v2edit', - version => 2, - -primary_address => 'test@example.com', - indexlevel => 'basic', -}); -$ibx = PublicInbox::InboxWritable->new($ibx, {nproc=>1}); +my $file = 't/data/0001.patch'; +my $eml = eml_load($file); +my $mid = mid_clean($eml->header('Message-ID')); +my $ibx = create_inbox 'v2edit', indexlevel => 'basic', version => 2, + tmpdir => $inboxdir, sub { + my ($im, $ibx) = @_; + $im->add($eml) or BAIL_OUT; +}; my $cfgfile = "$tmpdir/config"; local $ENV{PI_CONFIG} = $cfgfile; -my $im = $ibx->importer(0); -my $file = 't/data/0001.patch'; -my $mime = eml_load($file); -my $mid = mid_clean($mime->header('Message-Id')); -ok($im->add($mime), 'add message to be edited'); -$im->done; 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)); @@ -46,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)); @@ -57,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; @@ -73,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; @@ -89,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)); @@ -100,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"); @@ -108,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"); @@ -118,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}; @@ -132,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)); @@ -155,14 +147,15 @@ $t = '--raw and mbox escaping'; { $t = 'reuse Message-ID'; { my @warn; local $SIG{__WARN__} = sub { push @warn, @_ }; - ok($im->add($mime), "$t and re-add"); + my $im = $ibx->importer(0); + ok($im->add($eml), "$t and re-add"); $im->done; like($warn[0], qr/reused for mismatched content/, "$t got warning"); } $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/, @@ -172,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); @@ -26,6 +26,8 @@ sub mime_load ($) { is($str, "hi\n", '->new modified body like Email::Simple'); is($eml->body, "hi\n", '->body works'); is($eml->as_string, "a: b\n\nhi\n", '->as_string'); + my $empty = PublicInbox::Eml->new("\n\n"); + is($empty->as_string, "\n\n", 'empty message'); } for my $cls (@classes) { @@ -214,6 +216,17 @@ if ('one newline before headers') { is($eml->body, ""); } +if ('body only') { + my $str = <<EOM; +--- a/lib/PublicInbox/Eml.pm ++++ b/lib/PublicInbox/Eml.pm +@@ -122,9 +122,10 @@ sub new { +\x20 +EOM + my $eml = PublicInbox::Eml->new($str); + is($eml->body, $str, 'body-only accepted'); +} + for my $cls (@classes) { # XXX: matching E::M, but not sure about this my $s = <<EOF; Content-Type: multipart/mixed; boundary="b" @@ -342,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)) { @@ -404,13 +417,14 @@ Content-Type: text/x-patch; name="=?utf-8?q?vtpm-fakefile.patch?=" Content-Disposition: attachment; filename="=?utf-8?q?vtpm-makefile.patch?=" EOF - is($cls->new($s)->filename, 'vtpm-makefile.patch', 'filename decoded'); + is($cls->new($s)->filename, 'vtpm-makefile.patch', + "filename decoded ($cls)") if $cls ne 'PublicInbox::MIME'; $s =~ s/^Content-Disposition:.*$//sm; is($cls->new($s)->filename, 'vtpm-fakefile.patch', "filename fallback ($cls)") if $cls ne 'PublicInbox::MIME'; is($cls->new($s)->content_type, 'text/x-patch; name="vtpm-fakefile.patch"', - 'matches Email::MIME output, "correct" or not'); + qq[matches Email::MIME output, "correct" or not ($cls)]); $s = <<'EOF'; Content-Type: multipart/foo; boundary=b @@ -1,22 +1,22 @@ -use strict; +#!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 Test::More; -use IO::Handle; -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'); -my $hnd = IO::Handle->new_from_fd($epfd, 'r+'); # close on exit - -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); -is(@events, 0, 'epoll_wait timeout'); +$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 new file mode 100644 index 00000000..896c46ff --- /dev/null +++ b/t/extindex-psgi.t @@ -0,0 +1,134 @@ +#!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 PublicInbox::TestCommon; +use PublicInbox::Config; +use File::Copy qw(cp); +use IO::Handle (); +require_git(2.6); +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); +require PublicInbox::WWW; +my ($ro_home, $cfg_path) = setup_public_inboxes; +my ($tmpdir, $for_destroy) = tmpdir; +my $home = "$tmpdir/home"; +mkdir $home or BAIL_OUT $!; +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 }; +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); + print $cfgfh <<EOM or BAIL_OUT; +[extindex "all"] + topdir = $tmpdir/eidx + url = http://bogus.example.com/all +[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) = @_; + my $res = $cb->(GET('/all/')); + is($res->code, 200, '/all/ good'); + $res = $cb->(GET('/all/new.atom', Host => 'usethis.example.com')); + like($res->content, qr!http://usethis\.example\.com/!s, + 'Host: header respected in Atom feed'); + unlike($res->content, qr!http://bogus\.example\.com/!s, + 'default URL ignored with different host header'); + + $res = $cb->(GET('/all/_/text/config/')); + is($res->code, 200, '/text/config HTML'); + $res = $cb->(GET('/all/_/text/config/raw')); + is($res->code, 200, '/text/config raw'); + my $f = "$tmpdir/extindex.config"; + open my $fh, '>', $f or xbail $!; + print $fh $res->content or xbail $!; + close $fh or xbail $!; + my $cfg = PublicInbox::Config->git_config_dump($f); + is($?, 0, 'no errors from git-config parsing'); + ok($cfg->{'extindex.all.topdir'}, 'extindex.topdir defined'); + + $res = $cb->(GET('/all/all.mbox.gz')); + is($res->code, 200, 'all.mbox.gz'); + + $res = $cb->(GET('/')); + like($res->content, qr!\Qhttp://bogus.example.com/all\E!, + '/all listed'); + $res = $cb->(GET('/?q=')); + is($res->code, 200, 'no query means all inboxes'); + $res = $cb->(GET('/?q=nonexistent')); + is($res->code, 404, 'no inboxes matched'); + unlike($res->content, qr!no inboxes, yet!, + 'we have inboxes, just no matches'); + + my $m = {}; + for my $pfx (qw(/t1 /t2), '') { + $res = $cb->(GET($pfx.'/manifest.js.gz')); + gunzip(\($res->content) => \(my $js)); + $m->{$pfx} = json_utf8->decode($js); + } + is_deeply([sort keys %{$m->{''}}], + [ sort(keys %{$m->{'/t1'}}, keys %{$m->{'/t2'}}) ], + 't1 + t2 = all'); + is_deeply([ sort keys %{$m->{'/t2'}} ], [ '/t2/git/0.git' ], + '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); +test_httpd($env, $client); + +done_testing; diff --git a/t/extsearch.t b/t/extsearch.t index d199fc7b..797aa8f5 100644 --- a/t/extsearch.t +++ b/t/extsearch.t @@ -1,30 +1,25 @@ #!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 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,42 +28,78 @@ 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 $?"; -ok(run_script([qw(-extindex --all), "$home/extindex"]), 'extindex init'); +ok(run_script([qw(-extindex --dangerous --all), "$home/extindex"]), + 'extindex init'); { my $es = PublicInbox::ExtSearch->new("$home/extindex"); ok($es->has_threadid, '->has_threadid'); } +if ('with boost') { + xsys([qw(git config publicinbox.v1test.boost), 10], + { GIT_CONFIG => $cfg_path }); + ok(run_script([qw(-extindex --all), "$home/extindex-b"]), + 'extindex init with boost'); + my $es = PublicInbox::ExtSearch->new("$home/extindex-b"); + my $smsg = $es->over->get_art(1); + ok($smsg, 'got first article'); + my $xref3 = $es->over->get_xref3($smsg->{num}); + my @v1 = grep(/\Av1/, @$xref3); + my @v2 = grep(/\Av2/, @$xref3); + like($v1[0], qr/\Av1\.example.*?\b\Q$smsg->{blob}\E\b/, + 'smsg->{blob} respected boost'); + is(scalar(@$xref3), 2, 'only to entries'); + undef $es; + + xsys([qw(git config publicinbox.v2test.boost), 20], + { GIT_CONFIG => $cfg_path }); + ok(run_script([qw(-extindex --all --reindex), "$home/extindex-b"]), + 'extindex --reindex with altered boost'); + + $es = PublicInbox::ExtSearch->new("$home/extindex-b"); + $smsg = $es->over->get_art(1); + like($v2[0], qr/\Av2\.example.*?\b\Q$smsg->{blob}\E\b/, + 'smsg->{blob} respects boost after reindex'); + + # high boost added later + my $b2 = "$home/extindex-bb"; + ok(run_script([qw(-extindex), $b2, "$home/v1test"]), + 'extindex with low boost inbox only'); + ok(run_script([qw(-extindex), $b2, "$home/v2test"]), + 'extindex with high boost inbox only'); + $es = PublicInbox::ExtSearch->new($b2); + $smsg = $es->over->get_art(1); + $xref3 = $es->over->get_xref3($smsg->{num}); + like($v2[0], qr/\Av2\.example.*?\b\Q$smsg->{blob}\E\b/, + 'smsg->{blob} respected boost across 2 index runs'); + + xsys([qw(git config --unset publicinbox.v1test.boost)], + { GIT_CONFIG => $cfg_path }); + xsys([qw(git config --unset publicinbox.v2test.boost)], + { GIT_CONFIG => $cfg_path }); +} + { # 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'); @@ -80,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 }); @@ -107,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), @@ -132,7 +165,7 @@ if ('inbox edited') { is($mset->size, 1, 'new message found'); $mset = $es->mset('b:"test message"'); is($mset->size, 1, 'old message found'); - delete @$es{qw(git over xdb)}; # fork preparation + delete @$es{qw(git over xdb qp)}; # fork preparation my $pi_cfg = PublicInbox::Config->new; $pi_cfg->fill_all; @@ -158,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), @@ -201,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 = ''; @@ -236,6 +263,7 @@ if ('inject w/o indexing') { if ('reindex catches missed messages') { my $v2ibx = $cfg->lookup_name('v2test'); + $v2ibx->{-no_fsync} = 1; my $im = PublicInbox::InboxWritable->new($v2ibx)->importer(0); my $cmt_a = $v2ibx->mm->last_commit_xap($schema_version, 0); my $eml = eml_load('t/data/0001.patch'); @@ -263,12 +291,17 @@ 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'); $es->{xdb}->reopen; - my $mset = $es->mset("mid:$new->{mid}"); + # git patch-id --stable <t/data/0001.patch | awk '{print $1}' + my $patchid = '91ee6b761fc7f47cad9f2b09b10489f313eb5b71'; + my $mset = $es->search->mset("patchid:$patchid"); + is($mset->size, 1, 'patchid search works'); + + $mset = $es->mset("mid:$new->{mid}"); is($mset->size, 1, 'previously unseen, now indexed in Xapian'); ok($im->remove($eml), 'remove new message from v2 inbox'); @@ -291,11 +324,17 @@ if ('reindex catches missed messages') { $es->{xdb}->reopen; $mset = $es->mset("mid:$new->{mid}"); is($mset->size, 0, 'stale mid gone Xapian'); + + ok(run_script([qw(-extindex --reindex --all --fast), "$home/extindex"], + undef, $opt), '--reindex w/ --fast'); + ok(!run_script([qw(-extindex --all --fast), "$home/extindex"], + undef, $opt), '--fast alone makes no sense'); } if ('reindex catches content bifurcation') { use PublicInbox::MID qw(mids); my $v2ibx = $cfg->lookup_name('v2test'); + $v2ibx->{-no_fsync} = 1; my $im = PublicInbox::InboxWritable->new($v2ibx)->importer(0); my $eml = eml_load('t/data/message_embed.eml'); my $cmt_a = $v2ibx->mm->last_commit_xap($schema_version, 0); @@ -324,7 +363,7 @@ if ('reindex catches content bifurcation') { is($oidx->max, $oldmax, 'oidx->max unchanged'); $oidx->dbh_close; ok(run_script([qw(-extindex --reindex --all), "$home/extindex"], - undef, $opt), 'extindex --reindex'); + undef, $opt), 'extindex --reindex') or diag explain($opt); $oidx->dbh; ok($oidx->max > $oldmax, 'oidx->max bumped'); like($err, qr/split into 2 due to deduplication change/, @@ -358,12 +397,200 @@ 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; is(scalar(@it), 1, 'only one inbox left'); } +if ('dedupe + dry-run') { + my @cmd = ('-extindex', "$home/extindex"); + my $opt = { 2 => \(my $err = '') }; + ok(run_script([@cmd, '--dedupe'], undef, $opt), '--dedupe'); + ok(run_script([@cmd, qw(--dedupe --dry-run)], undef, $opt), + '--dry-run --dedupe'); + is $err, '', 'no errors'; + ok(!run_script([@cmd, qw(--dry-run)], undef, $opt), + '--dry-run alone fails'); +} + +# chmod 0755, $home or xbail "chmod: $!"; +for my $j (1, 3, 6) { + my $o = { 2 => \(my $err = '') }; + my $d = "$home/extindex-j$j"; + ok(run_script(['-extindex', "-j$j", '--all', $d], undef, $o), + "init with -j$j"); + my $max = $j - 2; + $max = 0 if $max < 0; + my @dirs = glob("$d/ei*/?"); + like($dirs[-1], qr!/ei[0-9]+/$max\z!, '-j works'); +} + +SKIP: { + my $d = "$home/extindex-j1"; + my $es = PublicInbox::ExtSearch->new($d); + ok(my $nresult0 = $es->mset('z:0..')->size, 'got results'); + ok(ref($es->{xdb}), '{xdb} created'); + my $nshards1 = $es->{nshard}; + is($nshards1, 1, 'correct shard count'); + + my @ei_dir = glob("$d/ei*/"); + chmod 0755, $ei_dir[0] or xbail "chmod: $!"; + my $mode = sprintf('%04o', 07777 & (stat($ei_dir[0]))[2]); + is($mode, '0755', 'mode set on ei*/ dir'); + my $o = { 2 => \(my $err = '') }; + ok(run_script([qw(-xcpdb -R4), $d]), 'xcpdb R4'); + my @dirs = glob("$d/ei*/?"); + for my $i (0..3) { + is(grep(m!/ei[0-9]+/$i\z!, @dirs), 1, "shard [$i] created"); + my $m = sprintf('%04o', 07777 & (stat($dirs[$i]))[2]); + is($m, $mode, "shard [$i] mode"); + } + delete @$es{qw(xdb qp)}; + is($es->mset('z:0..')->size, $nresult0, 'new shards, same results'); + + for my $i (4..5) { + is(grep(m!/ei[0-9]+/$i\z!, @dirs), 0, "no shard [$i]"); + } + + ok(run_script([qw(-xcpdb -R2), $d]), 'xcpdb -R2'); + @dirs = glob("$d/ei*/?"); + for my $i (0..1) { + is(grep(m!/ei[0-9]+/$i\z!, @dirs), 1, "shard [$i] kept"); + } + for my $i (2..3) { + is(grep(m!/ei[0-9]+/$i\z!, @dirs), 0, "no shard [$i]"); + } + have_xapian_compact 1; + ok(run_script([qw(-compact), $d], undef, $o), 'compact'); + # n.b. stderr contains xapian-compact output + + my @d2 = glob("$d/ei*/?"); + is_deeply(\@d2, \@dirs, 'dirs consistent after compact'); + ok(run_script([qw(-extindex --dedupe --all), $d]), + '--dedupe works after compact'); + ok(run_script([qw(-extindex --gc), $d], undef, $o), + '--gc works after compact'); +} + +{ # ensure --gc removes non-xposted messages + my $old_size = -s $cfg_path // xbail "stat $cfg_path $!"; + my $tmp_addr = 'v2tmp@example.com'; + run_script([qw(-init v2tmp --indexlevel basic + --newsgroup v2tmp.example), + "$home/v2tmp", 'http://example.com/v2tmp', $tmp_addr ]) + or xbail '-init'; + $env = { ORIGINAL_RECIPIENT => $tmp_addr }; + my $mid = 'tmpmsg@example.com'; + my $in = \<<EOM; +From: b\@z +To: b\@r +Message-Id: <$mid> +Subject: tmpmsg +Date: Tue, 19 Jan 2038 03:14:07 +0000 + +EOM + run_script([qw(-mda --no-precheck)], $env, {0 => $in}) or xbail '-mda'; + ok(run_script([qw(-extindex --all), "$home/extindex"]), 'update'); + my $nr; + { + my $es = PublicInbox::ExtSearch->new("$home/extindex"); + my ($id, $prv); + my $smsg = $es->over->next_by_mid($mid, \$id, \$prv); + ok($smsg, 'tmpmsg indexed'); + my $mset = $es->search->mset("mid:$mid"); + is($mset->size, 1, 'new message found'); + $mset = $es->search->mset('z:0..'); + $nr = $mset->size; + } + 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'); + is_deeply([ grep(!/^(?:I:|#)/, split(/^/m, $err)) ], [], + 'no non-informational errors in stderr'); + + my $es = PublicInbox::ExtSearch->new("$home/extindex"); + my $mset = $es->search->mset("mid:$mid"); + is($mset->size, 0, 'tmpmsg gone from search'); + my ($id, $prv); + is($es->over->next_by_mid($mid, \$id, \$prv), undef, + 'tmpmsg gone from over'); + $id = $prv = undef; + is($es->over->next_by_mid('testmessage@example.com', \$id, \$prv), + undef, 'remaining message not indavderover'); + $mset = $es->search->mset('z:0..'); + is($mset->size, $nr - 1, 'existing messages not clobbered from search'); + my $o = $es->over->{dbh}->selectall_arrayref(<<EOM); +SELECT num FROM over ORDER BY num +EOM + is(scalar(@$o), $mset->size, 'over row count matches Xapian'); + my $x = $es->over->{dbh}->selectall_arrayref(<<EOM); +SELECT DISTINCT(docid) FROM xref3 ORDER BY docid +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 5c925ae6..8221e092 100644 --- a/t/fake_inotify.t +++ b/t/fake_inotify.t @@ -1,16 +1,15 @@ #!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 Test::More; +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: $!"; open my $fh, '>', "$tmpdir/tst" or BAIL_OUT "open: $!"; close $fh or BAIL_OUT "close: $!"; @@ -18,24 +17,35 @@ my $fi = PublicInbox::FakeInotify->new; my $mask = PublicInbox::FakeInotify::MOVED_TO_OR_CREATE(); my $w = $fi->watch("$tmpdir/new", $mask); -select undef, undef, undef, $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); -select undef, undef, undef, $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; -select undef, undef, undef, $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()); -PublicInbox::DS->Reset; +rmdir("$tmpdir/new/rmd") or xbail "rmdir: $!"; +@events = $fi->read; +is_deeply([map{ $_->fullname }@events], ["$tmpdir/new/rmd"], 'rmdir detected') or + diag explain(\@events); +ok($events[-1]->IN_DELETE, 'IN_DELETE set on rmdir'); + +unlink("$tmpdir/new/tst") or xbail "unlink: $!"; +@events = grep { ref =~ /Gone/ } $fi->read; +is_deeply([map{ $_->fullname }@events], ["$tmpdir/new/tst"], 'unlink detected') or + diag explain(\@events); +ok($events[0]->IN_DELETE, 'IN_DELETE set on unlink'); done_testing; @@ -1,14 +1,14 @@ +#!perl -w # Copyright (C) 2014-2021 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::TestCommon; use PublicInbox::Eml; use PublicInbox::Feed; -use PublicInbox::Import; use PublicInbox::Inbox; my $have_xml_treepp = eval { require XML::TreePP; 1 }; -use PublicInbox::TestCommon; +my ($tmpdir, $for_destroy) = tmpdir(); sub string_feed { my $res = PublicInbox::Feed::generate($_[0]); @@ -21,43 +21,18 @@ sub string_feed { $str; } -my ($tmpdir, $for_destroy) = tmpdir(); my $git_dir = "$tmpdir/gittest"; -my $ibx = PublicInbox::Inbox->new({ - address => 'test@example', - name => 'testbox', - inboxdir => $git_dir, - url => [ 'http://example.com/test' ], - feedmax => 3, -}); -my $git = $ibx->git; -my $im = PublicInbox::Import->new($git, $ibx->{name}, 'test@example'); - -{ - $im->init_bare; +my $ibx = create_inbox 'v1', tmpdir => $git_dir, sub { + my ($im, $ibx) = @_; foreach my $i (1..6) { - my $mime = PublicInbox::Eml->new(<<EOF); + $im->add(PublicInbox::Eml->new(<<EOF)) or BAIL_OUT; From: ME <me\@example.com> To: U <u\@example.com> Message-Id: <$i\@example.com> Subject: zzz #$i Date: Thu, 01 Jan 1970 00:00:00 +0000 -> This is a long multi line quote so it should not be allowed to -> show up in its entirty in the Atom feed. drop me -> I quote to much -> I quote to much -> I quote to much -> I quote to much -> I quote to much -> I quote to much -> I quote to much -> I quote to much -> I quote to much -> I quote to much -> I quote to much -> I quote to much -> I quote to much +> drop me msg $i @@ -66,10 +41,12 @@ msg $i keep me EOF - like($im->add($mime), qr/\A:\d+/, 'added'); } - $im->done; -} +}; + +$ibx->{url} = [ 'http://example.com/test' ]; +$ibx->{feedmax} = 3; +my $im = $ibx->importer(0); # spam check { @@ -83,7 +60,7 @@ EOF 'looks like an an Atom feed'); is(scalar @{$t->{feed}->{entry}}, 3, 'parsed three entries'); - is($t->{feed}->{id}, 'mailto:test@example', + is($t->{feed}->{id}, 'mailto:v1@example.com', 'id is set to default'); } @@ -140,4 +117,4 @@ EOF } } -done_testing(); +done_testing; diff --git a/t/filter_rubylang.t b/t/filter_rubylang.t index 81799451..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'; @@ -44,7 +43,7 @@ EOF $mime = PublicInbox::Eml->new($msg); $ret = $f->delivery($mime); is($ret, $mime, "delivery successful"); - my $mm = PublicInbox::Msgmap->new($git_dir); + my $mm = $ibx->mm; is($mm->num_for('a@b'), 12, 'MM entry created based on X-ML-Count'); $msg = <<'EOF'; @@ -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,16 +1,17 @@ -# 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_ok 'PublicInbox::Git'; +use PublicInbox::Git; +is(PublicInbox::Git::MAX_INFLIGHT, + int(PublicInbox::Git::MAX_INFLIGHT), 'MAX_INFLIGHT is an integer'); { - PublicInbox::Import::init_bare($dir); + PublicInbox::Import::init_bare($dir, 'master'); my $fi_data = './t/git.fast-import-data'; open my $fh, '<', $fi_data or die "fast-import data readable (or run test at top level: $!"; @@ -19,7 +20,13 @@ use_ok 'PublicInbox::Git'; is($?, 0, 'fast-import succeeded'); } { - my $git = PublicInbox::Git->new($dir); + my $git = PublicInbox::Git->new("$dir/foo.git"); + my $nick = $git->local_nick; # internal sub + unlike($nick, qr/\.git\.git\z/, "no doubled `.git.git' suffix"); + like($nick, qr/\.git\z/, "one `.git' suffix"); + $git = PublicInbox::Git->new($dir); + $nick = $git->local_nick; # internal sub + like($nick, qr/\.git\z/, "local nick always adds `.git' suffix"); my @s = $git->date_parse('1970-01-01T00:00:00Z'); is($s[0], 0, 'parsed epoch'); local $ENV{TZ} = 'UTC'; @@ -39,7 +46,7 @@ use_ok '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'); @@ -61,13 +68,37 @@ use_ok 'PublicInbox::Git'; my ($bref, $oid_hex, $type, $size, $arg) = @_; $missing = [ @_ ]; }, $arg); - $gcf->cat_async_wait; + $gcf->async_wait_all; my ($bref, $oid_hex, $type, $size, $arg_res) = @$res; is_deeply([$oid_hex, $type, $size], \@x, 'got expected header'); is($arg_res, $arg, 'arg passed to cat_async'); is_deeply($raw, $bref, 'blob result matches'); is_deeply($missing, [ undef, 'non-existent', 'missing', undef, $arg], 'non-existent blob gives expected result'); + + $res = []; + $gcf->cat_async($oid, sub { push @$res, \@_ }); + $gcf->cat_async($oid, sub { die 'HI' }); + $gcf->cat_async($oid, sub { push @$res, \@_ }); + eval { $gcf->async_wait_all }; + like($@, qr/\bHI\b/, 'die in callback propagates'); + is(scalar(@$res), 2, 'two results'); + is_deeply($res->[0], [ $raw, @x, undef ], '1st cb result'); + is_deeply($res->[1], [ undef, $oid, undef, undef, undef ], + '2nd cb aborted '); + + my @w; + local $PublicInbox::Git::async_warn = 1; + local $SIG{__WARN__} = sub { push @w, @_ }; + $res = []; + $gcf->cat_async($oid, sub { push @$res, \@_ }); + $gcf->cat_async($oid, sub { die 'HI' }); + $gcf->cat_async($oid, sub { push @$res, \@_ }); + eval { $gcf->async_wait_all }; + is(scalar(@$res), 2, 'two results'); + is_deeply($res->[0], [ $raw, @x, undef ], '1st cb result'); + is_deeply($res->[1], [ $raw, @x, undef ], '2st cb result'); + like("@w", qr/\bHI\b/, 'die turned to warning'); } if (1) { @@ -98,12 +129,14 @@ if (1) { $gcf->qx(qw(repack -adq)); ok($gcf->packed_bytes > 0, 'packed size is positive'); - $gcf->qx(qw(rev-parse --verify bogus)); - isnt($?, 0, '$? set on failure'.$?); + my $rdr; + open $rdr->{2}, '+>', '/dev/null' or xbail "open $!"; + $gcf->qx([qw(rev-parse --verify bogus)], undef, $rdr); + isnt($?, 0, '$? set on failure: '.$?); } 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); @@ -145,7 +178,7 @@ SKIP: { # trigger cat_async_retry: $gcf->cat_async($remote, $cb, $results); } - $gcf->cat_async_wait; + $gcf->async_wait_all; my $expect = [ @exist[0..3], [ $remote, 'blob', 5 ], @exist[4..5] ]; is_deeply($results, $expect, 'got expected results'); @@ -168,5 +201,8 @@ is(git_quote($s = "Eléanor"), '"El\\303\\251anor"', 'quoted octal'); is(git_quote($s = "hello\"world"), '"hello\"world"', 'quoted dq'); is(git_quote($s = "hello\\world"), '"hello\\\\world"', 'quoted backslash'); 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,23 +1,17 @@ #!/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 warnings; -use Test::More; -use PublicInbox::Spawn qw(which); -use PublicInbox::TestCommon; -use IO::Handle; # ->autoflush +use strict; use v5.10.1; use PublicInbox::TestCommon; use IO::Handle; # ->autoflush use Fcntl qw(:seek); -eval { require highlight } or - plan skip_all => "failed to load highlight.pm for $0"; +require_mods 'highlight'; use_ok 'PublicInbox::HlMod'; my $hls = PublicInbox::HlMod->new; ok($hls, 'initialized OK'); 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'); -is($hls->_path2lang('Makefile'), 'make', 'Makefile OK'); -my $str = do { local $/; open(my $fh, __FILE__); <$fh> }; +like($hls->_path2lang('Makefile'), qr/\Amake/, 'Makefile OK'); +my $str = do { local $/; open(my $fh, '<', __FILE__); <$fh> }; my $orig = $str; { @@ -30,7 +24,7 @@ my $orig = $str; is($$ref, $$lref, 'do_hl_lang matches do_hl'); SKIP: { - my $w3m = which('w3m') or + my $w3m = require_cmd('w3m', 1) or skip('w3m(1) missing to check output', 1); my $cmd = [ $w3m, qw(-T text/html -dump -config /dev/null) ]; my $in = '<pre>' . $$ref . '</pre>'; diff --git a/t/html_index.t b/t/html_index.t deleted file mode 100644 index 8e2a674f..00000000 --- a/t/html_index.t +++ /dev/null @@ -1,56 +0,0 @@ -# Copyright (C) 2014-2021 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::Eml; -use PublicInbox::Feed; -use PublicInbox::Git; -use PublicInbox::Import; -use PublicInbox::Inbox; -use PublicInbox::TestCommon; -my ($tmpdir, $for_destroy) = tmpdir(); -my $git_dir = "$tmpdir/gittest"; -my $ibx = PublicInbox::Inbox->new({ - address => 'test@example', - name => 'tester', - inboxdir => $git_dir, - url => 'http://example.com/test', -}); -my $git = $ibx->git; -my $im = PublicInbox::Import->new($git, 'tester', 'test@example'); - -# setup -{ - $im->init_bare; - my $prev = ""; - - foreach my $i (1..6) { - my $mid = "<$i\@example.com>"; - my $mid_line = "Message-ID: $mid"; - if ($prev) { - $mid_line .= "In-Reply-To: $prev"; - } - $prev = $mid; - my $mime = PublicInbox::Eml->new(<<EOF); -From: ME <me\@example.com> -To: U <u\@example.com> -$mid_line -Subject: zzz #$i -Date: Thu, 01 Jan 1970 00:00:00 +0000 - -> This is a long multi line quote so it should not be allowed to -> show up in its entirty in the Atom feed. drop me - -msg $i - -> inline me here, short quote - -keep me -EOF - like($im->add($mime), qr/\A:\d+\z/, 'inserted message'); - } - $im->done; -} - -done_testing(); diff --git a/t/httpd-corner.psgi b/t/httpd-corner.psgi index 5fab2ba4..e29fd87b 100644 --- a/t/httpd-corner.psgi +++ b/t/httpd-corner.psgi @@ -1,11 +1,25 @@ -# 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> # corner case tests for the generic PSGI server # Usage: plackup [OPTIONS] /path/to/this/file -use strict; -use warnings; +use v5.12; 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) = @_; my $path = $env->{PATH_INFO}; @@ -15,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); @@ -78,41 +92,50 @@ 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') { $code = 200; push @$body, "$$\n"; + } elsif ($path eq '/url_scheme') { + $code = 200; + push @$body, $env->{'psgi.url_scheme'} + } 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 794d8aeb..7539573c 100644 --- a/t/httpd-corner.t +++ b/t/httpd-corner.t @@ -1,15 +1,14 @@ -# 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> # note: our HTTP server should be standalone and capable of running # generic PSGI/Plack apps. -use strict; -use warnings; -use Test::More; +use v5.12; use PublicInbox::TestCommon; use Time::HiRes qw(gettimeofday tv_interval); -use PublicInbox::Spawn qw(which spawn popen_rd); -use PublicInbox::TestCommon; +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); @@ -22,26 +21,27 @@ ok(defined mkfifo($fifo, 0777), 'created FIFO'); my $err = "$tmpdir/stderr.log"; my $out = "$tmpdir/stdout.log"; my $psgi = "./t/httpd-corner.psgi"; -my $sock = tcp_server() or die; +my $sock = tcp_server(); 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(); + 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 ($) { @@ -56,14 +56,40 @@ sub unix_server ($) { my $upath = "$tmpdir/s"; my $unix = unix_server($upath); +my $alt = tcp_server(); my $td; my $spawn_httpd = sub { my (@args) = @_; - my $cmd = [ '-httpd', @args, "--stdout=$out", "--stderr=$err", $psgi ]; - $td = start_script($cmd, undef, { 3 => $sock, 4 => $unix }); + my $x = tcp_host_port($alt); + my $cmd = [ '-httpd', @args, "--stdout=$out", "--stderr=$err", $psgi, + '-l', "http://$x/?psgi=t/alt.psgi,env.PI_CONFIG=/path/to/alt". + ",err=$tmpdir/alt.err" ]; + my $env = { PI_CONFIG => '/dev/null' }; + $td = start_script($cmd, $env, { 3 => $sock, 4 => $unix, 5 => $alt }); }; $spawn_httpd->(); +{ + my $conn = conn_for($alt, 'alt PSGI path'); + $conn->write("GET / HTTP/1.0\r\n\r\n"); + $conn->read(my $buf, 4096); + like($buf, qr!^/path/to/alt\z!sm, + 'alt.psgi loaded on alt socket with correct env'); + + $conn = conn_for($sock, 'default PSGI path'); + $conn->write("GET /PI_CONFIG HTTP/1.0\r\n\r\n"); + $conn->read($buf, 4096); + like($buf, qr!^/dev/null\z!sm, + 'default PSGI on original socket'); + my $log = capture("$tmpdir/alt.err"); + ok(grep(/ALT/, @$log), 'alt psgi.errors written to'); + $log = capture($err); + ok(!grep(/ALT/, @$log), 'STDERR not written to'); + is(unlink($err, "$tmpdir/alt.err"), 2, 'unlinked stderr and alt.err'); + + $td->kill('USR1'); # trigger reopen_logs +} + if ('test worker death') { my $conn = conn_for($sock, 'killed worker'); $conn->write("GET /pid HTTP/1.1\r\nHost:example.com\r\n\r\n"); @@ -85,7 +111,16 @@ if ('test worker death') { like($body, qr/\A[0-9]+\z/, '/pid response'); isnt($body, $pid, 'respawned worker'); } - +{ # check on prior USR1 signal + ok(-e $err, 'stderr recreated after USR1'); + ok(-e "$tmpdir/alt.err", 'alt.err recreated after USR1'); +} +{ + my $conn = conn_for($sock, 'Header spaces bogus'); + $conn->write("GET /empty HTTP/1.1\r\nSpaced-Out : 3\r\n\r\n"); + $conn->read(my $buf, 4096); + like($buf, qr!\AHTTP/1\.[0-9] 400 !, 'got 400 response on bad request'); +} { my $conn = conn_for($sock, 'streaming callback'); $conn->write("GET /callback HTTP/1.0\r\n\r\n"); @@ -287,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; @@ -303,12 +338,12 @@ my $check_self = sub { }; SKIP: { - my $curl = which('curl') or skip('curl(1) missing', 4); + my $curl = require_cmd('curl', 1) or skip('curl(1) missing', 4); my $base = 'http://'.tcp_host_port($sock); 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 }; @@ -325,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) { @@ -333,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/, @@ -353,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'); @@ -592,42 +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; - my $var = PublicInbox::Daemon::SO_ACCEPTFILTER(); - defined(my $x = getsockopt($sock, SOL_SOCKET, $var)) or die; + require_mods '+accf_data'; + my $var = $PublicInbox::Daemon::SO_ACCEPTFILTER; + 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 = which('lsof') or skip 'no lsof in PATH', 1; - my $null_in = ''; - my $rdr = { 2 => \(my $null_err), 0 => \$null_in }; - my @lsof = xqx([$lsof, '-p', $td->{pid}], undef, $rdr); - is_deeply([grep(/\bdeleted\b/, @lsof)], [], 'no lingering deleted inputs'); + 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 @@ -643,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 b37492eb..bf086123 100644 --- a/t/httpd-https.t +++ b/t/httpd-https.t @@ -1,15 +1,15 @@ -# Copyright (C) 2019-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 Socket qw(SOCK_STREAM IPPROTO_TCP SOL_SOCKET); use PublicInbox::TestCommon; +use File::Copy qw(cp); # IO::Poll is part of the standard library, but distros may split them off... require_mods(qw(IO::Socket::SSL IO::Poll Plack::Util)); -my $cert = 'certs/server-cert.pem'; -my $key = 'certs/server-key.pem'; -unless (-r $key && -r $cert) { +my @certs = qw(certs/server-cert.pem certs/server-key.pem + certs/server2-cert.pem certs/server2-key.pem); +if (scalar(grep { -r $_ } @certs) != scalar(@certs)) { plan skip_all => "certs/ missing for $0, run $^X ./create-certs.perl in certs/"; } @@ -22,6 +22,20 @@ my $out = "$tmpdir/stdout.log"; my $https = tcp_server(); my $td; my $https_addr = tcp_host_port($https); +my $cert = "$tmpdir/cert.pem"; +my $key = "$tmpdir/key.pem"; +cp('certs/server-cert.pem', $cert) or xbail $!; +cp('certs/server-key.pem', $key) or xbail $!; + +my $check_url_scheme = sub { + my ($s, $line) = @_; + $s->print("GET /url_scheme HTTP/1.1\r\n\r\nHost: example.com\r\n\r\n") + or xbail "failed to write HTTP request: $! (line $line)"; + my $buf = ''; + sysread($s, $buf, 2007, length($buf)) until $buf =~ /\r\n\r\nhttps?/; + like($buf, qr!\AHTTP/1\.1 200!, "read HTTPS response (line $line)"); + like($buf, qr!\r\nhttps\z!, "psgi.url_scheme is 'https' (line $line)"); +}; for my $args ( [ "-lhttps://$https_addr/?key=$key,cert=$cert" ], @@ -53,11 +67,7 @@ for my $args ( # normal HTTPS my $c = tcp_connect($https); IO::Socket::SSL->start_SSL($c, %o); - ok($c->print("GET /empty HTTP/1.1\r\n\r\nHost: example.com\r\n\r\n"), - 'wrote HTTP request'); - my $buf = ''; - sysread($c, $buf, 2007, length($buf)) until $buf =~ /\r\n\r\n/; - like($buf, qr!\AHTTP/1\.1 200!, 'read HTTP response'); + $check_url_scheme->($c, __LINE__); # HTTPS with bad hostname $c = tcp_connect($https); @@ -80,7 +90,7 @@ for my $args ( $slow->blocking(1); ok($slow->print("GET /empty HTTP/1.1\r\n\r\nHost: example.com\r\n\r\n"), 'wrote HTTP request from slow'); - $buf = ''; + my $buf = ''; sysread($slow, $buf, 666, length($buf)) until $buf =~ /\r\n\r\n/; like($buf, qr!\AHTTP/1\.1 200!, 'read HTTP response from slow'); $slow = undef; @@ -92,17 +102,36 @@ 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; - my $var = PublicInbox::Daemon::SO_ACCEPTFILTER(); - my $x = getsockopt($https, SOL_SOCKET, $var); + ok(defined($PublicInbox::Daemon::SO_ACCEPTFILTER), + 'SO_ACCEPTFILTER defined'); + my $x = getsockopt($https, SOL_SOCKET, + $PublicInbox::Daemon::SO_ACCEPTFILTER); like($x, qr/\Adataready\0+\z/, 'got dataready accf for https'); }; - $c = undef; + # switch cert and key: + cp('certs/server2-cert.pem', $cert) or xbail $!; + cp('certs/server2-key.pem', $key) or xbail $!; + $td->kill('HUP') or xbail "kill: $!"; + tick(); # wait for SIGHUP to take effect (hopefully :x) + + my $d = tcp_connect($https); + $d = IO::Socket::SSL->start_SSL($d, %o); + is($d, undef, 'HTTPS fails with bad hostname after new cert on HUP'); + + $d = tcp_connect($https); + $o{SSL_hostname} = $o{SSL_verifycn_name} = 'server2.local'; + is(IO::Socket::SSL->start_SSL($d, %o), $d, + 'new hostname to match cert works after HUP'); + $check_url_scheme->($d, __LINE__); + + # existing connection w/ old cert still works: + $check_url_scheme->($c, __LINE__); + + undef $c; + undef $d; $td->kill; $td->join; is($?, 0, 'no error in exited process'); 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(); @@ -1,34 +1,28 @@ +#!perl -w # Copyright (C) 2016-2021 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::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(); my $home = "$tmpdir/pi-home"; my $err = "$tmpdir/stderr.log"; my $out = "$tmpdir/stdout.log"; -my $maindir = "$tmpdir/main.git"; +my $inboxdir = "$tmpdir/i.git"; my $group = 'test-httpd'; my $addr = $group . '@example.com'; -my $cfgpfx = "publicinbox.$group"; my $sock = tcp_server(); my $td; -use_ok 'PublicInbox::Git'; -use_ok 'PublicInbox::Import'; { - local $ENV{HOME} = $home; - my $cmd = [ '-init', $group, $maindir, 'http://example.com/', $addr ]; - ok(run_script($cmd), 'init ran properly'); - - # ensure successful message delivery - { - my $mime = PublicInbox::Eml->new(<<EOF); + create_inbox 'test', tmpdir => $inboxdir, sub { + my ($im, $ibx) = @_; + $im->add(PublicInbox::Eml->new(<<EOF)) or BAIL_OUT; From: Me <me\@example.com> To: You <you\@example.com> Cc: $addr @@ -38,12 +32,14 @@ Date: Thu, 01 Jan 1970 06:06:06 +0000 nntp EOF - - my $git = PublicInbox::Git->new($maindir); - my $im = PublicInbox::Import->new($git, 'test', $addr); - $im->add($mime); - $im->done($mime); - } + }; + my $i2 = create_inbox 'test-2', sub { + my ($im, $ibx) = @_; + $im->add(eml_load('t/plack-qp.eml')) or xbail '->add'; + }; + local $ENV{HOME} = $home; + my $cmd = [ '-init', $group, $inboxdir, 'http://example.com/', $addr ]; + ok(run_script($cmd), 'init ran properly'); $cmd = [ '-httpd', '-W0', "--stdout=$out", "--stderr=$err" ]; $td = start_script($cmd, undef, { 3 => $sock }); my $http_pfx = 'http://'.tcp_host_port($sock); @@ -53,7 +49,6 @@ EOF like(<$bad>, qr!\AHTTP/1\.[01] 405\b!, 'got 405 on bad req'); } my $conn = tcp_connect($sock); - ok($conn, 'connected'); ok($conn->write("GET / HTTP/1.0\r\n\r\n"), 'wrote data to socket'); { my $buf; @@ -67,13 +62,34 @@ EOF 0, 'smart clone successful'); # ensure dumb cloning works, too: - is(xsys('git', "--git-dir=$maindir", + is(xsys('git', "--git-dir=$inboxdir", qw(config http.uploadpack false)), 0, 'disable http.uploadpack'); is(xsys(qw(git clone -q --mirror), "$http_pfx/$group", "$tmpdir/dumb.git"), 0, 'clone successful'); + # test config reload + my $cfg = "$home/.public-inbox/config"; + open my $fh, '>>', $cfg or xbail "open: $!"; + print $fh <<EOM or xbail "print $!"; +[publicinbox "test-2"] + inboxdir = $i2->{inboxdir} + address = test-2\@example.com + url = https://example.com/test-2 +EOM + close $fh or xbail "close $!"; + $td->kill('HUP') or BAIL_OUT "failed to kill -httpd: $!"; + tick; # wait for HUP to take effect + my $buf = do { + my $c2 = tcp_connect($sock); + $c2->write("GET /test-2/qp\@example.com/raw HTTP/1.0\r\n\r\n") + or xbail "c2 write: $!"; + local $/; + <$c2> + }; + like($buf, qr!\AHTTP/1\.0 200\b!s, 'got 200 after reload for test-2'); + ok($td->kill, 'killed httpd'); $td->join; @@ -89,16 +105,13 @@ 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; - my $var = PublicInbox::Daemon::SO_ACCEPTFILTER(); - my $x = getsockopt($sock, SOL_SOCKET, $var); + ok(defined($PublicInbox::Daemon::SO_ACCEPTFILTER), + 'SO_ACCEPTFILTER defined'); + my $x = getsockopt($sock, SOL_SOCKET, + $PublicInbox::Daemon::SO_ACCEPTFILTER); like($x, qr/\Ahttpready\0+\z/, 'got httpready accf for HTTP'); }; -done_testing(); - -1; +done_testing; @@ -47,6 +47,10 @@ EOF is($html, $exp, 'only obfuscated relevant addresses'); +$exp = 'https://example.net/foo@example.net'; +PublicInbox::Hval::obfuscate_addrs($ibx, my $res = $exp); +is($res, $exp, 'does not obfuscate URL with Message-ID'); + is(PublicInbox::Hval::to_filename('foo bar '), 'foo-bar', 'to_filename has no trailing -'); @@ -1,21 +1,20 @@ #!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; -use Test::More; +use v5.10.1; use PublicInbox::TestCommon; require_git 2.6; -require_mods(qw(DBD::SQLite Email::Address::XS||Mail::Address - Parse::RecDescent)); +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 @@ -24,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", @@ -38,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 6b4121ea..d7840dd0 100644 --- a/t/imap_searchqp.t +++ b/t/imap_searchqp.t @@ -1,12 +1,13 @@ #!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 Test::More; +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(DBD::SQLite Email::Address::XS||Mail::Address - Parse::RecDescent)); +require_mods(qw(-imapd)); use_ok 'PublicInbox::IMAPsearchqp'; use_ok 'PublicInbox::IMAP'; @@ -29,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 ab90ddec..b95085a2 100644 --- a/t/imapd-tls.t +++ b/t/imapd-tls.t @@ -1,13 +1,11 @@ -# 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 warnings; -use Test::More; +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... -require_mods(qw(DBD::SQLite IO::Socket::SSL Mail::IMAPClient IO::Poll - Email::Address::XS||Mail::Address Parse::RecDescent)); +require_mods(qw(-imapd IO::Socket::SSL Mail::IMAPClient IO::Poll)); my $imap_client = 'Mail::IMAPClient'; $imap_client->can('starttls') or plan skip_all => 'Mail::IMAPClient does not support TLS'; @@ -25,50 +23,32 @@ unless (-r $key && -r $cert) { } use_ok 'PublicInbox::TLS'; use_ok 'IO::Socket::SSL'; -use PublicInbox::InboxWritable; -require PublicInbox::SearchIdx; my $version = 1; # v2 needs newer git require_git('2.6') if $version >= 2; my ($tmpdir, $for_destroy) = tmpdir(); my $err = "$tmpdir/stderr.log"; my $out = "$tmpdir/stdout.log"; -my $inboxdir = "$tmpdir"; -my $pi_config = "$tmpdir/pi_config"; +my $pi_config; my $group = 'test-imapd-tls'; my $addr = $group . '@example.com'; my $starttls = tcp_server(); my $imaps = tcp_server(); -my $ibx = PublicInbox::Inbox->new({ - inboxdir => $inboxdir, - name => 'imapd-tls', - version => $version, - -primary_address => $addr, - indexlevel => 'basic', -}); -$ibx = PublicInbox::InboxWritable->new($ibx, {nproc=>1}); -$ibx->init_inbox(0); -{ +my $ibx = create_inbox 'imapd-tls', version => $version, + -primary_address => $addr, indexlevel => 'basic', sub { + my ($im, $ibx) = @_; + $im->add(eml_load('t/data/0001.patch')) or BAIL_OUT '->add'; + $pi_config = "$ibx->{inboxdir}/pi_config"; open my $fh, '>', $pi_config or BAIL_OUT "open: $!"; - print $fh <<EOF + print $fh <<EOF or BAIL_OUT "print: $!"; [publicinbox "imapd-tls"] - inboxdir = $inboxdir + inboxdir = $ibx->{inboxdir} address = $addr indexlevel = basic newsgroup = $group EOF - ; close $fh or BAIL_OUT "close: $!\n"; -} - -{ - my $im = $ibx->importer(0); - ok($im->add(eml_load('t/data/0001.patch')), 'message added'); - $im->done; - if ($version == 1) { - my $s = PublicInbox::SearchIdx->new($ibx, 1); - $s->index_sync; - } -} +}; +$pi_config //= "$ibx->{inboxdir}/pi_config"; my $imaps_addr = tcp_host_port($imaps); my $starttls_addr = tcp_host_port($starttls); @@ -174,6 +154,24 @@ for my $args ( ok(sysread($slow, my $end, 4096) > 0, 'got end'); is(sysread($slow, my $eof, 4096), 0, 'got EOF'); + test_lei(sub { + lei_ok qw(ls-mail-source), "imap://$starttls_addr", + \'STARTTLS not used by default'; + 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: { skip 'TCP_DEFER_ACCEPT is Linux-only', 2 if $^O ne 'linux'; my $var = eval { Socket::TCP_DEFER_ACCEPT() } // 9; @@ -183,15 +181,13 @@ 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 $var = PublicInbox::Daemon::SO_ACCEPTFILTER(); - my $x = getsockopt($imaps, SOL_SOCKET, $var); + my $x = getsockopt($imaps, SOL_SOCKET, + $PublicInbox::Daemon::SO_ACCEPTFILTER); like($x, qr/\Adataready\0+\z/, 'got dataready accf for IMAPS'); - $x = getsockopt($starttls, IPPROTO_TCP, $var); + $x = getsockopt($starttls, IPPROTO_TCP, + $PublicInbox::Daemon::SO_ACCEPTFILTER); is($x, undef, 'no BSD accept filter for plain IMAP'); }; @@ -1,15 +1,14 @@ #!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> # 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; -use PublicInbox::Spawn qw(which); -require_mods(qw(DBD::SQLite Mail::IMAPClient Mail::IMAPClient::BodyStructure - Email::Address::XS||Mail::Address Parse::RecDescent)); +require_mods(qw(-imapd Mail::IMAPClient)); my $imap_client = 'Mail::IMAPClient'; my $can_compress = $imap_client->can('compress'); if ($can_compress) { # hope this gets fixed upstream, soon @@ -22,7 +21,7 @@ my $first_range = '0'; my $level = 'basic'; SKIP: { - require_mods('Search::Xapian', 1); + require_mods('Xapian', 1); $level = 'medium'; }; @@ -31,30 +30,34 @@ push(@V, 2) if require_git('2.6', 1); my ($tmpdir, $for_destroy) = tmpdir(); my $home = "$tmpdir/home"; -local $ENV{HOME} = $home; - +BAIL_OUT "mkdir: $!" unless (mkdir($home) and mkdir("$home/.public-inbox")); +my @ibx; +open my $cfgfh, '>', "$home/.public-inbox/config" or BAIL_OUT; +print $cfgfh <<EOM or BAIL_OUT; +[publicinboxmda] + spamcheck = none +EOM +my $eml; for my $V (@V) { - my $addr = "i$V\@example.com"; - my $name = "i$V"; - my $url = "http://example.com/i$V"; - my $inboxdir = "$tmpdir/$name"; - my $folder = "inbox.i$V"; - my $cmd = ['-init', "-V$V", "-L$level", "--ng=$folder", - $name, $inboxdir, $url, $addr]; - run_script($cmd) or BAIL_OUT("init $name"); - if ($V == 1) { - xsys(qw(git config), "--file=$ENV{HOME}/.public-inbox/config", - 'publicinboxmda.spamcheck', 'none') == 0 or - BAIL_OUT("config: $?"); - } - open(my $fh, '<', 't/utf8.eml') or BAIL_OUT("open t/utf8.eml: $!"); - my $env = { ORIGINAL_RECIPIENT => $addr }; - run_script(['-mda', '--no-precheck'], $env, { 0 => $fh }) or - BAIL_OUT('-mda delivery'); - if ($V == 1) { - run_script(['-index', $inboxdir]) or BAIL_OUT("index $?"); - } + my $ibx = create_inbox("i$V-$level", + tmpdir => "$tmpdir/i$V", version => $V, + indexlevel => $level, sub { + my ($im) = @_; + $im->add($eml //= eml_load('t/utf8.eml')) or BAIL_OUT; + }); + push @ibx, $ibx; + $ibx->{newsgroup} = "inbox.i$V"; + print $cfgfh <<EOF or BAIL_OUT; +[publicinbox "i$V"] + inboxdir = $ibx->{inboxdir} + address = $ibx->{-primary_address}; + newsgroup = inbox.i$V + url = http://example.com/i$V + indexlevel = $level +EOF } +close $cfgfh or BAIL_OUT; +local $ENV{HOME} = $home; my $sock = tcp_server(); my $err = "$tmpdir/stderr.log"; my $out = "$tmpdir/stdout.log"; @@ -97,7 +100,8 @@ ok($mic->examine($mailbox1), 'EXAMINE succeeds'); my @raw = $mic->status($mailbox1, qw(Messages uidnext uidvalidity)); is(scalar(@raw), 2, 'got status response'); like($raw[0], qr/\A\*\x20STATUS\x20inbox\.i1\.$first_range\x20 - \(MESSAGES\x20\d+\x20UIDNEXT\x20\d+\x20UIDVALIDITY\x20\d+\)\r\n/sx); + \(MESSAGES\x20[1-9][0-9]*\x20 + UIDNEXT\x20\d+\x20UIDVALIDITY\x20\d+\)\r\n/sx); like($raw[1], qr/\A\S+ OK /, 'finished status response'); my @orig_list = @raw = $mic->list; @@ -246,12 +250,9 @@ SKIP: { ok($mic->logout, 'logout works'); -my $have_inotify = eval { require Linux::Inotify2; 1 }; +my $have_inotify = eval { require PublicInbox::Inotify; 1 }; -my $pi_cfg = PublicInbox::Config->new; -$pi_cfg->each_inbox(sub { - my ($ibx) = @_; - my $env = { ORIGINAL_RECIPIENT => $ibx->{-primary_address} }; +for my $ibx (@ibx) { my $name = $ibx->{name}; my $ng = $ibx->{newsgroup}; my $mic = $imap_client->new(%mic_opt); @@ -263,10 +264,9 @@ $pi_cfg->each_inbox(sub { ok(!$mic->idle, "IDLE fails w/o SELECT/EXAMINE $name"); ok($mic->examine($mb), "EXAMINE $ng succeeds"); ok(my $idle_tag = $mic->idle, "IDLE succeeds on $ng"); - - open(my $fh, '<', 't/data/message_embed.eml') or BAIL_OUT("open: $!"); - run_script(['-mda', '--no-precheck'], $env, { 0 => $fh }) or - BAIL_OUT('-mda delivery'); + my $im = $ibx->importer(0); + $im->add(eml_load 't/data/message_embed.eml') or BAIL_OUT; + $im->done; my $t0 = Time::HiRes::time(); ok(my @res = $mic->idle_data(11), "IDLE succeeds on $ng"); is(grep(/\A\* [0-9] EXISTS\b/, @res), 1, 'got EXISTS message'); @@ -299,9 +299,8 @@ $pi_cfg->each_inbox(sub { "connection $n works after HUP"); } - open($fh, '<', 't/data/0001.patch') or BAIL_OUT("open: $!"); - run_script(['-mda', '--no-precheck'], $env, { 0 => $fh }) or - BAIL_OUT('-mda delivery'); + $im->add(eml_load 't/data/0001.patch') or BAIL_OUT; + $im->done; $t0 = Time::HiRes::time(); ok(@res = $mic->idle_data(11), "IDLE succeeds on $ng after HUP"); is(grep(/\A\* [0-9] EXISTS\b/, @res), 1, 'got EXISTS message'); @@ -356,7 +355,7 @@ EOF my $ret = $mic->fetch_hash(2, 'RFC822'); is_deeply($ret, {}, 'MSN FETCH on empty dummy will not trigger warnings, later'); -}); # each_inbox +}; # for @ibx # message sequence numbers :< is($mic->Uid(0), 0, 'disable UID on '.ref($mic)); @@ -438,18 +437,59 @@ 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::Watch'; 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 $!; mkdir "$home/.public-inbox" or BAIL_OUT $!; local $ENV{HOME} = $home; my $name = 'watchimap'; - my $addr = "i1\@example.com"; + my $addr = "i1-$level\@example.com"; my $url = "http://example.com/i1"; my $inboxdir = "$tmpdir/watchimap"; my $cmd = ['-init', '-V2', '-Lbasic', $name, $inboxdir, $url, $addr]; @@ -461,26 +501,27 @@ 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->EventLoop; + 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'); + 'delivered a message for IDLE to kick -watch') or + diag "mda error \$?=$?"; diag 'waiting for IMAP IDLE wakeup'; - PublicInbox::DS->SetPostLoopCallback(undef); - PublicInbox::DS->EventLoop; + @PublicInbox::DS::post_loop_do = (); + PublicInbox::DS::event_loop(); diag 'inbox unlocked on IDLE wakeup'; # try again with polling @@ -489,15 +530,16 @@ 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->EventLoop; + @PublicInbox::DS::post_loop_do = (); + PublicInbox::DS::event_loop(); diag 'inbox unlocked (poll)'; $w->kill; $w->join; @@ -506,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); @@ -531,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'; }; @@ -13,7 +13,7 @@ is($x->base_url, 'http://example.com/test/', 'added trailing slash'); $x = PublicInbox::Inbox->new({}); is($x->base_url, undef, 'undef base_url allowed'); -my $tmpdir = File::Temp->newdir('pi-inbox-XXXXXX', TMPDIR => 1); +my $tmpdir = File::Temp->newdir('pi-inbox-XXXX', TMPDIR => 1); $x->{inboxdir} = $tmpdir->dirname; is_deeply($x->cloneurl, [], 'no cloneurls'); is($x->description, '($INBOX_DIR/description missing)', 'default description'); @@ -32,4 +32,11 @@ is(unlink(glob("$x->{inboxdir}/*")), 2, 'unlinked cloneurl & description'); is_deeply($x->cloneurl, ['https://example.com/inbox'], 'cloneurls memoized'); is($x->description, "\x{100}blah", 'description memoized'); +$x->{name} = "2\x{100}wide"; +$x->{newsgroup} = '2.wide'; +like($x->mailboxid, qr/\AM32c48077696465-[0-9a-f]+\z/, + '->mailboxid w/o slice (JMAP)'); +like($x->mailboxid(78), qr/\AM322e77696465-4e-[0-9a-f]+\z/, + '->mailboxid w/ slice (IMAP)'); + done_testing(); diff --git a/t/inbox_idle.t b/t/inbox_idle.t index 27facfe9..0ccffab7 100644 --- a/t/inbox_idle.t +++ b/t/inbox_idle.t @@ -1,41 +1,34 @@ #!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 Test::More; +use v5.12; use PublicInbox::TestCommon; -use PublicInbox::Config; require_git 2.6; require_mods(qw(DBD::SQLite)); require PublicInbox::SearchIdx; use_ok 'PublicInbox::InboxIdle'; -use PublicInbox::InboxWritable; my ($tmpdir, $for_destroy) = tmpdir(); for my $V (1, 2) { my $inboxdir = "$tmpdir/$V"; - mkdir $inboxdir or BAIL_OUT("mkdir: $!"); - my %opt = ( - inboxdir => $inboxdir, - name => 'inbox-idle', - version => $V, - -primary_address => 'test@example.com', - indexlevel => 'basic', - ); - my $ibx = PublicInbox::Inbox->new({ %opt }); - $ibx = PublicInbox::InboxWritable->new($ibx); - my $obj = InboxIdleTestObj->new; - $ibx->init_inbox(0); - my $im = $ibx->importer(0); - if ($V == 1) { + my $ibx = create_inbox "idle$V", tmpdir => $inboxdir, version => $V, + indexlevel => 'basic', -no_gc => 1, sub { + my ($im, $ibx) = @_; # capture + $im->done; + $ibx->init_inbox(0); + $_[0] = undef; + return if $V != 1; my $sidx = PublicInbox::SearchIdx->new($ibx, 1); $sidx->idx_acquire; $sidx->set_metadata_once; $sidx->idx_release; # allow watching on lockfile - } - my $pi_cfg = PublicInbox::Config->new(\<<EOF); -publicinbox.inbox-idle.inboxdir=$inboxdir -publicinbox.inbox-idle.indexlevel=basic -publicinbox.inbox-idle.address=test\@example.com + }; + my $obj = InboxIdleTestObj->new; + 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) }); @@ -45,15 +38,14 @@ EOF skip('inotify or kqueue missing', 1) unless $ii->{sock}; ok(fileno($ii->{sock}) >= 0, 'fileno() gave valid FD'); } + my $im = $ibx->importer(0); ok($im->add(eml_load('t/utf8.eml')), "$V added"); $im->done; - PublicInbox::SearchIdx->new($ibx)->index_sync if $V == 1; $ii->event_step; is(scalar @{$obj->{called}}, 1, 'called on unlock'); $pi_cfg->each_inbox(sub { shift->unsubscribe_unlock($ident) }); ok($im->add(eml_load('t/data/0001.patch')), "$V added #2"); $im->done; - PublicInbox::SearchIdx->new($ibx)->index_sync if $V == 1; $ii->event_step; is(scalar @{$obj->{called}}, 1, 'not called when unsubbed'); $ii->close; diff --git a/t/index-git-times.t b/t/index-git-times.t index 3cfb99f4..eac2d650 100644 --- a/t/index-git-times.t +++ b/t/index-git-times.t @@ -1,42 +1,44 @@ #!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(); local $ENV{PI_CONFIG} = "$tmpdir/cfg"; my $v1dir = "$tmpdir/v1"; my $addr = 'x@example.com'; +my $default_branch = PublicInbox::Import::default_branch; run_script(['-init', '--indexlevel=medium', 'v1', $v1dir, 'http://example.com/x', $addr]) or die "init failed"; { - my $data = <<'EOF'; + my $data = <<"EOF"; blob mark :1 data 133 -From: timeless <t@example.com> -To: x <x@example.com> +From: timeless <t\@example.com> +To: x <x\@example.com> Subject: can I haz the time? -Message-ID: <19700101000000-1234@example.com> +Message-ID: <19700101000000-1234\@example.com> plz -reset refs/heads/master -commit refs/heads/master +reset $default_branch +commit $default_branch mark :2 -author timeless <t@example.com> 749520000 +0100 -committer x <x@example.com> 1285977600 -0100 +author timeless <t\@example.com> 749520000 +0100 +committer x <x\@example.com> 1285977600 -0100 data 20 can I haz the time? M 100644 :1 53/256f6177504c2878d3a302ef5090dacf5e752c @@ -56,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); @@ -72,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 53826aef..c852f72c 100644 --- a/t/indexlevels-mirror.t +++ b/t/indexlevels-mirror.t @@ -1,13 +1,12 @@ -# Copyright (C) 2019-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::TestCommon; use PublicInbox::Eml; -use PublicInbox::Inbox; use PublicInbox::InboxWritable; require PublicInbox::Admin; -use PublicInbox::TestCommon; my $PI_TEST_VERSION = $ENV{PI_TEST_VERSION} || 2; require_git('2.6') if $PI_TEST_VERSION == 2; require_mods(qw(DBD::SQLite)); @@ -26,28 +25,23 @@ my $import_index_incremental = sub { my $err = ''; my $this = "pi-$v-$level-indexlevels"; my ($tmpdir, $for_destroy) = tmpdir(); + my $ibx = create_inbox "testbox$v", indexlevel => $level, + version => $v, tmpdir => "$tmpdir/v$v", sub { + $mime->header_set('Message-ID', '<m@1>'); + $_[0]->add($mime) or BAIL_OUT; + }; + my $im = $ibx->importer(0); local $ENV{PI_CONFIG} = "$tmpdir/config"; - my $ibx = PublicInbox::Inbox->new({ - inboxdir => "$tmpdir/testbox", - name => $this, - version => $v, - -primary_address => 'test@example.com', - indexlevel => $level, - }); - my $im = PublicInbox::InboxWritable->new($ibx, {nproc=>1})->importer(0); - $mime->header_set('Message-ID', '<m@1>'); - ok($im->add($mime), 'first message added'); - $im->done; # index master (required for v1) - my @cmd = (qw(-index -j0), $ibx->{inboxdir}, "-L$level"); + my @cmd = (qw(-index -j0 --dangerous), $ibx->{inboxdir}, "-L$level"); push @cmd, '-c' if have_xapian_compact; ok(run_script(\@cmd, undef, { 2 => \$err }), 'index master'); my $ro_master = PublicInbox::Inbox->new({ 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'); @@ -77,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'); @@ -89,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'); @@ -97,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'); @@ -116,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'); @@ -126,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'); @@ -158,13 +153,14 @@ 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: { skip 'xapian-compact missing', 1 if !have_xapian_compact; my $cmd = [ qw(-compact), $mirror ]; - ok(run_script($cmd, undef, { 2 => \$err}), "compact $level"); + ok(run_script($cmd, undef, { 2 => \$err}), "compact $level") + or diag $err; } }; @@ -172,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,12 +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 File::Basename; +use PublicInbox::InboxWritable; my ($tmpdir, $for_destroy) = tmpdir(); sub quiet_fail { my ($cmd, $msg) = @_; @@ -19,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'); @@ -48,6 +52,40 @@ sub quiet_fail { is($? >> 8, 255, 'got expected exit code on lock failure'); ok(unlink("$cfgfile.lock"), '-init did not unlink lock on failure'); + + my @init_args = ('i', "$tmpdir/i", + qw(http://example.com/i i@example.com)); + $cmd = [ qw(-init -c .bogus=val), @init_args ]; + quiet_fail($cmd, 'invalid -c KEY=VALUE fails'); + $cmd = [ qw(-init -c .bogus=val), @init_args ]; + quiet_fail($cmd, '-c KEY-only fails'); + $cmd = [ qw(-init -c address=clist@example.com), @init_args ]; + quiet_fail($cmd, '-c address=CONFLICTING-VALUE fails'); + + $cmd = [ qw(-init -c no=problem -c no=problemo), @init_args ]; + ok(run_script($cmd), '-c KEY=VALUE runs'); + my $env = { GIT_CONFIG => "$ENV{PI_DIR}/config" }; + chomp(my @v = xqx([qw(git config --get-all publicinbox.i.no)], $env)); + is_deeply(\@v, [ qw(problem problemo) ]) or xbail(\@v); + + ok(run_script($cmd), '-c KEY=VALUE runs idempotently'); + chomp(my @v2 = xqx([qw(git config --get-all publicinbox.i.no)], $env)); + is_deeply(\@v, \@v2, 'nothing repeated') or xbail(\@v2); + + ok(run_script([@$cmd, '-c', 'no=more']), '-c KEY=VALUE addendum'); + chomp(@v = xqx([qw(git config --get-all publicinbox.i.no)], $env)); + is_deeply(\@v, [ qw(problem problemo more) ]) or xbail(\@v); + + + ok(run_script([@$cmd, '-c', 'no=problem']), '-c KEY=VALUE repeated'); + chomp(@v = xqx([qw(git config --get-all publicinbox.i.no)], $env)); + is_deeply(\@v, [ qw(problem problemo more) ]) or xbail(\@v); + + ok(run_script([@$cmd, '-c', 'address=j@example.com']), + '-c KEY=VALUE address'); + chomp(@v = xqx([qw(git config --get-all publicinbox.i.address)], $env)); + is_deeply(\@v, [ qw(i@example.com j@example.com) ], + 'extra address added via -c KEY=VALUE'); } { my $env = { PI_DIR => "$tmpdir/.public-inbox/" }; @@ -64,8 +102,17 @@ sub quiet_fail { $cmd = [ '-init', 'deep-non-existent', "$tmpdir/a/b/c/d", qw(http://example.com/abcd abcd@example.com) ]; $err = ''; + my $umask = umask(022) // xbail "umask: $!"; ok(run_script($cmd, $env, $rdr), 'initializes non-existent hierarchy'); + umask($umask) // xbail "umask: $!"; ok(-d "$tmpdir/a/b/c/d", 'directory created'); + my $desc = "$tmpdir/a/b/c/d/description"; + 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', + 'description respects umask'); + open my $fh, '>', "$tmpdir/d" or BAIL_OUT "open: $!"; close $fh; $cmd = [ '-init', 'd-f-conflict', "$tmpdir/d/f/conflict", @@ -74,8 +121,8 @@ sub quiet_fail { } SKIP: { - require_mods(qw(DBD::SQLite Search::Xapian::WritableDatabase), 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"; @@ -105,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'); } @@ -117,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'); @@ -163,11 +210,20 @@ SKIP: { $err = ''; ok(run_script([qw(-mda --no-precheck)], $env, $rdr), 'deliver V1'); diag "err=$err" if $err; - $mm = PublicInbox::Msgmap->new("$tmpdir/skip4"); + $mm = PublicInbox::Msgmap->new_file( + "$tmpdir/skip4/public-inbox/msgmap.sqlite3"); $n = $mm->num_for($mid); 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) { @@ -122,20 +121,30 @@ for my $t ('local', 'worker', 'worker again') { $ipc->wq_io_do('test_sha', [ $wa, $wb ], 'hello world'); is(readline($rb), sha1_hex('hello world')."\n", "SHA small ($t)"); { - my $bigger = $big x 10; + my $bigger = $big x 10; # to hit EMSGSIZE $ipc->wq_io_do('test_sha', [ $wa, $wb ], $bigger); my $exp = sha1_hex($bigger)."\n"; - undef $bigger; - is(readline($rb), $exp, "SHA big ($t)"); + is(readline($rb), $exp, "SHA big for EMSGSIZE ($t)"); + + # to hit the WQWorker recv_and_run length + substr($bigger, my $MY_MAX_ARG_STRLEN = 4096 * 33, -1) = ''; + $ipc->wq_io_do('test_sha', [ $wa, $wb ], $bigger); + $exp = sha1_hex($bigger)."\n"; + is(readline($rb), $exp, "SHA WQWorker limit ($t)"); + } + 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)"); } - my $ppid = $ipc->wq_workers_start('wq', 1); - push(@ppids, $ppid); } # 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) { @@ -156,6 +165,12 @@ SKIP: { is(waitpid($pid, 0), $pid, 'waitpid complete'); is($?, 0, 'child wq producer exited'); } + my @ary = $ipc->wq_do('test_array'); + is_deeply(\@ary, [ qw(test array) ], 'wq_do wantarray'); + is(my $s = $ipc->wq_do('test_scalar'), 'scalar', 'defined wantarray'); + my $exp = bless ['blessed'], 'PublicInbox::WTF'; + my $ret = eval { $ipc->wq_do('test_die', $exp) }; + is_deeply($@, $exp, 'die with blessed ref'); } $ipc->wq_close; @@ -163,30 +178,18 @@ 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', 1), $$, 'workers started again'); - is($ipc->wq_workers, 1, '1 worker started'); - - $ipc->wq_worker_incr; - is($ipc->wq_workers, 2, 'worker count bumped'); - $ipc->wq_worker_decr; - $ipc->wq_worker_decr_wait(10); - is($ipc->wq_workers, 1, 'worker count lowered'); - is($ipc->wq_workers(2), 2, 'worker count set'); - is($ipc->wq_workers, 2, 'worker count stayed set'); - + is($ipc->wq_workers_start('wq', 2), $$, 'workers started again'); $ipc->wq_broadcast('test_append_pid', "$tmpdir/append_pid"); $ipc->wq_close; open my $fh, '<', "$tmpdir/append_pid" or BAIL_OUT "open: $!"; chomp(my @pids = <$fh>); my %pids = map { $_ => 1 } grep(/\A[0-9]+\z/, @pids); is(scalar keys %pids, 2, 'broadcast hit both PIDs'); - is($ipc->wq_workers, undef, 'workers undef after close'); } done_testing; 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 new file mode 100644 index 00000000..1e190316 --- /dev/null +++ b/t/lei-auto-watch.t @@ -0,0 +1,49 @@ +#!perl -w +# Copyright 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::Basename qw(basename); +plan skip_all => "TEST_FLAKY not enabled for $0" if !$ENV{TEST_FLAKY}; +my $have_fast_inotify = eval { require PublicInbox::Inotify } || + eval { require IO::KQueue }; +$have_fast_inotify or + diag("$0 IO::KQueue or inotify missing, test will be slow"); + +test_lei(sub { + my ($ro_home, $cfg_path) = setup_public_inboxes; + my $x = "$ENV{HOME}/x"; + my $y = "$ENV{HOME}/y"; + lei_ok qw(add-external), "$ro_home/t1"; + lei_ok qw(q mid:testmessage@example.com -o), $x; + lei_ok qw(q mid:testmessage@example.com -o), $y; + my @x = glob("$x/cur/*"); + my @y = glob("$y/cur/*"); + scalar(@x) == 1 or xbail 'expected 1 file', \@x; + scalar(@y) == 1 or xbail 'expected 1 file', \@y; + + my $oid = '9bf1002c49eb075df47247b74d69bcd555e23422'; + lei_ok qw(inspect), "blob:$oid"; + my $ins = json_utf8->decode($lei_out); + my $exp = { "maildir:$x" => [ map { basename($_) } @x ], + "maildir:$y" => [ map { basename($_) } @y ] }; + is_deeply($ins->{'mail-sync'}, $exp, 'inspect as expected'); + lei_ok qw(add-watch), $x; + my $dst = $x[0] . 'S'; + rename($x[0], $dst) or xbail "rename($x[0], $dst): $!"; + my $ys = "$y[0]S"; + for (0..50) { + last if -f $ys; + tick; # wait for inotify or kevent + } + my @y2 = glob("$y/*/*"); + is_deeply(\@y2, [ $ys ], "`seen' kw propagated to `y' dir"); + lei_ok qw(note-event done); + lei_ok qw(inspect), "blob:$oid"; + $ins = json_utf8->decode($lei_out); + $exp = { "maildir:$x" => [ map { basename($_) } glob("$x/*/*") ], + "maildir:$y" => [ map { basename($_) } glob("$y/*/*") ] }; + is_deeply($ins->{'mail-sync'}, $exp, 'mail_sync matches FS') or + diag explain($ins); +}); + +done_testing; diff --git a/t/lei-convert.t b/t/lei-convert.t index 20099f65..4670e47f 100644 --- a/t/lei-convert.t +++ b/t/lei-convert.t @@ -1,13 +1,17 @@ #!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; -require_git 2.6; -require_mods(qw(DBD::SQLite Search::Xapian Mail::IMAPClient Net::NNTP)); +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; my $cmd = [ '-imapd', '-W0', "--stdout=$tmpdir/i1", "--stderr=$tmpdir/i2" ]; @@ -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://'); @@ -57,10 +89,11 @@ test_lei({ tmpdir => $tmpdir }, sub { lei_ok('convert', '-o', "$d/md", "mboxrd:$d/foo.mboxrd"); ok(-d "$d/md", 'Maildir created'); my @md; - PublicInbox::MdirReader::maildir_each_eml("$d/md", sub { - push @md, $_[1]; + PublicInbox::MdirReader->new->maildir_each_eml("$d/md", sub { + push @md, $_[2]; }); - is(scalar(@md), scalar(@mboxrd), 'got expected emails in Maildir'); + is(scalar(@md), scalar(@mboxrd), 'got expected emails in Maildir') or + diag $lei_err; @md = sort { ${$a->{bdy}} cmp ${$b->{bdy}} } @md; @mboxrd = sort { ${$a->{bdy}} cmp ${$b->{bdy}} } @mboxrd; my @rd_nostatus = map { @@ -86,18 +119,103 @@ test_lei({ tmpdir => $tmpdir }, sub { my $exp = do { local $/; <$fh> }; is($out, $exp, 'stdin => stdout'); - lei_ok qw(convert -F eml -o mboxcl2:/dev/stdout t/plack-qp.eml); + lei_ok qw(convert -F eml -o mboxcl2:/dev/fd/1 t/plack-qp.eml); open $fh, '<', \$lei_out or BAIL_OUT; @bar = (); PublicInbox::MboxReader->mboxcl2($fh, sub { my $eml = shift; - for my $h (qw(Status Content-Length Lines)) { + for my $h (qw(Content-Length Lines)) { ok(defined($eml->header_raw($h)), "$h defined for mboxcl2"); $eml->header_set($h); } push @bar, $eml; }); - is_deeply(\@bar, [ eml_load('t/plack-qp.eml') ], 'eml => mboxcl2'); + my $qp_eml = eml_load('t/plack-qp.eml'); + $qp_eml->header_set('Status', 'O'); + is_deeply(\@bar, [ $qp_eml ], 'eml => mboxcl2'); + + lei_ok qw(convert t/plack-qp.eml -o), "mboxrd:$d/qp.gz"; + open $fh, '<', "$d/qp.gz" or xbail $!; + ok(-s $fh, 'not empty'); + $fh = IO::Uncompress::Gunzip->new($fh, MultiStream => 1); + @bar = (); + PublicInbox::MboxReader->mboxrd($fh, sub { push @bar, shift }); + is_deeply(\@bar, [ $qp_eml ], 'wrote gzipped mboxrd'); + lei_ok qw(convert -o mboxrd:/dev/stdout), "mboxrd:$d/qp.gz"; + open $fh, '<', \$lei_out or xbail; + @bar = (); + PublicInbox::MboxReader->mboxrd($fh, sub { push @bar, shift }); + is_deeply(\@bar, [ $qp_eml ], 'readed gzipped mboxrd'); + + # Status => Maildir flag => Status round trip + $lei_out =~ s/^Status: O/Status: RO/sm or xbail "`seen' Status"; + $rdr = { 0 => \($in = $lei_out), %$lei_opt }; + lei_ok([qw(convert -F mboxrd -o), "$d/md2"], undef, $rdr); + @md = glob("$d/md2/*/*"); + is(scalar(@md), 1, 'one message'); + 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 c30e5ac1..d97e494a 100644 --- a/t/lei-daemon.t +++ b/t/lei-daemon.t @@ -1,27 +1,55 @@ #!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 Socket qw(AF_UNIX SOCK_SEQPACKET pack_sockaddr_un); test_lei({ daemon_only => 1 }, sub { + my $send_cmd = PublicInbox::Spawn->can('send_cmd4') // do { + require PublicInbox::CmdIPC4; + PublicInbox::CmdIPC4->can('send_cmd4'); + } // do { + require PublicInbox::Syscall; + PublicInbox::Syscall->can('send_cmd4'); + }; + $send_cmd or BAIL_OUT 'started testing lei-daemon w/o send_cmd4!'; + my $sock = "$ENV{XDG_RUNTIME_DIR}/lei/5.seq.sock"; my $err_log = "$ENV{XDG_RUNTIME_DIR}/lei/errors.log"; lei_ok('daemon-pid'); + ignore_inline_c_missing($lei_err); 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'); - open my $efh, '>>', $err_log or BAIL_OUT $!; - print $efh "phail\n" or BAIL_OUT $!; - close $efh or BAIL_OUT $!; - lei_ok('daemon-pid'); chomp(my $pid_again = $lei_out); is($pid, $pid_again, 'daemon-pid idempotent'); - like($lei_err, qr/phail/, 'got mock "phail" error previous run'); + SKIP: { + skip 'only testing open files on Linux', 1 if $^O ne 'linux'; + my $d = "/proc/$pid/fd"; + 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: $!"; + my @fds = map { fileno($null) } (0..2); + for (0..10) { + socket(my $c, AF_UNIX, SOCK_SEQPACKET, 0) or + BAIL_OUT "socket: $!"; + connect($c, $addr) or BAIL_OUT "connect: $!"; + $send_cmd->($c, \@fds, 'hi', 0); + } + lei_ok('daemon-pid'); + chomp($pid = $lei_out); + is($pid, $pid_again, 'pid unchanged after failed reqs'); + my @after = sort(glob("$d/*")); + is_deeply(\@before, \@after, 'open files unchanged') or + diag explain([\@before, \@after]);; + } lei_ok(qw(daemon-kill)); is($lei_out, '', 'no output from daemon-kill'); is($lei_err, '', 'no error from daemon-kill'); @@ -44,14 +72,6 @@ test_lei({ daemon_only => 1 }, sub { lei_ok('daemon-pid'); chomp $lei_out; is($lei_out, $new_pid, 'PID unchanged after -0/-CHLD'); - - if ('socket inaccessible') { - chmod 0000, $sock or BAIL_OUT "chmod 0000: $!"; - lei_ok('help', \'connect fail, one-shot fallback works'); - like($lei_err, qr/\bconnect\(/, 'connect error noted'); - like($lei_out, qr/^usage: /, 'help output works'); - chmod 0700, $sock or BAIL_OUT "chmod 0700: $!"; - } unlink $sock or BAIL_OUT "unlink($sock) $!"; for (0..100) { kill('CHLD', $new_pid) or last; diff --git a/t/lei-export-kw.t b/t/lei-export-kw.t new file mode 100644 index 00000000..88b2a80b --- /dev/null +++ b/t/lei-export-kw.t @@ -0,0 +1,51 @@ +#!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 File::Copy qw(cp); +use File::Path qw(make_path); +require_mods(qw(lei)); # see lei-import-imap.t for IMAP tests +my ($tmpdir, $for_destroy) = tmpdir; +my $expect = eml_load('t/data/0001.patch'); +my $do_export_kw = 1; +my $wait_for = sub { + my ($f) = @_; + lei_ok qw(export-kw --all=local) if $do_export_kw; + my $x = $f; + $x =~ s!\Q$tmpdir\E/!\$TMPDIR/!; + for (0..10) { + last if -f $f; + diag "tick #$_ $x"; + tick(0.1); + } + ok(-f $f, "$x exists") or xbail; +}; + +test_lei({ tmpdir => $tmpdir }, sub { + my $home = $ENV{HOME}; + my $md = "$home/md"; + my $f; + make_path("$md/new", "$md/cur", "$md/tmp"); + cp('t/data/0001.patch', "$md/new/y") or xbail "cp $md $!"; + cp('t/data/message_embed.eml', "$md/cur/x:2,S") or xbail "cp $md $!"; + lei_ok qw(index), $md; + lei_ok qw(tag t/data/0001.patch +kw:seen); + $wait_for->($f = "$md/cur/y:2,S"); + ok(!-e "$md/new/y", 'original gone') or + diag explain([glob("$md/*/*")]); + is_deeply(eml_load($f), $expect, "`seen' kw exported"); + + lei_ok qw(tag t/data/0001.patch +kw:answered); + $wait_for->($f = "$md/cur/y:2,RS"); + ok(!-e "$md/cur/y:2,S", 'seen-only file gone') or + diag explain([glob("$md/*/*")]); + is_deeply(eml_load($f), $expect, "`R' added"); + + lei_ok qw(tag t/data/0001.patch -kw:answered -kw:seen); + $wait_for->($f = "$md/cur/y:2,"); + ok(!-e "$md/cur/y:2,RS", 'seen+answered file gone') or + diag explain([glob("$md/*/*")]); + is_deeply(eml_load($f), $expect, 'no keywords left'); +}); + +done_testing; diff --git a/t/lei-externals.t b/t/lei-externals.t index d422a9d1..4f2dd6ba 100644 --- a/t/lei-externals.t +++ b/t/lei-externals.t @@ -3,31 +3,72 @@ # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; use PublicInbox::TestCommon; use Fcntl qw(SEEK_SET); -use PublicInbox::Spawn qw(which); -use PublicInbox::OnDestroy; require_git 2.6; -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(json DBD::SQLite Xapian)); +use POSIX qw(WTERMSIG WIFSIGNALED SIGPIPE); -my @onions = qw(http://hjrcffqmbrq6wope.onion/meta/ - http://czquwvybam4bgbro.onion/meta/ - http://ou63pmih66umazou.onion/meta/); +my @onions = map { "http://$_.onion/meta/" } qw( + 4uok3hntl7oi7b4uf4rtfwefqeexfzil2w6kgk2jn5z2f764irre7byd + ie5yzdi7fg72h7s4sdcztq5evakq23rdt33mfyfcddc5u3ndnw24ogqd + 7fh6tueqddpjyxjmgtdiueylzoqt6pt7hec3pukyptlmohoowvhde4yd); my $test_external_remote = sub { my ($url, $k) = @_; SKIP: { - my $nr = 5; - skip "$k unset", $nr if !$url; - which('curl') or skip 'no curl', $nr; - which('torsocks') or skip 'no torsocks', $nr if $url =~ m!\.onion/!; + skip "$k unset", 1 if !$url; + require_cmd 'curl', 1 or skip 'curl missing', 1; + if ($url =~ m!\.onion/!) { + require_cmd 'torsocks', 1 or skip 'no torsocks', 1; + } my $mid = '20140421094015.GA8962@dcvr.yhbt.net'; my @cmd = ('q', '--only', $url, '-q', "m:$mid"); lei_ok(@cmd, \"query $url"); is($lei_err, '', "no errors on $url"); my $res = json_utf8->decode($lei_out); - is($res->[0]->{'m'}, "<$mid>", "got expected mid from $url"); + is($res->[0]->{'m'}, $mid, "got expected mid from $url") or + skip 'further remote tests', 1; lei_ok(@cmd, 'd:..20101002', \'no results, no error'); is($lei_err, '', 'no output on 404, matching local FS behavior'); is($lei_out, "[null]\n", 'got null results'); + my ($pid_before, $pid_after); + if (-d $ENV{XDG_RUNTIME_DIR} && -w _) { + lei_ok 'daemon-pid'; + chomp($pid_before = $lei_out); + ok($pid_before, 'daemon is live'); + } + for my $out ([], [qw(-f mboxcl2)]) { + pipe(my ($r, $w)) or BAIL_OUT $!; + open my $err, '+>', undef or BAIL_OUT $!; + my $opt = { run_mode => 0, 1 => $w, 2 => $err }; + my $cmd = [qw(lei q -qt), @$out, 'z:1..']; + my $tp = start_script($cmd, undef, $opt); + close $w; + sysread($r, my $buf, 1); + close $r; # trigger SIGPIPE + $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"); + } + if (-d $ENV{XDG_RUNTIME_DIR} && -w _) { + lei_ok 'daemon-pid'; + chomp(my $pid_after = $lei_out); + is($pid_after, $pid_before, 'pid unchanged') or + skip 'daemon died', 1; + skip 'not killing persistent lei-daemon', 2 if + $ENV{TEST_LEI_DAEMON_PERSIST_DIR}; + lei_ok 'daemon-kill'; + my $alive = 1; + for (1..100) { + $alive = kill(0, $pid_after) or last; + tick(); + } + ok(!$alive, 'daemon-kill worked'); + no_coredump; + } } # /SKIP }; # /sub @@ -37,12 +78,17 @@ test_lei(sub { my $config_file = "$home/.config/lei/config"; my $store_dir = "$home/.local/share/lei"; lei_ok 'ls-external', \'ls-external on fresh install'; + ignore_inline_c_missing($lei_err); is($lei_out.$lei_err, '', 'ls-external no output, yet'); ok(!-e $config_file && !-e $store_dir, 'nothing created by ls-external'); - ok(!lei('add-external', "$home/nonexistent", - "fails on non-existent dir")); + ok(!lei('add-external', "$home/nonexistent"), + "fails on non-existent dir"); + like($lei_err, qr/not a directory/, 'noted non-existence'); + mkdir "$home/new\nline" or BAIL_OUT "mkdir: $!"; + ok(!lei('add-external', "$home/new\nline"), "fails on newline"); + like($lei_err, qr/`\\n' not allowed/, 'newline noted in error'); lei_ok('ls-external', \'ls-external works after add failure'); is($lei_out.$lei_err, '', 'ls-external still has no output'); my $cfg = PublicInbox::Config->new($cfg_path); @@ -52,8 +98,7 @@ test_lei(sub { \'added external'); is($lei_out.$lei_err, '', 'no output'); }); - ok(-s $config_file && -e $store_dir, - 'add-external created config + store'); + ok(-s $config_file, 'add-external created config'); my $lcfg = PublicInbox::Config->new($config_file); $cfg->each_inbox(sub { my ($ibx) = @_; @@ -86,8 +131,10 @@ test_lei(sub { lei_ok qw(_complete lei forget-external), \'complete for externals'; my %comp = map { $_ => 1 } split(/\s+/, $lei_out); ok($comp{'https://example.com/ibx/'}, 'forget external completion'); + my @dirs; $cfg->each_inbox(sub { my ($ibx) = @_; + push @dirs, $ibx->{inboxdir}; ok($comp{$ibx->{inboxdir}}, "local $ibx->{name} completion"); }); for my $u (qw(h http https https: https:/ https:// https://e @@ -116,7 +163,8 @@ test_lei(sub { lei_ok('ls-external'); unlike($lei_out, qr!https://example\.com/ibx/!s, 'removed canonical URL'); -SKIP: { + + # do some queries ok(!lei(qw(q s:prefix -o maildir:/dev/null)), 'bad maildir'); like($lei_err, qr!/dev/null exists and is not a directory!, 'error shown'); @@ -166,6 +214,8 @@ SKIP: { like($lei_out, qr/use boolean prefix/, '--stdin on pipe'); } ok(!lei(qw(q -q --stdin s:use)), "--stdin and argv don't mix"); + like($lei_err, qr/no query allowed.*--stdin/, + '--stdin conflict error message'); for my $fmt (qw(ldjson ndjson jsonl)) { lei_ok('q', '-f', $fmt, 's:use boolean prefix'); @@ -192,7 +242,8 @@ SKIP: { is(scalar(@s), 2, "2 results in mbox$sfx"); lei_ok('q', '-a', '-o', "mboxcl2:$f", 's:nonexistent'); - is(grep(!/^#/, $lei_err), 0, "no errors on no results ($sfx)"); + is(grep(!/^#/, $lei_err), 0, "no errors on no results ($sfx)") + or diag $lei_err; my @s2 = grep(/^Subject:/, $cat->()); is_deeply(\@s2, \@s, @@ -204,15 +255,24 @@ SKIP: { } ok(!lei('q', '-o', "$home/mbox", 's:nope'), 'fails if mbox format unspecified'); + like($lei_err, qr/unable to determine mbox/, 'mbox-related message'); + ok(!lei(qw(q --no-local s:see)), '--no-local'); is($? >> 8, 1, 'proper exit code'); like($lei_err, qr/no local or remote.+? to search/, 'no inbox'); + for my $no (['--no-local'], ['--no-external'], + [qw(--no-local --no-external)]) { + lei_ok(qw(q mid:testmessage@example.com), @$no, + '-I', $dirs[0], \"-I and @$no combine"); + $res = json_utf8->decode($lei_out); + is($res->[0]->{'m'}, 'testmessage@example.com', + "-I \$DIR got results regardless of @$no"); + } + { - opendir my $dh, '.' or BAIL_OUT "opendir(.) $!"; - my $od = PublicInbox::OnDestroy->new($$, sub { - chdir $dh or BAIL_OUT "chdir: $!" - }); + skip 'TEST_LEI_DAEMON_PERSIST_DIR in use', 1 if + $ENV{TEST_LEI_DAEMON_PERSIST_DIR}; my @q = qw(q -o mboxcl2:rel.mboxcl2 bye); lei_ok('-C', $home, @q); is(unlink("$home/rel.mboxcl2"), 1, '-C works before q'); @@ -237,6 +297,5 @@ SKIP: { $url = $e{$k} if $url eq '1'; $test_external_remote->($url, $k); } - }; # /SKIP }); # test_lei done_testing; diff --git a/t/lei-import-http.t b/t/lei-import-http.t new file mode 100644 index 00000000..d113d479 --- /dev/null +++ b/t/lei-import-http.t @@ -0,0 +1,47 @@ +#!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; +require_mods(qw(lei -httpd)); +require_cmd('curl'); +my ($ro_home, $cfg_path) = setup_public_inboxes; +my ($tmpdir, $for_destroy) = tmpdir; +my $sock = tcp_server; +my $cmd = [ '-httpd', '-W0', "--stdout=$tmpdir/1", "--stderr=$tmpdir/2" ]; +my $env = { PI_CONFIG => $cfg_path }; +my $td = start_script($cmd, $env, { 3 => $sock }) or BAIL_OUT("-httpd $?"); +my $host_port = tcp_host_port($sock); +undef $sock; +test_lei({ tmpdir => $tmpdir }, sub { + my $url = "http://$host_port/t2"; + for my $p (qw(bogus@x/t.mbox.gz bogus@x/raw ?q=noresultever)) { + ok(!lei('import', "$url/$p"), "/$p fails properly"); + like($lei_err, qr/curl.*404/, 'got curl 404'); + } + for my $p (qw(/ /T/ /t/ /t.atom)) { + ok(!lei('import', "$url/m\@example$p"), "/$p fails"); + like($lei_err, qr/did you mean/, "gave hint for $p"); + } + lei_ok 'import', "$url/testmessage\@example.com/raw"; + lei_ok 'q', 'm:testmessage@example.com'; + my $res = json_utf8->decode($lei_out); + is($res->[0]->{'m'}, 'testmessage@example.com', 'imported raw') + or diag explain($res); + + lei_ok 'import', "$url/qp\@example.com/t.mbox.gz"; + lei_ok 'q', 'm:qp@example.com'; + $res = json_utf8->decode($lei_out); + is($res->[0]->{'m'}, 'qp@example.com', 'imported t.mbox.gz') + or diag explain($res); + + lei_ok 'import', "$url/?q=s:boolean"; + lei_ok 'q', 'm:20180720072141.GA15957@example'; + $res = json_utf8->decode($lei_out); + is($res->[0]->{'m'}, '20180720072141.GA15957@example', + 'imported search result') or diag explain($res); + + ok(!lei(qw(import --mail-sync), "$url/x\@example.com/raw"), + '--mail-sync fails on HTTP'); + like($lei_err, qr/--mail-sync/, 'error message notes --mail-sync'); +}); +done_testing; diff --git a/t/lei-import-imap.t b/t/lei-import-imap.t index a6ba805f..3b6cb299 100644 --- a/t/lei-import-imap.t +++ b/t/lei-import-imap.t @@ -2,8 +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; -require_git 2.6; -require_mods(qw(DBD::SQLite Search::Xapian Mail::IMAPClient)); +require_mods(qw(lei -imapd Mail::IMAPClient)); my ($ro_home, $cfg_path) = setup_public_inboxes; my ($tmpdir, $for_destroy) = tmpdir; my $sock = tcp_server; @@ -13,16 +12,107 @@ my $td = start_script($cmd, $env, { 3 => $sock }) or BAIL_OUT("-imapd: $?"); my $host_port = tcp_host_port($sock); undef $sock; test_lei({ tmpdir => $tmpdir }, sub { - lei_ok(qw(q bytes:1..)); + my $url = "imap://$host_port/t.v2.0"; + my $url_orig = $url; + lei_ok(qw(ls-mail-source), "imap://$host_port/"); + like($lei_out, qr/^t\.v2\.0$/ms, 'shows mailbox'); + lei_ok(qw(ls-mail-source), $url); + is($lei_out, "t.v2.0\n", 'shows only mailbox with filter'); + lei_ok(qw(ls-mail-source -l), "imap://$host_port/"); + is(ref(json_utf8->decode($lei_out)), 'ARRAY', 'ls-mail-source JSON'); + + lei_ok(qw(q z:1..)); my $out = json_utf8->decode($lei_out); is_deeply($out, [ undef ], 'nothing imported, yet'); - lei_ok('import', "imap://$host_port/t.v2.0"); - lei_ok(qw(q bytes:1..)); + + lei_ok('inspect', $url); + is_deeply(json_utf8->decode($lei_out), {}, 'no inspect stats, yet'); + + lei_ok('import', $url); + lei_ok('inspect', $url); + my $res = json_utf8->decode($lei_out); + is(scalar keys %$res, 1, 'got one key in inspect URL'); + my $re = qr!\Aimap://;AUTH=ANONYMOUS\@\Q$host_port\E + /t\.v2\.0;UIDVALIDITY=\d+!x; + like((keys %$res)[0], qr/$re\z/, 'got expanded key'); + + lei_ok 'ls-mail-sync'; + like($lei_out, qr!$re\n\z!, 'ls-mail-sync'); + chomp(my $u = $lei_out); + lei_ok('import', $u, \'UIDVALIDITY match in URL'); + $url = $u; + $u =~ s/;UIDVALIDITY=(\d+)\s*/;UIDVALIDITY=9$1/s; + ok(!lei('import', $u), 'UIDVALIDITY mismatch in URL rejected'); + like($lei_err, qr/UIDVALIDITY mismatch/, 'mismatch noted'); + + lei_ok('inspect', $url); + my $inspect = json_utf8->decode($lei_out); + my @k = keys %$inspect; + is(scalar(@k), 1, 'one URL resolved'); + is($k[0], $url, 'inspect URL matches'); + my $stats = $inspect->{$k[0]}; + is_deeply([ sort keys %$stats ], + [ qw(uid.count uid.max uid.min) ], 'keys match'); + ok($stats->{'uid.min'} < $stats->{'uid.max'}, 'min < max'); + ok($stats->{'uid.count'} > 0, 'count > 0'); + + lei_ok('lcat', $url); + is(scalar(grep(/^# blob:/, split(/\n/ms, $lei_out))), + $stats->{'uid.count'}, 'lcat on URL dumps folder'); + lei_ok qw(lcat -f json), $url; + $out = json_utf8->decode($lei_out); + is(scalar(@$out) - 1, $stats->{'uid.count'}, 'lcat JSON dumps folder'); + + lei_ok(qw(q z:1..)); $out = json_utf8->decode($lei_out); ok(scalar(@$out) > 1, 'got imported messages'); is(pop @$out, undef, 'trailing JSON null element was null'); my %r; for (@$out) { $r{ref($_)}++ } is_deeply(\%r, { 'HASH' => scalar(@$out) }, 'all hashes'); + lei_ok([qw(tag +kw:seen), $url], undef, undef); + + my $f = "$ENV{HOME}/.local/share/lei/store/mail_sync.sqlite3"; + ok(-s $f, 'mail_sync tracked for redundant imports'); + lei_ok('inspect', "blob:$out->[5]->{blob}"); + my $x = json_utf8->decode($lei_out); + is(ref($x->{'lei/store'}), 'ARRAY', 'lei/store in inspect'); + is(ref($x->{'mail-sync'}), 'HASH', 'sync in inspect'); + is(ref($x->{'mail-sync'}->{$k[0]}), 'ARRAY', 'UID arrays in inspect') + or diag explain($x); + + my $psgi_attach = 'cfa3622cbeffc9bd6b0fc66c4d60d420ba74f60d'; + lei_ok('blob', $psgi_attach); + like($lei_out, qr!^Content-Type: multipart/mixed;!sm, 'got full blob'); + lei_ok('blob', "$psgi_attach:2"); + is($lei_out, "b64\xde\xad\xbe\xef\n", 'got attachment'); + + lei_ok 'forget-mail-sync', $url; + lei_ok 'ls-mail-sync'; + unlike($lei_out, qr!\Q$host_port\E!, 'sync info gone after forget'); + my $uid_url = "$url/;UID=".$stats->{'uid.max'}; + lei_ok 'import', $uid_url; + lei_ok 'ls-mail-sync'; + is($lei_out, "$url\n", 'ls-mail-sync added URL w/o UID'); + lei_ok 'inspect', $uid_url; + $lei_out =~ /([a-f0-9]{40,})/ or + xbail 'inspect missed blob with UID URL'; + my $blob = $1; + lei_ok 'lcat', $uid_url; + like $lei_out, qr/^Subject: /sm, + 'lcat shows mail text with UID URL'; + like $lei_out, qr/\bblob:$blob\b/, 'lcat showed blob'; + my $orig = $lei_out; + lei_ok 'lcat', "blob:$blob"; + is($lei_out, $orig, 'lcat understands blob:...'); + lei_ok qw(lcat -f json), $uid_url; + $out = json_utf8->decode($lei_out); + is(scalar(@$out), 2, 'got JSON') or diag explain($out); + lei_ok qw(lcat), $url_orig; + is($lei_out, $orig, 'lcat w/o UID works'); + + ok(!lei(qw(export-kw), $url_orig), 'export-kw fails on read-only IMAP'); + like($lei_err, qr/does not support/, 'error noted in failure'); }); + done_testing; diff --git a/t/lei-import-maildir.t b/t/lei-import-maildir.t index a3796491..1e7eddd5 100644 --- a/t/lei-import-maildir.t +++ b/t/lei-import-maildir.t @@ -10,24 +10,70 @@ test_lei(sub { } symlink(abs_path('t/data/0001.patch'), "$md/cur/x:2,S") or BAIL_OUT "symlink $md $!"; - lei_ok(qw(import), $md, \'import Maildir'); + lei_ok(qw(import), "$md/", \'import Maildir'); + my $imp_err = $lei_err; + + my %i; + lei_ok('inspect', $md); $i{no_type} = $lei_out; + lei_ok('inspect', "$md/"); $i{no_type_tslash} = $lei_out; + lei_ok('inspect', "maildir:$md"), $i{with_type} = $lei_out; + lei_ok('inspect', "maildir:$md/"), $i{with_type_tslash} = $lei_out; + lei_ok('inspect', "MAILDIR:$md"), $i{ALLCAPS} = $lei_out; + lei_ok(['inspect', $md], undef, { -C => $ENV{HOME}, %$lei_opt }); + $i{rel_no_type} = $lei_out; + lei_ok(['inspect', "maildir:$md"], undef, + { -C => $ENV{HOME}, %$lei_opt }); + $i{rel_with_type} = $lei_out; + my %v = map { $_ => 1 } values %i; + is(scalar(keys %v), 1, 'inspect handles relative and absolute paths'); + my $inspect = json_utf8->decode([ keys %v ]->[0]); + is_deeply($inspect, {"maildir:$md" => { 'name.count' => 1 }}, + 'inspect maildir: path had expected output') or xbail($inspect); + lei_ok(qw(q s:boolean)); my $res = json_utf8->decode($lei_out); - like($res->[0]->{'s'}, qr/use boolean/, 'got expected result'); + like($res->[0]->{'s'}, qr/use boolean/, 'got expected result') + or diag explain($imp_err, $res); is_deeply($res->[0]->{kw}, ['seen'], 'keyword set'); is($res->[1], undef, 'only got one result'); + lei_ok('inspect', "blob:$res->[0]->{blob}"); + $inspect = json_utf8->decode($lei_out); + is(ref(delete $inspect->{"lei/store"}), 'ARRAY', 'lei/store IDs'); + is_deeply($inspect, { 'mail-sync' => { "maildir:$md" => [ 'x:2,S' ] } }, + 'maildir sync info as expected'); + + lei_ok qw(ls-mail-sync); + is($lei_out, "maildir:$md\n", 'ls-mail-sync as expected'); + lei_ok(qw(import), $md, \'import Maildir again'); + $imp_err = $lei_err; lei_ok(qw(q -d none s:boolean), \'lei q w/o dedupe'); my $r2 = json_utf8->decode($lei_out); - is_deeply($r2, $res, 'idempotent import'); - - rename("$md/cur/x:2,S", "$md/cur/x:2,SR") or BAIL_OUT "rename: $!"; + is_deeply($r2, $res, 'idempotent import') + or diag explain($imp_err, $res); + rename("$md/cur/x:2,S", "$md/cur/x:2,RS") or BAIL_OUT "rename: $!"; lei_ok('import', "maildir:$md", \'import Maildir after +answered'); lei_ok(qw(q -d none s:boolean), \'lei q after +answered'); $res = json_utf8->decode($lei_out); like($res->[0]->{'s'}, qr/use boolean/, 'got expected result'); is_deeply($res->[0]->{kw}, ['answered', 'seen'], 'keywords set'); is($res->[1], undef, 'only got one result'); + + symlink(abs_path('t/utf8.eml'), "$md/cur/u:2,ST") or + BAIL_OUT "symlink $md $!"; + lei_ok('import', "maildir:$md", \'import Maildir w/ trashed message'); + $imp_err = $lei_err; + lei_ok(qw(q -d none m:testmessage@example.com)); + $res = json_utf8->decode($lei_out); + is_deeply($res, [ undef ], 'trashed message not imported') + or diag explain($imp_err, $res); + + lei_ok qw(rm t/data/0001.patch); + lei_ok(qw(q s:boolean)); + is($lei_out, "[null]\n", 'removed message gone from results'); + my $g0 = "$ENV{HOME}/.local/share/lei/store/local/0.git"; + my $x = xqx(['git', "--git-dir=$g0", qw(cat-file blob HEAD:d)]); + is($?, 0, "git cat-file shows file is `d'"); }); done_testing; diff --git a/t/lei-import-nntp.t b/t/lei-import-nntp.t index 3fb78fbc..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; @@ -13,18 +13,104 @@ my $td = start_script($cmd, $env, { 3 => $sock }) or BAIL_OUT("-nntpd $?"); my $host_port = tcp_host_port($sock); undef $sock; test_lei({ tmpdir => $tmpdir }, sub { - lei_ok(qw(q bytes:1..)); + lei_ok(qw(q z:1..)); my $out = json_utf8->decode($lei_out); is_deeply($out, [ undef ], 'nothing imported, yet'); - lei_ok('import', "nntp://$host_port/t.v2"); - diag $lei_err; - lei_ok(qw(q bytes:1..)); - diag $lei_err; + my $url = "nntp://$host_port/t.v2"; + lei_ok(qw(ls-mail-source), "nntp://$host_port/"); + like($lei_out, qr/^t\.v2$/ms, 'shows newsgroup'); + lei_ok(qw(ls-mail-source), $url); + is($lei_out, "t.v2\n", 'shows only newsgroup with filter'); + lei_ok(qw(ls-mail-source -l), "nntp://$host_port/"); + is(ref(json_utf8->decode($lei_out)), 'ARRAY', 'ls-mail-source JSON'); + + lei_ok('import', $url); + lei_ok "lcat", "nntp://$host_port/testmessage\@example.com"; + my $local = $lei_out; + lei_ok "lcat", "nntp://example.com/testmessage\@example.com"; + my $remote = $lei_out; + is($local, $remote, 'Message-ID used even from unknown host'); + lei_ok(qw(q z:1..)); $out = json_utf8->decode($lei_out); ok(scalar(@$out) > 1, 'got imported messages'); is(pop @$out, undef, 'trailing JSON null element was null'); my %r; for (@$out) { $r{ref($_)}++ } is_deeply(\%r, { 'HASH' => scalar(@$out) }, 'all hashes'); + + my $f = "$ENV{HOME}/.local/share/lei/store/mail_sync.sqlite3"; + ok(-s $f, 'mail_sync exists tracked for redundant imports'); + 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') or + diag $lei_err; + + # new home + local $ENV{HOME} = "$tmpdir/h2"; + lei_ok(qw(ls-mail-source -l), $url); + my $ls = json_utf8->decode($lei_out); + my ($high, $low) = @{$ls->[0]}{qw(high low)}; + ok($high > $low, 'high > low'); + + my $end = $high - 1; + lei_ok qw(import), "$url/$high"; + lei_ok('inspect', $url); is_xdeeply(json_utf8->decode($lei_out), { + $url => { 'article.count' => 1, + 'article.min' => $high, + 'article.max' => $high, } + }, 'inspect output for URL after single message') or diag $lei_out; + lei_ok('inspect', "$url/$high"); + my $x = json_utf8->decode($lei_out); + like($x->{$url}->{$high}, qr/\A[a-f0-9]{40,}\z/, 'inspect shows blob'); + lei_ok qw(lcat -f json), "$url/$high"; + my $lcat = json_utf8->decode($lei_out); + is($lcat->[1], undef, 'only one result for lcat'); + is($lcat->[0]->{blob}, $x->{$url}->{$high}, + 'lcat showed correct blob'); + + lei_ok 'ls-mail-sync'; + is($lei_out, "$url\n", 'article number not stored as folder'); + lei_ok qw(q z:0..); my $one = json_utf8->decode($lei_out); + pop @$one; # trailing null + is(scalar(@$one), 1, 'only 1 result'); + + local $ENV{HOME} = "$tmpdir/h3"; + lei_ok qw(import), "$url/$low-$end"; + lei_ok('inspect', $url); is_xdeeply(json_utf8->decode($lei_out), { + $url => { 'article.count' => $end - $low + 1, + 'article.min' => $low, + 'article.max' => $end, } + }, 'inspect output for URL after range') or diag $lei_out; + lei_ok('inspect', "$url/$low-$end"); + $x = json_utf8->decode($lei_out); + is_deeply([ ($low..$end) ], [ sort { $a <=> $b } keys %{$x->{$url}} ], + 'inspect range shows range'); + is(scalar(grep(/\A[a-f0-9]{40,}\z/, values %{$x->{$url}})), + $end - $low + 1, 'all values are git blobs'); + + lei_ok qw(lcat -f json), "$url/$low"; + $lcat = json_utf8->decode($lei_out); + is($lcat->[1], undef, 'only one result for lcat'); + is($lcat->[0]->{blob}, $x->{$url}->{$low}, + 'lcat showed correct blob'); + lei_ok qw(lcat -f json), "$url/$low-$end"; + $lcat = json_utf8->decode($lei_out); + pop @$lcat; + for ($low..$end) { + my $tip = shift @$lcat; + is($x->{$url}->{$_}, $tip->{blob}, "blob matches art #$_"); + } + + lei_ok 'ls-mail-sync'; + is($lei_out, "$url\n", 'article range not stored as folder'); + lei_ok qw(q z:0..); my $start = json_utf8->decode($lei_out); + pop @$start; # trailing null + is(scalar(@$start), scalar(map { $_ } ($low..$end)), + 'range worked as expected'); + my %seen; + for (@$start, @$one) { + is($seen{$_->{blob}}++, 0, "blob $_->{blob} seen once"); + } }); done_testing; diff --git a/t/lei-import.t b/t/lei-import.t index edb0cd20..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/\bbogus unrecognized/, 'gave error message'); +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'); @@ -29,26 +32,200 @@ lei_ok(qw(q s:boolean -f mboxrd), \'blob accessible after import'); lei_ok(qw(import -F eml), 't/data/message_embed.eml', \'import single file by path'); -my $str = <<''; +lei_ok(qw(q m:testmessage@example.com)); +is($lei_out, "[null]\n", 'no results, yet'); +my $oid = '9bf1002c49eb075df47247b74d69bcd555e23422'; +my $eml = eml_load('t/utf8.eml'); +my $in = 'From x@y Fri Oct 2 00:00:00 1993'."\n".$eml->as_string; +lei_ok([qw(import -F eml -)], undef, { %$lei_opt, 0 => \$in }); +lei_ok(qw(q m:testmessage@example.com)); +is(json_utf8->decode($lei_out)->[0]->{'blob'}, $oid, + 'got expected OID w/o From'); + +my $eml_str = <<''; From: a@b Message-ID: <x@y> Status: RO -my $opt = { %$lei_opt, 0 => \$str }; +my $opt = { %$lei_opt, 0 => \$eml_str }; lei_ok([qw(import -F eml -)], undef, $opt, \'import single file with keywords from stdin'); lei_ok(qw(q m:x@y)); my $res = json_utf8->decode($lei_out); is($res->[1], undef, 'only one result'); -is_deeply($res->[0]->{kw}, ['seen'], "message `seen' keyword set"); +is($res->[0]->{'m'}, 'x@y', 'got expected message'); +is($res->[0]->{kw}, undef, 'Status ignored for eml'); +lei_ok(qw(q -f mboxrd m:x@y)); +unlike($lei_out, qr/^Status:/, 'no Status: in imported message'); +lei_ok('blob', $res->[0]->{blob}); +is($lei_out, "From: a\@b\nMessage-ID: <x\@y>\n", 'got blob back'); + -$str =~ tr/x/v/; # v@y -lei_ok([qw(import --no-kw -F eml -)], undef, $opt, +$eml->header_set('Message-ID', '<v@y>'); +$eml->header_set('Status', 'RO'); +$in = 'From v@y Fri Oct 2 00:00:00 1993'."\n".$eml->as_string; +lei_ok([qw(import --no-kw -F mboxrd -)], undef, { %$lei_opt, 0 => \$in }, \'import single file with --no-kw from stdin'); lei(qw(q m:v@y)); $res = json_utf8->decode($lei_out); is($res->[1], undef, 'only one result'); -is_deeply($res->[0]->{kw}, [], 'no keywords set'); +is($res->[0]->{'m'}, 'v@y', 'got expected message'); +is($res->[0]->{kw}, undef, 'no keywords set'); + +$eml->header_set('Message-ID', '<k@y>'); +$in = 'From k@y Fri Oct 2 00:00:00 1993'."\n".$eml->as_string; +lei_ok([qw(import -F mboxrd /dev/fd/0)], undef, { %$lei_opt, 0 => \$in }, + \'import single file with --kw (default) from stdin'); +lei(qw(q m:k@y)); +$res = json_utf8->decode($lei_out); +is($res->[1], undef, 'only one result'); +is($res->[0]->{'m'}, 'k@y', 'got expected message'); +is_deeply($res->[0]->{kw}, ['seen'], "`seen' keywords set"); + +# no From, Sender, or Message-ID +$eml_str = <<'EOM'; +Subject: draft message with no sender +References: <y@y> +Resent-Message-ID: <resent-test@example> + +No use for a name +EOM +lei_ok([qw(import -F eml -)], undef, { %$lei_opt, 0 => \$eml_str }); +lei_ok(['q', 's:draft message with no sender']); +my $draft_a = json_utf8->decode($lei_out); +ok(!exists $draft_a->[0]->{'m'}, 'no fake mid stored or exposed'); +lei_ok([qw(tag -F eml - +kw:draft)], undef, { %$lei_opt, 0 => \$eml_str }); +lei_ok(['q', 's:draft message with no sender']); +my $draft_b = json_utf8->decode($lei_out); +my $kw = delete $draft_b->[0]->{kw}; +is_deeply($kw, ['draft'], 'draft kw set'); +is_deeply($draft_a, $draft_b, 'fake Message-ID lookup') or + diag explain($draft_a, $draft_b); +lei_ok('blob', '--mail', $draft_b->[0]->{blob}); +is($lei_out, $eml_str, 'draft retrieved by blob'); + + +$eml_str = "Message-ID: <inbox\@example.com>\nSubject: label-this\n\n"; +lei_ok([qw(import -F eml - +kw:seen +L:inbox)], + 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 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 new file mode 100644 index 00000000..2b28f1be --- /dev/null +++ b/t/lei-index.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 strict; use v5.10.1; use PublicInbox::TestCommon; +use File::Spec; +require_mods(qw(lei)); +my ($ro_home, $cfg_path) = setup_public_inboxes; +my ($tmpdir, $for_destroy) = tmpdir; +my $env = { PI_CONFIG => $cfg_path }; +my $srv = {}; + +SKIP: { + require_mods(qw(-nntpd Net::NNTP), 1); + my $rdr = { 3 => tcp_server }; + $srv->{nntpd} = start_script( + [qw(-nntpd -W0), "--stdout=$tmpdir/n1", "--stderr=$tmpdir/n2"], + $env, $rdr) or xbail "nntpd: $?"; + $srv->{nntp_host_port} = tcp_host_port($rdr->{3}); +} + +SKIP: { + require_mods(qw(-imapd Mail::IMAPClient), 1); + my $rdr = { 3 => tcp_server }; + $srv->{imapd} = start_script( + [qw(-imapd -W0), "--stdout=$tmpdir/i1", "--stderr=$tmpdir/i2"], + $env, $rdr) or xbail("-imapd $?"); + $srv->{imap_host_port} = tcp_host_port($rdr->{3}); +} + +for ('', qw(cur new)) { + mkdir "$tmpdir/md/$_" or xbail "mkdir: $!"; + mkdir "$tmpdir/md1/$_" or xbail "mkdir: $!"; +} +symlink(File::Spec->rel2abs('t/plack-qp.eml'), "$tmpdir/md/cur/x:2,"); +my $expect = do { + open my $fh, '<', 't/plack-qp.eml' or xbail $!; + local $/; + <$fh>; +}; + +# mbsync and offlineimap both put ":2," in "new/" files: +symlink(File::Spec->rel2abs('t/utf8.eml'), "$tmpdir/md/new/u:2,") or + xbail "symlink $!"; + +symlink(File::Spec->rel2abs('t/mda-mime.eml'), "$tmpdir/md1/cur/x:2,S") or + xbail "symlink $!"; + +test_lei({ tmpdir => $tmpdir }, sub { + my $store_path = "$ENV{HOME}/.local/share/lei/store/"; + + 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); + is($lei_out, $expect, 'got expected blob via Maildir'); + lei_ok(qw(q mid:qp@example.com -f text)); + like($lei_out, qr/^hi = bye/sm, 'lei2mail fallback'); + + lei_ok(qw(q mid:testmessage@example.com -f text)); + lei_ok(qw(-C / blob --mail 9bf1002c49eb075df47247b74d69bcd555e23422)); + + my $all_obj = ['git', "--git-dir=$store_path/ALL.git", + qw(cat-file --batch-check --batch-all-objects)]; + is_deeply([xqx($all_obj)], [], 'no git objects'); + lei_ok('import', 't/plack-qp.eml'); + ok(grep(/\A$blob blob /, my @objs = xqx($all_obj)), + 'imported blob'); + lei_ok(qw(q m:qp@example.com --dedupe=none)); + my $res_b = json_utf8->decode($lei_out); + is_deeply($res_b, $res_a, 'no extra DB entries'); + + # ensure tag works on index-only messages: + lei_ok(qw(tag +kw:seen t/utf8.eml)); + lei_ok(qw(q mid:testmessage@example.com)); + is_deeply(json_utf8->decode($lei_out)->[0]->{kw}, + ['seen'], 'seen kw can be set on index-only message'); + + lei_ok(qw(q z:0.. -o), "$tmpdir/all-results") for (1..2); + is_deeply([xqx($all_obj)], \@objs, + 'no new objects after 2x q to trigger implicit import'); + + lei_ok 'index', "$tmpdir/md1/cur/x:2,S"; + 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"); + $srv->{imapd} and + lei_ok('index', "imap://$srv->{imap_host_port}/t.v2.0"); + is_deeply([xqx($all_obj)], \@objs, 'no new objects from NNTP+IMAP'); + + 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 NNTP + IMAP import'); + + # ensure import works after lms->local_blob fallback in lei/store + lei_ok('import', 't/mda-mime.eml'); + lei_ok qw(q m:multipart-html-sucks@11); + $res_b = json_utf8->decode($lei_out)->[0]; + 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-inspect.t b/t/lei-inspect.t new file mode 100644 index 00000000..077d0d13 --- /dev/null +++ b/t/lei-inspect.t @@ -0,0 +1,14 @@ +#!perl -w +# Copyright 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; + +test_lei(sub { + my ($ro_home, $cfg_path) = setup_public_inboxes; + lei_ok qw(inspect --dir), "$ro_home/t1", 'mid:testmessage@example.com'; + my $ent = json_utf8->decode($lei_out); + is(ref($ent->{smsg}), 'ARRAY', 'smsg array'); + is(ref($ent->{xdoc}), 'ARRAY', 'xdoc array'); +}); + +done_testing; diff --git a/t/lei-lcat.t b/t/lei-lcat.t new file mode 100644 index 00000000..31a84744 --- /dev/null +++ b/t/lei-lcat.t @@ -0,0 +1,30 @@ +#!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; +require_mods(qw(lei)); + +test_lei(sub { + my $in = "\nMessage-id: <qp\@example.com>\n"; + lei_ok([qw(lcat --stdin)], undef, { 0 => \$in, %$lei_opt }); + unlike($lei_out, qr/\S/, 'nothing, yet'); + lei_ok('import', 't/plack-qp.eml'); + lei_ok([qw(lcat --stdin)], undef, { 0 => \$in, %$lei_opt }); + like($lei_out, qr/qp\@example\.com/, 'got a result'); + + # test Link:, -f reply, and implicit --stdin: + my $prev = $lei_out; + $in = "\nLink: https://example.com/foo/qp\@example.com/\n"; + lei_ok([qw(lcat -f reply)], undef, { 0 => \$in, %$lei_opt}); + my $exp = <<'EOM'; +To: qp@example.com +Subject: Re: QP +In-Reply-To: <qp@example.com> + +On some unknown date, qp wrote: +> hi = bye +EOM + like($lei_out, qr/\AFrom [^\n]+\n\Q$exp\E/sm, '-f reply works'); +}); + +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.psgi b/t/lei-mirror.psgi new file mode 100644 index 00000000..6b4bbfec --- /dev/null +++ b/t/lei-mirror.psgi @@ -0,0 +1,9 @@ +use Plack::Builder; +use PublicInbox::WWW; +my $www = PublicInbox::WWW->new; +$www->preload; +builder { + enable 'Head'; + mount '/pfx' => builder { sub { $www->call(@_) } }; + mount '/' => builder { sub { $www->call(@_) } }; +}; diff --git a/t/lei-mirror.t b/t/lei-mirror.t index 1d113e3e..76041b73 100644 --- a/t/lei-mirror.t +++ b/t/lei-mirror.t @@ -1,44 +1,222 @@ #!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_git 2.6; -require_mods(qw(DBD::SQLite Search::Xapian)); +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(); my $http = 'http://'.tcp_host_port($sock); my ($ro_home, $cfg_path) = setup_public_inboxes; -my $cmd = [ qw(-httpd -W0), "--stdout=$tmpdir/out", "--stderr=$tmpdir/err" ]; +my $cmd = [ qw(-httpd -W0 ./t/lei-mirror.psgi), + "--stdout=$tmpdir/out", "--stderr=$tmpdir/err" ]; my $td = start_script($cmd, { PI_CONFIG => $cfg_path }, { 3 => $sock }); +my %created; test_lei({ tmpdir => $tmpdir }, sub { my $home = $ENV{HOME}; my $t1 = "$home/t1-mirror"; + my $mm_orig = "$ro_home/t1/public-inbox/msgmap.sqlite3"; + $created{v1} = PublicInbox::Msgmap->new_file($mm_orig)->created_at; lei_ok('add-external', $t1, '--mirror', "$http/t1/", \'--mirror v1'); - ok(-f "$t1/public-inbox/msgmap.sqlite3", 't1-mirror indexed'); + my $mm_dup = "$t1/public-inbox/msgmap.sqlite3"; + ok(-f $mm_dup, 't1-mirror indexed'); + 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'); + is((stat(_))[2] & 0222, 0, 'inbox.config.example not writable'); + my $tb = PublicInbox::Msgmap->new_file($mm_dup)->created_at; + is($tb, $created{v1}, 'created_at matched in mirror'); lei_ok('ls-external'); like($lei_out, qr!\Q$t1\E!, 't1 added to ls-externals'); my $t2 = "$home/t2-mirror"; + $mm_orig = "$ro_home/t2/msgmap.sqlite3"; + $created{v2} = PublicInbox::Msgmap->new_file($mm_orig)->created_at; lei_ok('add-external', $t2, '--mirror', "$http/t2/", \'--mirror v2'); - ok(-f "$t2/msgmap.sqlite3", 't2-mirror indexed'); + $mm_dup = "$t2/msgmap.sqlite3"; + ok(-f $mm_dup, 't2-mirror indexed'); + ok(-f "$t2/description", 't2 description'); + ok(-f "$t2/Makefile", 'convenience Makefile added (v2)'); + 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'); lei_ok('ls-external'); like($lei_out, qr!\Q$t2\E!, 't2 added to ls-externals'); ok(!lei('add-external', $t2, '--mirror', "$http/t2/"), '--mirror fails if reused') or diag "$lei_err.$lei_out = $?"; + like($lei_err, qr/\Q$t2\E' already exists/, 'destination in error'); + + ok(!lei('add-external', "$home/t2\nnewline", '--mirror', "$http/t2/"), + '--mirror fails on newline'); + like($lei_err, qr/`\\n' not allowed/, 'newline noted in error'); lei_ok('ls-external'); like($lei_out, qr!\Q$t2\E!, 'still in ls-externals'); + unlike($lei_out, qr!\Qnewline\E!, 'newline entry not added'); ok(!lei('add-external', "$t2-fail", '-Lmedium'), '--mirror v2'); + like($lei_err, qr/not a directory/, 'non-directory noted'); ok(!-d "$t2-fail", 'destination not created on failure'); lei_ok('ls-external'); unlike($lei_out, qr!\Q$t2-fail\E!, 'not added to ls-external'); + + lei_ok('add-external', "$t1-pfx", '--mirror', "$http/pfx/t1/", + \'--mirror v1 w/ PSGI prefix'); + ok(!-e "$t1-pfx/mirror.done", 'no leftover mirror.done'); + + my $d = "$home/404"; + ok(!lei(qw(add-external --mirror), "$http/404", $d), 'mirror 404'); + unlike($lei_err, qr!unlink.*?404/mirror\.done!, + 'no unlink failure message'); + ok(!-d $d, "`404' dir not created"); + lei_ok('ls-external'); + unlike($lei_out, qr!\Q$d\E!s, 'not added to ls-external'); + + $d = "$home/bad-epoch"; + ok(!lei(qw(add-external -q --epoch=0.. --mirror), "$http/t1/", $d), + 'v1 fails on --epoch'); + ok(!-d $d, 'destination not created on unacceptable --epoch'); + ok(!lei(qw(add-external -q --epoch=1 --mirror), "$http/t2/", $d), + 'v2 fails on bad epoch range'); + ok(!-d $d, 'destination not created on bad epoch'); + + my %phail = ( + HTTPS => 'https://public-inbox.org/' . 'phail', + ONION => +'http://7fh6tueqddpjyxjmgtdiueylzoqt6pt7hec3pukyptlmohoowvhde4yd.onion/' . +'phail,' + ); + for my $t (qw(HTTPS ONION)) { + SKIP: { + my $k = "TEST_LEI_EXTERNAL_$t"; + $ENV{$k} or skip "$k unset", 1; + my $url = $phail{$t}; + my $dir = "phail-$t"; + ok(!lei(qw(add-external -Lmedium --mirror), + $url, $dir), '--mirror non-existent v2'); + is($? >> 8, 22, 'curl 404'); + ok(!-d $dir, 'directory not created'); + unlike($lei_err, qr/# mirrored/, 'no success message'); + like($lei_err, qr/curl.*404/, "curl 404 shown for $k"); + } # SKIP + } # for }); +SKIP: { + undef $sock; + my $d = "$tmpdir/d"; + mkdir $d or xbail "mkdir $d $!"; + my $opt = { -C => $d, 2 => \(my $err) }; + ok(!run_script([qw(-clone -q), "$http/404"], undef, $opt), '404 fails'); + ok(!-d "$d/404", 'destination not created'); + + ok(run_script([qw(-clone -q -C), $d, "$http/t2"], undef, $opt), + '-clone succeeds on v2'); + ok(-f "$d/t2/git/0.git/config", 'epoch cloned'); + + # writeBitmaps is the default for bare repos in git 2.22+, + # so we may stop setting it ourselves. + 0 and is(xqx(['git', "--git-dir=$d/t2/git/0.git", 'config', + qw(--bool repack.writeBitmaps)]), "true\n", + 'write bitmaps set (via include.path=all.git/config'); + + is(xqx(['git', "--git-dir=$d/t2/git/0.git", 'config', + qw(include.path)]), "../../all.git/config\n", + 'include.path set'); + + ok(-s "$d/t2/all.git/objects/info/alternates", + 'all.git alternates created'); + ok(-f "$d/t2/manifest.js.gz", 'manifest saved'); + ok(!-e "$d/t2/mirror.done", 'no leftover mirror.done'); + ok(!run_script([qw(-fetch --exit-code -C), "$d/t2"], undef, $opt), + '-fetch succeeds w/ manifest.js.gz'); + is($? >> 8, 127, '--exit-code gave 127'); + unlike($err, qr/git --git-dir=\S+ fetch/, 'no fetch done w/ manifest'); + unlink("$d/t2/manifest.js.gz") or xbail "unlink $!"; + ok(!run_script([qw(-fetch --exit-code -C), "$d/t2"], undef, $opt), + '-fetch succeeds w/o manifest.js.gz'); + is($? >> 8, 127, '--exit-code gave 127'); + like($err, qr/git --git-dir=\S+ fetch/, 'fetch forced w/o manifest'); + + ok(run_script([qw(-clone -q -C), $d, "$http/t1"], undef, $opt), + 'cloning v1 works'); + ok(-d "$d/t1", 'v1 cloned'); + ok(!-e "$d/t1/mirror.done", 'no leftover file'); + ok(-f "$d/t1/manifest.js.gz", 'manifest saved'); + ok(!run_script([qw(-fetch --exit-code -C), "$d/t1"], undef, $opt), + 'fetching v1 works'); + is($? >> 8, 127, '--exit-code gave 127'); + unlike($err, qr/git --git-dir=\S+ fetch/, 'no fetch done w/ manifest'); + unlink("$d/t1/manifest.js.gz") or xbail "unlink $!"; + my $before = [ glob("$d/t1/*") ]; + ok(!run_script([qw(-fetch --exit-code -C), "$d/t1"], undef, $opt), + 'fetching v1 works w/o manifest.js.gz'); + is($? >> 8, 127, '--exit-code gave 127'); + unlink("$d/t1/FETCH_HEAD"); # git internal + like($err, qr/git --git-dir=\S+ fetch/, 'no fetch done w/ manifest'); + ok(unlink("$d/t1/manifest.js.gz"), 'manifest created'); + my $after = [ glob("$d/t1/*") ]; + is_deeply($before, $after, 'no new files created'); + + local $ENV{HOME} = $tmpdir; + ok(run_script([qw(-index -Lbasic), "$d/t1"]), 'index v1'); + ok(run_script([qw(-index -Lbasic), "$d/t2"]), 'index v2'); + + SKIP: { + join('', sort(keys %created)) eq 'v1v2' or + skip "lei didn't run", 2; + my $f = "$d/t1/public-inbox/msgmap.sqlite3"; + my $ca = PublicInbox::Msgmap->new_file($f)->created_at; + is($ca, $created{v1}, 'clone + index v1 synced ->created_at'); + + $f = "$d/t2/msgmap.sqlite3"; + $ca = PublicInbox::Msgmap->new_file($f)->created_at; + is($ca, $created{v2}, 'clone + index v2 synced ->created_at'); + } + test_lei(sub { + lei_ok qw(inspect num:1 --dir), "$d/t1"; + ok(ref(json_utf8->decode($lei_out)), 'inspect num: on v1'); + lei_ok qw(inspect num:1 --dir), "$d/t2"; + ok(ref(json_utf8->decode($lei_out)), 'inspect num: on v2'); + }); +} + ok($td->kill, 'killed -httpd'); $td->join; +{ + require_ok 'PublicInbox::LeiMirror'; + my $mrr = { src => 'https://example.com/src/', dst => $tmpdir }; + my $exp = "mirror of https://example.com/src/\n"; + my $f = "$tmpdir/description"; + PublicInbox::LeiMirror::set_description($mrr); + 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::IO::try_cat($f), $exp, 'description set on empty'); + (open($fh, '>', $f) and print $fh "x\n" and close($fh)) or xbail $!; + is(PublicInbox::IO::try_cat($f), "x\n", + 'description preserved if non-default'); +} + done_testing; diff --git a/t/lei-p2q.t b/t/lei-p2q.t new file mode 100644 index 00000000..44f37d19 --- /dev/null +++ b/t/lei-p2q.t @@ -0,0 +1,39 @@ +#!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; +require_git 2.6; +require_mods(qw(json DBD::SQLite Xapian)); + +test_lei(sub { + ok(!lei(qw(p2q this-better-cause-format-patch-to-fail)), + 'p2q fails on bogus arg') or diag $lei_err; + like($lei_err, qr/format-patch.*failed/, 'notes format-patch failure'); + lei_ok(qw(p2q -w dfpost t/data/0001.patch)); + is($lei_out, "dfpost:6e006fd73b1d\n", 'pathname') or diag $lei_err; + open my $fh, '+<', 't/data/0001.patch' or xbail "open: $!"; + lei_ok([qw(p2q -w dfpost -)], undef, { %$lei_opt, 0 => $fh }); + is($lei_out, "dfpost:6e006fd73b1d\n", '--stdin') or diag $lei_err; + + sysseek($fh, 0, 0) or xbail "lseek: $!"; + lei_ok([qw(p2q -w dfpost)], undef, { %$lei_opt, 0 => $fh }); + is($lei_out, "dfpost:6e006fd73b1d\n", 'implicit --stdin'); + + lei_ok(qw(p2q --uri t/data/0001.patch -w), 'dfpost,dfn'); + is($lei_out, "dfpost%3A6e006fd73b1d+". + "dfn%3Alib%2FPublicInbox%2FSearch.pm\n", + '--uri -w dfpost,dfn'); + lei_ok(qw(p2q t/data/0001.patch), '--want=dfpost,OR,dfn'); + is($lei_out, "dfpost:6e006fd73b1d OR dfn:lib/PublicInbox/Search.pm\n", + '--want=OR'); + lei_ok(qw(p2q t/data/0001.patch --want=dfpost9)); + is($lei_out, "dfpost:6e006fd73b1d OR " . + "dfpost:6e006fd73b1 OR " . + "dfpost:6e006fd73b OR " . + "dfpost:6e006fd73\n", + '3-byte chop'); + + lei_ok(qw(p2q t/data/message_embed.eml --want=dfb)); + like($lei_out, qr/\bdfb:\S+/, 'got dfb off /dev/null file'); +}); +done_testing; diff --git a/t/lei-q-kw.t b/t/lei-q-kw.t new file mode 100644 index 00000000..63e46037 --- /dev/null +++ b/t/lei-q-kw.t @@ -0,0 +1,264 @@ +#!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 PublicInbox::TestCommon; +use POSIX qw(mkfifo); +use Fcntl qw(SEEK_SET O_RDONLY O_NONBLOCK); +use IO::Uncompress::Gunzip qw(gunzip); +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'), +}; +$exp->{'<qp@example.com>'}->header_set('Status', 'RO'); + +test_lei(sub { +lei_ok(qw(import -F eml t/plack-qp.eml)); +my $o = "$ENV{HOME}/dst"; +lei_ok(qw(q -o), "maildir:$o", qw(m:qp@example.com)); +my @fn = glob("$o/cur/*:2,"); +scalar(@fn) == 1 or xbail $lei_err, 'wrote multiple or zero files:', \@fn; +rename($fn[0], "$fn[0]S") or BAIL_OUT "rename $!"; + +lei_ok(qw(q -o), "maildir:$o", qw(m:bogus-noresults@example.com)); +ok(!glob("$o/cur/*"), 'last result cleared after augment-import'); + +lei_ok(qw(q -o), "maildir:$o", qw(m:qp@example.com)); +@fn = glob("$o/cur/*:2,S"); +is(scalar(@fn), 1, "`seen' flag set on Maildir file") or + diag "$o contents: ", explain([glob("$o/*/*")]); + +# ensure --no-import-before works +my $n = $fn[0]; +$n =~ s/,S\z/,RS/; +rename($fn[0], $n) or BAIL_OUT "rename $!"; +lei_ok(qw(q --no-import-before -o), "maildir:$o", + qw(m:bogus-noresults@example.com)); +ok(!glob("$o/cur/*"), '--no-import-before cleared destination'); +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); + # cat(1) since lei() may not execve for FD_CLOEXEC to work + my $cat = popen_rd(['cat', $o]); + ok(!lei(qw(q --import-before bogus -o), "mboxrd:$o"), + '--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'); + $cat->close; + $cat = popen_rd(['cat', $o]); + lei_ok(qw(q m:qp@example.com -o), "mboxrd:$o"); + my $buf = do { local $/; <$cat> }; + open my $fh, '<', \$buf or BAIL_OUT $!; + PublicInbox::MboxReader->mboxrd($fh, sub { + my ($eml) = @_; + $eml->header_set('Status', 'RO'); + is_deeply($eml, $exp->{'<qp@example.com>'}, + 'FIFO output works as expected'); + }); +}; + +lei_ok qw(import -F eml t/utf8.eml), \'for augment test'; +my $read_file = sub { + if ($_[0] =~ /\.gz\z/) { + gunzip($_[0] => \(my $buf = ''), MultiStream => 1) or + BAIL_OUT 'gunzip'; + $buf; + } else { + open my $fh, '+<', $_[0] or BAIL_OUT $!; + do { local $/; <$fh> }; + } +}; + +my $write_file = sub { + if ($_[0] =~ /\.gz\z/) { + gzip(\($_[1]), $_[0]) or BAIL_OUT 'gzip'; + } else { + write_file '>', $_[0], $_[1]; + } +}; + +for my $sfx ('', '.gz') { + $o = "$ENV{HOME}/dst.mboxrd$sfx"; + lei_ok(qw(q -o), "mboxrd:$o", qw(m:qp@example.com)); + my $buf = $read_file->($o); + $buf =~ s/^Status: [^\n]*\n//sm or BAIL_OUT "no status in $buf"; + $write_file->($o, $buf); + lei_ok(qw(q -o), "mboxrd:$o", qw(rereadandimportkwchange)); + $buf = $read_file->($o); + is($buf, '', 'emptied'); + lei_ok(qw(q -o), "mboxrd:$o", qw(m:qp@example.com)); + $buf = $read_file->($o); + $buf =~ s/\nStatus: O\n\n/\nStatus: RO\n\n/s or + BAIL_OUT "no Status in $buf"; + $write_file->($o, $buf); + lei_ok(qw(q -a -o), "mboxrd:$o", qw(m:testmessage@example.com)); + $buf = $read_file->($o); + open my $fh, '<', \$buf or BAIL_OUT "PerlIO::scalar $!"; + my %res; + PublicInbox::MboxReader->mboxrd($fh, sub { + my ($eml) = @_; + my $mid = $eml->header_raw('Message-ID'); + if ($mid eq '<testmessage@example.com>') { + is_deeply([$eml->header('Status')], [], + "no status $sfx"); + $eml->header_set('Status'); + } elsif ($mid eq '<qp@example.com>') { + is($eml->header('Status'), 'RO', 'status preserved'); + } else { + fail("unknown mid $mid"); + } + $res{$mid} = $eml; + }); + is_deeply(\%res, $exp, '--augment worked') or diag $lei_err; + + lei_ok(qw(q -o), "mboxrd:/dev/stdout", qw(m:qp@example.com)) or + diag $lei_err; + like($lei_out, qr/^Status: RO\n/sm, 'Status set by previous augment'); +} # /mbox + mbox.gz tests + +my ($ro_home, $cfg_path) = setup_public_inboxes; + +# import keywords-only for external messages: +$o = "$ENV{HOME}/kwdir"; +my $m = 'alpine.DEB.2.20.1608131214070.4924@example'; +my @inc = ('-I', "$ro_home/t1"); +lei_ok(qw(q -o), $o, "m:$m", @inc); + +# emulate MUA marking a Maildir message as read: +@fn = glob("$o/cur/*"); +scalar(@fn) == 1 or xbail $lei_err, 'wrote multiple or zero files:', \@fn; +rename($fn[0], "$fn[0]S") or BAIL_OUT "rename $!"; + +lei_ok(qw(q -o), $o, 'bogus', \'clobber output dir to import keywords'); +@fn = glob("$o/cur/*"); +is_deeply(\@fn, [], 'output dir actually clobbered'); +lei_ok('q', "m:$m", @inc); +my $res = json_utf8->decode($lei_out); +is_deeply($res->[0]->{kw}, ['seen'], 'seen flag set for external message') + or diag explain($res); +lei_ok('q', "m:$m", '--no-external'); +is_deeply($res = json_utf8->decode($lei_out), [ undef ], + 'external message not imported') or diag explain($res); + +$o = "$ENV{HOME}/kwmboxrd"; +lei_ok(qw(q -o), "mboxrd:$o", "m:$m", @inc); + +# emulate MUA marking mboxrd message as unread +open my $fh, '<', $o or BAIL_OUT; +my $s = do { local $/; <$fh> }; +$s =~ s/^Status: RO\n/Status: O\nX-Status: AF\n/sm or + fail "failed to clear R flag in $s"; +open $fh, '>', $o or BAIL_OUT; +print $fh $s or BAIL_OUT; +close $fh or BAIL_OUT; + +lei_ok(qw(q -o), "mboxrd:$o", 'm:bogus', @inc, + \'clobber mbox to import keywords'); +lei_ok(qw(q -o), "mboxrd:$o", "m:$m", @inc); +open $fh, '<', $o or BAIL_OUT; +$s = do { local $/; <$fh> }; +like($s, qr/^Status: O\nX-Status: AF\n/ms, + 'seen keyword gone in mbox, answered + flagged set'); + +lei_ok(qw(q --pretty), "m:$m", @inc); +like($lei_out, qr/^ "kw": \["answered", "flagged"\],\n/sm, + '--pretty JSON output shows kw: on one line'); + +# ensure import on previously external-only message works +lei_ok('q', "m:$m"); +is_deeply(json_utf8->decode($lei_out), [ undef ], + 'to-be-imported message non-existent'); +lei_ok(qw(import -F eml t/x-unknown-alpine.eml)); +is($lei_err, '', 'no errors importing previous external-only message'); +lei_ok('q', "m:$m"); +$res = json_utf8->decode($lei_out); +is($res->[1], undef, 'got one result'); +is_deeply($res->[0]->{kw}, [ qw(answered flagged) ], 'kw preserved on exact'); + +# ensure fuzzy match import works, too +$m = 'multipart@example.com'; +$o = "$ENV{HOME}/fuzz"; +lei_ok('q', '-o', $o, "m:$m", @inc); +@fn = glob("$o/cur/*"); +scalar(@fn) == 1 or xbail $lei_err, "wrote multiple or zero files", \@fn; +rename($fn[0], "$fn[0]S") or BAIL_OUT "rename $!"; +lei_ok('q', '-o', $o, "m:$m"); +is_deeply([glob("$o/cur/*")], [], 'clobbered output results'); +my $eml = eml_load('t/plack-2-txt-bodies.eml'); +$eml->header_set('List-Id', '<list.example.com>'); +my $in = $eml->as_string; +lei_ok([qw(import -F eml --stdin)], undef, { 0 => \$in, %$lei_opt }); +is($lei_err, '', 'no errors from import'); +lei_ok(qw(q -f mboxrd), "m:$m"); +open $fh, '<', \$lei_out or BAIL_OUT $!; +my @res; +PublicInbox::MboxReader->mboxrd($fh, sub { push @res, shift }); +is($res[0]->header('Status'), 'RO', 'seen kw set'); +$res[0]->header_set('Status'); +is_deeply(\@res, [ $eml ], 'imported message matches w/ List-Id'); + +$eml->header_set('List-Id', '<another.example.com>'); +$in = $eml->as_string; +lei_ok([qw(import -F eml --stdin)], undef, { 0 => \$in, %$lei_opt }); +is($lei_err, '', 'no errors from 2nd import'); +lei_ok(qw(q -f mboxrd), "m:$m", 'l:another.example.com'); +my @another; +open $fh, '<', \$lei_out or BAIL_OUT $!; +PublicInbox::MboxReader->mboxrd($fh, sub { push @another, shift }); +is($another[0]->header('Status'), 'RO', 'seen kw set'); + +# forwarded +{ + local $ENV{DBG} = 1; + $o = "$ENV{HOME}/forwarded"; + lei_ok(qw(q -o), $o, "m:$m"); + my @p = glob("$o/cur/*"); + scalar(@p) == 1 or xbail('multiple when 1 expected', \@p); + my $passed = $p[0]; + $passed =~ s/,S\z/,PS/ or xbail "failed to replace $passed"; + rename($p[0], $passed) or xbail "rename $!"; + lei_ok(qw(q -o), $o, 'm:bogus', \'clobber maildir'); + is_deeply([glob("$o/cur/*")], [], 'old results clobbered'); + lei_ok(qw(q -o), $o, "m:$m"); + @p = glob("$o/cur/*"); + scalar(@p) == 1 or xbail('multiple when 1 expected', \@p); + like($p[0], qr/,PS/, 'passed (Forwarded) flag kept'); + lei_ok(qw(q -o), "mboxrd:$o.mboxrd", "m:$m"); + open $fh, '<', "$o.mboxrd" or xbail $!; + my @res; + PublicInbox::MboxReader->mboxrd($fh, sub { push @res, shift }); + scalar(@res) == 1 or xbail('multiple when 1 expected', \@res); + is($res[0]->header('Status'), 'RO', 'seen kw set'); + is($res[0]->header('X-Status'), undef, 'no X-Status'); + + lei_ok(qw(q -o), "mboxrd:$o.mboxrd", 'bogus-for-import-before'); + lei_ok(qw(q -o), $o, "m:$m"); + @p = glob("$o/cur/*"); + scalar(@p) == 1 or xbail('multiple when 1 expected', \@p); + like($p[0], qr/,PS/, 'passed (Forwarded) flag still kept'); +} + +}); # test_lei +done_testing; diff --git a/t/lei-q-remote-import.t b/t/lei-q-remote-import.t index f73524cf..885fa3e1 100644 --- a/t/lei-q-remote-import.t +++ b/t/lei-q-remote-import.t @@ -1,9 +1,10 @@ #!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)); +use v5.12; use PublicInbox::TestCommon; +use autodie qw(open close unlink); +require_mods(qw(lei -httpd)); +require_cmd 'curl'; use PublicInbox::MboxReader; my ($ro_home, $cfg_path) = setup_public_inboxes; my $sock = tcp_server; @@ -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,20 +32,83 @@ 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'); + 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; + lei_ok(@cmd, '--lock=none'); + ok(-f $o && -s _, '--lock=none respected') or diag $lei_err; + 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"; + lei_ok(@cmd, '--lock=dotlock,timeout=0.000001', + \'succeeds after lock removal'); + + my $ibx = create_inbox 'local-external', indexlevel => 'medium', sub { + my ($im) = @_; + $im->add(eml_load('t/utf8.eml')) or BAIL_OUT '->add'; + }; + lei_ok(qw(add-external -q), $ibx->{inboxdir}); + lei_ok(qw(q -q -o), "mboxrd:$o", '--only', $url, + 'm:testmessage@example.com'); + is($lei_err, '', 'no warnings or errors'); + ok(-s $o, 'got result from remote external'); + my $exp = eml_load('t/utf8.eml'); + is_deeply($slurp_emls->($o), [$exp], 'got expected result'); + lei_ok(qw(q --no-external -o), "mboxrd:/dev/stdout", + 'm:testmessage@example.com'); + is($lei_out, '', 'message not imported when in local external'); + + 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 +Message-ID: <never-before-seen@example.com> +Status: OR + +whatever +EOF + 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; + lei_ok(qw(q -o mboxrd:/dev/stdout m:never-before-seen@example.com)); + like($lei_out, qr/seen\@example\.com>\nStatus: RO\n\nwhatever/sm, + '--import-before imported totally unseen message'); + + lei_ok(qw(q --save z:0.. -o), "$ENV{HOME}/md", '--only', $url); + my @f = glob("$ENV{HOME}/md/*/*"); + lei_ok('up', "$ENV{HOME}/md"); + is_deeply(\@f, [ glob("$ENV{HOME}/md/*/*") ], + 'lei up remote dedupe works on maildir'); + my $edit_env = { VISUAL => 'cat', EDITOR => 'cat' }; + 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 new file mode 100644 index 00000000..0970bc3c --- /dev/null +++ b/t/lei-q-save.t @@ -0,0 +1,311 @@ +#!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 autodie qw(close open unlink); +use PublicInbox::Smsg; +use List::Util qw(sum); +use File::Path qw(remove_tree); + +my $doc1 = eml_load('t/plack-qp.eml'); +$doc1->header_set('Date', PublicInbox::Smsg::date({ds => time - (86400 * 5)})); +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 + +blah +EOF + +test_lei(sub { + my $home = $ENV{HOME}; + my $in = $doc1->as_string; + lei_ok [qw(import -q -F eml -)], undef, { 0 => \$in, %$lei_opt }; + lei_ok qw(q -q z:0.. d:last.week..), '-o', "MAILDIR:$home/md/"; + my %before = map { $_ => 1 } glob("$home/md/cur/*"); + my $f = (keys %before)[0] or xbail({before => \%before}); + is_deeply(eml_load($f), $doc1, 'doc1 matches'); + lei_ok qw(ls-mail-sync); + is($lei_out, "maildir:$home/md\n", 'canonicalized mail sync name'); + + my @s = glob("$home/.local/share/lei/saved-searches/md-*"); + is(scalar(@s), 1, 'got one saved search'); + my $cfg = PublicInbox::Config->new("$s[0]/lei.saved-search"); + is($cfg->{'lei.q.output'}, "maildir:$home/md", 'canonicalized output'); + is_deeply($cfg->{'lei.q'}, ['z:0..', 'd:last.week..'], + 'store relative time, not parsed (absolute) timestamp'); + + # ensure "lei up" works, since it compliments "lei q --save" + $in = $doc2->as_string; + lei_ok [qw(import -q -F eml -)], undef, { 0 => \$in, %$lei_opt }; + lei_ok qw(up -q md -C), $home; + lei_ok qw(up -q . -C), "$home/md"; + lei_ok qw(up -q), "/$home/md"; + my %after = map { $_ => 1 } glob("$home/md/{new,cur}/*"); + is(delete $after{(keys(%before))[0]}, 1, 'original message kept'); + is(scalar(keys %after), 1, 'one new message added'); + $f = (keys %after)[0] or xbail({after => \%after}); + is_deeply(eml_load($f), $doc2, 'doc2 matches'); + + # check stdin + lei_ok [qw(q - -o), "mboxcl2:mbcl2" ], undef, + { -C => $home, %$lei_opt, 0 => \'d:last.week..'}; + @s = glob("$home/.local/share/lei/saved-searches/mbcl2-*"); + $cfg = PublicInbox::Config->new("$s[0]/lei.saved-search"); + is_deeply $cfg->{'lei.q'}, 'd:last.week..', + 'q --stdin stores relative time'; + my $size = -s "$home/mbcl2"; + ok(defined($size) && $size > 0, 'results written'); + lei_ok([qw(up mbcl2)], undef, { -C => $home, %$lei_opt }); + is(-s "$home/mbcl2", $size, 'size unchanged on noop up'); + + $in = $doc3->as_string; + lei_ok [qw(import -q -F eml -)], undef, { 0 => \$in, %$lei_opt }; + lei_ok([qw(up mbcl2)], undef, { -C => $home, %$lei_opt }); + ok(-s "$home/mbcl2" > $size, 'size increased after up'); + + ok(!lei(qw(up -q), $home), 'up fails on unknown dir'); + like($lei_err, qr/--no-save was used/, 'error noted --no-save'); + + lei_ok(qw(q --no-save d:last.week.. -q -o), "$home/no-save"); + ok(!lei(qw(up -q), "$home/no-save"), 'up fails on --no-save'); + like($lei_err, qr/--no-save was used/, 'error noted --no-save'); + + lei_ok qw(ls-search); my @d = split(/\n/, $lei_out); + lei_ok qw(ls-search -z); my @z = split(/\0/, $lei_out); + is_deeply(\@d, \@z, '-z output matches non-z'); + is_deeply(\@d, [ "$home/mbcl2", "$home/md" ], + 'ls-search output alphabetically sorted'); + lei_ok qw(ls-search -l); + my $json = PublicInbox::Config->json->decode($lei_out); + ok($json && $json->[0]->{output}, 'JSON has output'); + lei_ok qw(_complete lei up); + 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"); + lei_ok qw(_complete lei up); + like($lei_out, qr!^\Q$home/mbcl2\E$!sm, + 'mbcl2 output shown despite unlink'); + lei_ok([qw(up mbcl2)], undef, { -C => $home, %$lei_opt }); + ok(-f "$home/mbcl2" && -s _ == 0, 'up recreates on missing output'); + + # no --augment + open my $mb, '>', "$home/mbrd"; + print $mb $pre_existing; + close $mb; + lei_ok(qw(q -o mboxrd:mbrd m:qp@example.com -C), $home); + open $mb, '<', "$home/mbrd"; + is_deeply([grep(/pre-existing/, <$mb>)], [], + 'pre-existing messsage gone w/o augment'); + 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"; + print $mb $pre_existing; + close $mb; + lei_ok(qw(q -a -o mboxrd:mbrd-aug m:qp@example.com -C), $home); + 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'); + + lei_ok(qw(up --all=local)); + + ok(!lei(qw(forget-search), "$home/bogus"), 'bogus forget'); + like($lei_err, qr/--save was not used/, 'error noted --save'); + + lei_ok qw(_complete lei forget-search); + like($lei_out, qr/mbrd-aug/, 'forget-search completion'); + lei_ok(qw(forget-search -v), "$home/mbrd-aug"); + is($lei_out, '', 'no output'); + like($lei_err, qr/\bmbrd-aug\b/, '-v (verbose) reported unlinks'); + lei_ok qw(_complete lei forget-search); + unlike($lei_out, qr/mbrd-aug/, + 'forget-search completion cleared after forget'); + ok(!lei('up', "$home/mbrd-aug"), 'lei up fails after forget'); + like($lei_err, qr/--no-save was used/, 'error noted --no-save'); + + # dedupe=mid + my $o = "$home/dd-mid"; + $in = $doc2->as_string . "\n-------\nappended list sig\n"; + lei_ok [qw(import -q -F eml -)], undef, { 0 => \$in, %$lei_opt }; + lei_ok(qw(q --dedupe=mid m:testmessage@example.com -o), $o); + my @m = glob("$o/cur/*"); + is(scalar(@m), 1, '--dedupe=mid w/ --save'); + $in = $doc2->as_string . "\n-------\nanother list sig\n"; + lei_ok [qw(import -q -F eml -)], undef, { 0 => \$in, %$lei_opt }; + lei_ok 'up', $o; + is_deeply([glob("$o/cur/*")], \@m, 'lei up dedupe=mid works'); + + for my $dd (qw(content)) { + $o = "$home/dd-$dd"; + lei_ok(qw(q m:testmessage@example.com -o), $o, "--dedupe=$dd"); + @m = glob("$o/cur/*"); + is(scalar(@m), 3, 'all 3 matches with dedupe='.$dd); + } + + # dedupe=oid + $o = "$home/dd-oid"; + my $ibx = create_inbox 'ibx', indexlevel => 'medium', + tmpdir => "$home/v1", sub {}; + lei_ok(qw(q --dedupe=oid m:qp@example.com -o), $o, + '-I', $ibx->{inboxdir}); + @m = glob("$o/cur/*"); + is(scalar(@m), 1, 'got first result'); + + my $im = $ibx->importer(0); + my $diff = "X-Insignificant-Header: x\n".$doc1->as_string; + $im->add(PublicInbox::Eml->new($diff)); + $im->done; + lei_ok('up', $o); + @m = glob("$o/{new,cur}/*"); + is(scalar(@m), 2, 'got 2nd result due to different OID'); + + SKIP: { + symlink($o, "$home/ln -s") or + skip "symlinks not supported in $home?: $!", 1; + lei_ok('up', "$home/ln -s"); + lei_ok('forget-search', "$home/ln -s"); + }; + + my $v2 = "$home/v2"; # v2: as an output destination + my (@before, @after); + require PublicInbox::MboxReader; + 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('-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'); + my $orig = sum(map { -f $_ ? -s _ : () } ( + glob("$v2/git/0.git/objects/*/*"))); + lei_ok(qw(import t/data/0001.patch)); + lei_ok 'up', $v2; + lei_ok(qw(q z:0.. -o), "mboxrd:$home/after", '--only', $v2, '-j1,1'); + open $fh, '<', "$home/after"; + PublicInbox::MboxReader->mboxrd($fh, sub { push @after, $_[0] }); + + my $last = shift @after; + $last->header_set('Status'); + is_deeply($last, eml_load('t/data/0001.patch'), 'lei up worked on v2'); + is_deeply(\@before, \@after, 'got same results'); + + my $v2s = "$home/v2s"; + lei_ok(qw(q --shared z:0.. -o), "v2:$v2s"); + my $shared = sum(map { -f $_ ? -s _ : () } ( + glob("$v2s/git/0.git/objects/*/*"))); + ok($shared < $orig, 'fewer bytes stored with --shared') or + diag "shared=$shared orig=$orig"; + + 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)); + lei_ok qw(ls-search); + unlike $lei_out, qr{/\.\./s$}sm, 'relative path not in ls-search'; + like $lei_out, qr{^\Q$home\E/s$}sm, + 'absolute path appears in ls-search'; + lei_ok qw(up ../s -C), "$home/v2s", \'relative lei up'; + lei_ok qw(up), "$home/s", \'absolute lei up'; + + # mess up a config file + 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_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_e($^X, qw(-w -i -p -e), "s/\\0/\\[/", $lss[0]); + lei_ok qw(ls-search); + is($lei_err, '', 'no errors w/ fixed config'); + + like($lei_out, qr!\Q$home/after\E!, "`after' in ls-search"); + remove_tree("$home/after"); + lei_ok qw(forget-search --prune); + lei_ok qw(ls-search); + unlike($lei_out, qr!\Q$home/after\E!, "`after' pruned"); + + my $d = "$home/d"; + lei_ok [qw(import -q -F eml)], undef, + {%$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, + {%$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, + {%$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'); + is_deeply([glob("$d/cur/*")], \@orig, 'cur untouched'); + my @new = glob("$d/new/*"); + is(scalar(@new), 1, "new message written to `new'"); + is(eml_load($new[0])->header('Subject'), 'do not call, ever', + 'up retrieved correct message'); + + $d = "$home/d-stdin"; + 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, + {%$lei_opt, 0 => \"Subject: do not fall or ever call\n\n"}; + lei_ok [qw(import -q -Feml)], undef, + {%$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 { + for (@new) { diag "$_ ".eml_load($_)->header('Subject') } + }; + is_deeply([glob("$d/cur/*")], \@orig, 'cur untouched'); + 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 new file mode 100644 index 00000000..72d3a565 --- /dev/null +++ b/t/lei-q-thread.t @@ -0,0 +1,54 @@ +#!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; +require_git 2.6; +require_mods(qw(json DBD::SQLite Xapian)); +use PublicInbox::LeiToMail; +my ($ro_home, $cfg_path) = setup_public_inboxes; +test_lei(sub { + my $eml = eml_load('t/utf8.eml'); + my $buf = PublicInbox::LeiToMail::eml2mboxrd($eml, { kw => ['seen'] }); + lei_ok([qw(import -F mboxrd -)], undef, { 0 => $buf, %$lei_opt }); + + lei_ok qw(q -t m:testmessage@example.com); + my $res = json_utf8->decode($lei_out); + is_deeply($res->[0]->{kw}, [ 'seen' ], 'q -t sets keywords') or + diag explain($res); + + $eml = eml_load('t/utf8.eml'); + $eml->header_set('References', $eml->header('Message-ID')); + $eml->header_set('Message-ID', '<a-reply@miss>'); + $buf = PublicInbox::LeiToMail::eml2mboxrd($eml, { kw => ['draft'] }); + lei_ok([qw(import -F mboxrd -)], undef, { 0 => $buf, %$lei_opt }); + + lei_ok([qw(q - -t)], undef, + { 0 => \'m:testmessage@example.com', %$lei_opt }); + $res = json_utf8->decode($lei_out); + is(scalar(@$res), 3, 'got 2 results'); + pop @$res; + my %m = map { $_->{'m'} => $_ } @$res; + is_deeply($m{'testmessage@example.com'}->{kw}, ['seen'], + 'flag set in direct hit') or diag explain($res); + is_deeply($m{'a-reply@miss'}->{kw}, ['draft'], + 'flag set in thread hit') or diag explain($res); + + lei_ok qw(q -t -t m:testmessage@example.com); + $res = json_utf8->decode($lei_out); + is(scalar(@$res), 3, 'got 2 results with -t -t'); + pop @$res; + %m = map { $_->{'m'} => $_ } @$res; + is_deeply($m{'testmessage@example.com'}->{kw}, ['flagged', 'seen'], + 'flagged set in direct hit') or diag explain($res); + is_deeply($m{'a-reply@miss'}->{kw}, ['draft'], + 'set in thread hit') or diag explain($res); + lei_ok qw(q -tt m:testmessage@example.com --only), "$ro_home/t2"; + $res = json_utf8->decode($lei_out); + is_deeply($res->[0]->{kw}, [ qw(flagged seen) ], + 'flagged set on external with -tt') or diag explain($res); + lei_ok qw(q -t m:testmessage@example.com --only), "$ro_home/t2"; + $res = json_utf8->decode($lei_out); + is_deeply($res->[0]->{kw}, [ 'seen' ], + 'flagged not set on external with 1 -t') or diag explain($res); +}); +done_testing; diff --git a/t/lei-refresh-mail-sync.t b/t/lei-refresh-mail-sync.t new file mode 100644 index 00000000..8ccc68c6 --- /dev/null +++ b/t/lei-refresh-mail-sync.t @@ -0,0 +1,158 @@ +#!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 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: $!"; + 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 { + my $d = "$ENV{HOME}/d"; + my ($ro_home, $cfg_path) = setup_public_inboxes; + lei_ok qw(daemon-pid); + lei_ok qw(add-external), "$ro_home/t2"; + lei_ok qw(q mid:testmessage@example.com -o), "Maildir:$d"; + my (@o) = glob("$d/*/*"); + scalar(@o) == 1 or xbail('multiple results', \@o); + my ($bn0) = ($o[0] =~ m!/([^/]+)\z!); + + my $oid = '9bf1002c49eb075df47247b74d69bcd555e23422'; + lei_ok 'inspect', "blob:$oid"; + my $before = json_utf8->decode($lei_out); + my $exp0 = { 'mail-sync' => { "maildir:$d" => [ $bn0 ] } }; + is_deeply($before, $exp0, 'inspect shows expected'); + + $stop_daemon->(); + my $dst = $o[0]; + $dst =~ s/:2,.*\z// and $dst =~ s!/cur/!/new/! and + rename($o[0], $dst) or xbail "rename($o[0] => $dst): $!"; + + lei_ok 'inspect', "blob:$oid"; + is_deeply(json_utf8->decode($lei_out), + $before, 'inspect unchanged immediately after restart'); + lei_ok 'refresh-mail-sync', '--all'; + lei_ok 'inspect', "blob:$oid"; + my ($bn1) = ($dst =~ m!/([^/]+)\z!); + my $exp1 = { 'mail-sync' => { "maildir:$d" => [ $bn1 ] } }; + is_deeply(json_utf8->decode($lei_out), $exp1, + 'refresh-mail-sync updated location'); + + $stop_daemon->(); + rename($dst, "$d/unwatched") or xbail "rename $dst out-of-the-way $!"; + + lei_ok 'refresh-mail-sync', $d; + lei_ok 'inspect', "blob:$oid"; + is($lei_out, '{}', 'no known locations after "removal"'); + lei_ok 'refresh-mail-sync', "Maildir:$d"; + + $stop_daemon->(); + rename("$d/unwatched", $dst) or xbail "rename $dst back"; + + lei_ok 'refresh-mail-sync', "Maildir:$d"; + lei_ok 'inspect', "blob:$oid"; + is_deeply(json_utf8->decode($lei_out), $exp1, + 'replaced file noted again'); + + $stop_daemon->(); + + remove_tree($d); + lei_ok 'refresh-mail-sync', '--all'; + lei_ok 'inspect', "blob:$oid"; + is($lei_out, '{}', 'no known locations after "removal"'); + lei_ok 'ls-mail-sync'; + is($lei_out, '', 'no sync left when folder is gone'); + +SKIP: { + require_mods(qw(-imapd -nntpd Mail::IMAPClient Net::NNTP), 1); + require File::Copy; # stdlib + my $home = $ENV{HOME}; + my $srv; + my $cfg_path2 = "$home/cfg2"; + File::Copy::cp($cfg_path, $cfg_path2); + my $env = { PI_CONFIG => $cfg_path2 }; + my $sock_cls; + for my $x (qw(imapd)) { + my $s = tcp_server; + $sock_cls //= ref($s); + my $cmd = [ "-$x", '-W0', "--stdout=$home/$x.out", + "--stderr=$home/$x.err" ]; + 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 }; + } + my $url = "imap://$srv->{imapd}->{addr}/t.v1.0"; + lei_ok 'import', $url, '+L:v1'; + lei_ok 'inspect', "blob:$oid"; + $before = json_utf8->decode($lei_out); + my @f = grep(m!\Aimap://;AUTH=ANONYMOUS\@\Q$srv->{imapd}->{addr}\E!, + keys %{$before->{'mail-sync'}}); + is(scalar(@f), 1, 'got IMAP folder') or xbail(\@f); + xsys([qw(git config), '-f', $cfg_path2, + qw(--unset publicinbox.t1.newsgroup)]) and + xbail "git config $?"; + $stop_daemon->(); # drop IMAP IDLE + $srv->{imapd}->{td}->kill('HUP'); + tick; # wait for HUP + lei_ok 'refresh-mail-sync', $url; + lei_ok 'inspect', "blob:$oid"; + my $after = json_utf8->decode($lei_out); + ok(!$after->{'mail-sync'}, 'no sync info for non-existent mailbox'); + lei_ok 'ls-mail-sync'; + unlike $lei_out, qr!^\Q$f[0]\E!, 'IMAP folder gone from mail_sync'; + + # simulate server downtime + $url = "imap://$srv->{imapd}->{addr}/t.v2.0"; + lei_ok 'import', $url, '+L:v2'; + + lei_ok 'inspect', "blob:$oid"; + $before = $lei_out; + delete $srv->{imapd}->{td}; # kill + join daemon + + my $pid = fork // xbail "fork"; + if ($pid == 0) { # dummy server to kill new connections + $SIG{TERM} = sub { POSIX::_exit(0) }; + $srv->{imapd}->{s}->blocking(1); + while (1) { + my $caddr = accept(my $c, $srv->{imapd}->{s}) // next; + shutdown($c, 2); + } + POSIX::_exit(0); + } + 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'); + { + 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); + 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'); +}; # imapd+nntpd stuff +}); + +done_testing; 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 new file mode 100644 index 00000000..b9fd88a6 --- /dev/null +++ b/t/lei-sigpipe.t @@ -0,0 +1,73 @@ +#!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 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 = 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, my $w); + my $size = $F_SETPIPE_SZ && fcntl($w, $F_SETPIPE_SZ, 4096) ? + 4096 : 65536; + unless (-f $f) { + 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; + } + + lei_ok(qw(import), $f) if $imported++ == 0; + 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); + my $s = do { local $/; <$errfh> }; + xbail "lei q had no output after 30s, stderr=$s"; + } + is(sysread($r, my $buf, 1), 1, 'read one byte'); + close $r; # trigger SIGPIPE + $tp->join; + ok(WIFSIGNALED($?), "signaled @$out"); + is(WTERMSIG($?), SIGPIPE, "got SIGPIPE @$out"); + seek($errfh, 0, 0); + my $s = do { local $/; <$errfh> }; + is($s, '', "quiet after sigpipe @$out"); + } +}); + +done_testing; 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 new file mode 100644 index 00000000..7278dfcd --- /dev/null +++ b/t/lei-tag.t @@ -0,0 +1,121 @@ +#!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 v5.12; use PublicInbox::TestCommon; +require_git 2.6; +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) = @_; + my $args = $opt{args} // []; + my $mid = $opt{mid} // 'testmessage@example.com'; + lei_ok('q', "m:$mid", @$args); + my $res = json_utf8->decode($lei_out); + is($res->[1], undef, 'only got one result'); + my $msg = $opt{msg} ? " $opt{msg}" : ''; + ($exp ? is_deeply($res->[0]->{kw}, $exp, "got @$exp$msg") + : is($res->[0]->{kw}, undef, "got undef$msg")) or + diag explain($res); + if (exists $opt{L}) { + $exp = $opt{L}; + ($exp ? is_deeply($res->[0]->{L}, $exp, "got @$exp$msg") + : is($res->[0]->{L}, undef, "got undef$msg")) or + diag explain($res); + } +}; + +test_lei(sub { + lei_ok(qw(ls-label)); is($lei_out, '', 'no labels, yet'); + lei_ok(qw(import t/utf8.eml)); + lei_ok(qw(tag t/utf8.eml +kw:flagged +L:urgent)); + $check_kw->(['flagged'], L => ['urgent']); + lei_ok(qw(ls-label)); is($lei_out, "urgent\n", 'label found'); + ok(!lei(qw(tag -F eml t/utf8.eml +kw:seeen)), 'bad kw rejected'); + like($lei_err, qr/`seeen' is not one of/, 'got helpful error'); + + ok(!lei(qw(tag -F eml t/utf8.eml +k:seen)), 'bad prefix rejected'); + like($lei_err, qr/Unable to handle.*\Q+k:seen\E/, 'bad prefix noted'); + + ok(!lei(qw(tag -F eml t/utf8.eml)), 'no keywords'); + like($lei_err, qr/no keywords or labels specified/, + 'lack of kw/L noted'); + + my $mb = "$ENV{HOME}/mb"; + my $md = "$ENV{HOME}/md"; + lei_ok(qw(q m:testmessage@example.com -o), "mboxrd:$mb"); + ok(-s $mb, 'wrote mbox result'); + lei_ok(qw(q m:testmessage@example.com -o), $md); + my @fn = glob("$md/cur/*"); + scalar(@fn) == 1 or xbail $lei_err, 'no mail', \@fn; + rename($fn[0], "$fn[0]S") or BAIL_OUT "rename $!"; + $check_kw->(['flagged'], msg => 'after bad request'); + lei_ok(qw(tag -F eml t/utf8.eml -kw:flagged)); + $check_kw->(undef, msg => 'keyword cleared'); + lei_ok(qw(tag -F mboxrd +kw:seen), $mb); + $check_kw->(['seen'], msg => 'mbox Status ignored'); + lei_ok(qw(tag -kw:seen +kw:answered), $md); + $check_kw->(['answered'], msg => 'Maildir Status ignored'); + + open my $in, '<', 't/utf8.eml' or BAIL_OUT $!; + lei_ok([qw(tag -F eml - +kw:seen +L:nope)], + undef, { %$lei_opt, 0 => $in }); + $check_kw->(['answered', 'seen'], msg => 'stdin works'); + lei_ok(qw(q L:urgent)); + my $res = json_utf8->decode($lei_out); + is($res->[0]->{'m'}, 'testmessage@example.com', 'L: query works'); + lei_ok(qw(q kw:seen)); + my $r2 = json_utf8->decode($lei_out); + is_deeply($r2, $res, 'kw: query works, too') or + diag explain([$r2, $res]); + + lei_ok(qw(_complete lei tag)); + my %c = map { $_ => 1 } split(/\s+/, $lei_out); + ok($c{'+L:urgent'} && $c{'-L:urgent'} && + $c{'+L:nope'} && $c{'-L:nope'}, 'completed with labels'); + + my $mid = 'qp@example.com'; + lei_ok qw(q -f mboxrd --only), "$ro_home/t2", "mid:$mid"; + $in = $lei_out; + lei_ok [qw(tag -F mboxrd --stdin +kw:seen +L:qp)], + undef, { %$lei_opt, 0 => \$in }; + $check_kw->(['seen'], L => ['qp'], mid => $mid, + args => [ '--only', "$ro_home/t2" ], + msg => 'external-only message'); + lei_ok(qw(ls-label)); + is($lei_out, "nope\nqp\nurgent\n", 'ls-label shows qp'); + + lei_ok qw(tag -F eml t/utf8.eml +L:inbox +L:x); + lei_ok qw(q m:testmessage@example.com); + $check_kw->([qw(answered seen)], L => [qw(inbox nope urgent x)]); + lei_ok(qw(ls-label)); + is($lei_out, "inbox\nnope\nqp\nurgent\nx\n", 'ls-label shows qp'); + + lei_ok qw(q L:inbox); + is(json_utf8->decode($lei_out)->[0]->{blob}, + $r2->[0]->{blob}, 'label search works'); + + ok(!lei(qw(tag -F eml t/utf8.eml +L:ALLCAPS)), '+L:ALLCAPS fails'); + lei_ok(qw(ls-label)); + is($lei_out, "inbox\nnope\nqp\nurgent\nx\n", 'ls-label unchanged'); + + 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; diff --git a/t/lei-up.t b/t/lei-up.t new file mode 100644 index 00000000..2d3afd82 --- /dev/null +++ b/t/lei-up.t @@ -0,0 +1,54 @@ +#!perl -w +# Copyright 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 $GunzipError); +test_lei(sub { + my ($ro_home, $cfg_path) = setup_public_inboxes; + 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), "$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); + + 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'); + + undef $uc; + gunzip("$home/b.mbox.gz" => \$uc, MultiStream => 1) or + xbail "gunzip $GunzipError"; + is($uc, $exp, 'compressed and uncompressed match (b.gz)'); + + open $fh, '<', "$home/b" or xbail "open: $!"; + $uc = do { local $/; <$fh> }; + is($uc, $exp, 'uncompressed both match'); + + lei_ok [ qw(up -q), "$home/b", "--mua=touch $home/c" ], + undef, { run_mode => 0 }; + ok(-f "$home/c", '--mua works with single output'); +}); + +done_testing; diff --git a/t/lei-watch.t b/t/lei-watch.t new file mode 100644 index 00000000..8ad50d13 --- /dev/null +++ b/t/lei-watch.t @@ -0,0 +1,107 @@ +#!perl -w +# Copyright 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::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 PublicInbox::Inotify } || + eval { require IO::KQueue }; + +$have_fast_inotify or + diag("$0 IO::KQueue or inotify missing, test will be slow"); + +my ($ro_home, $cfg_path) = setup_public_inboxes; +test_lei(sub { + 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'; + is($lei_out, '', 'nothing in ls-watch, yet'); + + my ($ino_fdinfo, $ino_contents); + SKIP: { + $have_fast_inotify && $^O eq 'linux' or + skip 'Linux/inotify-only internals check', 1; + lei_ok 'daemon-pid'; chomp(my $pid = $lei_out); + skip 'missing /proc/$PID/fd', 1 if !-d "/proc/$pid/fd"; + my @ino = grep { + (readlink($_) // '') =~ /\binotify\b/ + } glob("/proc/$pid/fd/*"); + is(scalar(@ino), 1, 'only one inotify FD'); + my $ino_fd = (split('/', $ino[0]))[-1]; + $ino_fdinfo = "/proc/$pid/fdinfo/$ino_fd"; + open my $fh, '<', $ino_fdinfo or xbail "open $ino_fdinfo: $!"; + $ino_contents = [ <$fh> ]; + } + + if (0) { # TODO + my $url = 'imaps://example.com/foo.bar.0'; + lei_ok([qw(add-watch --state=pause), $url], undef, {}); + lei_ok 'ls-watch'; + is($lei_out, "$url\n", 'ls-watch shows added watch'); + ok(!lei(qw(add-watch --state=pause), 'bogus'.$url), + 'bogus URL rejected'); + } + + # first, make sure tag-ro works + 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) + + lei_ok qw(q mid:testmessage@example.com -o), $md2, '-I', "$ro_home/t1"; + my @f2 = glob("$md2/*/*"); + is(scalar(@f2), 1, 'got one result'); + like($f2[0], qr/S\z/, 'seen set from rename') or diag explain(\@f2); + my $e2 = eml_load($f2[0]); + my $e1 = eml_load("$f[0]S"); + is_deeply($e2, $e1, 'results match'); + + SKIP: { + $ino_fdinfo or skip 'Linux/inotify-only watch check', 1; + open my $fh, '<', $ino_fdinfo or xbail "open $ino_fdinfo: $!"; + my $cmp = [ <$fh> ]; + ok(scalar(@$cmp) > scalar(@$ino_contents), + 'inotify has Maildir watches'); + } + + lei_ok 'rm-watch', $md; + lei_ok 'ls-watch', \'refresh watches'; + is($lei_out, '', 'no watches left'); + + lei_ok 'add-watch', $md2; + remove_tree($md2); + lei_ok 'rm-watch', "maildir:".$md2, \'with maildir: prefix'; + lei_ok 'ls-watch', \'refresh watches'; + is($lei_out, '', 'no watches left'); + + lei_ok 'add-watch', $md; + remove_tree($md); + lei_ok 'rm-watch', $md, \'absolute path w/ missing dir'; + lei_ok 'ls-watch', \'refresh watches'; + is($lei_out, '', 'no watches left'); + + SKIP: { + $ino_fdinfo or skip 'Linux/inotify-only removal removal', 1; + open my $fh, '<', $ino_fdinfo or xbail "open $ino_fdinfo: $!"; + 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,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> use strict; use v5.10.1; use PublicInbox::TestCommon; +require_mods 'lei'; use File::Path qw(rmtree); -use PublicInbox::Spawn qw(which); # this only tests the basic help/config/init/completion bits of lei; # actual functionality is tested in other t/lei-*.t tests -my $curl = which('curl'); my $home; my $home_trash = []; my $cleanup = sub { rmtree([@$home_trash, @_]) }; @@ -41,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 { @@ -93,6 +103,20 @@ my $test_config = sub { 'config set var with -f fails'); like($lei_err, qr/not supported/, 'not supported noted'); ok(!-f "$home/config/f", 'no file created'); + + lei_ok(qw(-c imap.debug config --bool imap.debug)); + is($lei_out, "true\n", "-c sets w/o value"); + lei_ok(qw(-c imap.debug=1 config --bool imap.debug)); + is($lei_out, "true\n", "-c coerces value"); + lei_ok(qw(-c imap.debug=tr00 config imap.debug)); + 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'); + 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 { @@ -105,7 +129,7 @@ my $test_completion = sub { %out = map { $_ => 1 } split(/\s+/s, $lei_out); for my $sw (qw(-f --format -o --output --mfolder --augment -a --mua --no-local --local --verbose -v - --save-as --no-remote --remote --torsocks + --save --no-save --no-remote --remote --torsocks --reverse -r )) { ok($out{$sw}, "$sw offered as `lei q' completion"); } @@ -122,8 +146,7 @@ my $test_completion = sub { } lei_ok(qw(_complete lei import)); %out = map { $_ => 1 } split(/\s+/s, $lei_out); - for my $sw (qw(--flags --no-flags --no-kw --kw --no-keywords - --keywords)) { + for my $sw (qw(--no-kw --kw)) { ok($out{$sw}, "$sw offered as `lei import' completion"); } }; @@ -133,12 +156,44 @@ my $test_fail = sub { is($? >> 8, 1, 'chdir at end fails to /dev/null'); lei('-C', '/dev/null', 'q', 'whatever'); is($? >> 8, 1, 'chdir at beginning fails to /dev/null'); + + 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"; + 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'), + "newline $lk.lock fails with q $fl"); + like($lei_err, qr/`\\n' not allowed/, + "error noted with q $fl"); + } + } + 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 which('curl'); + skip 'no curl', 3 unless require_cmd('curl', 1); lei(qw(q --only http://127.0.0.1:99999/bogus/ t:m)); is($? >> 8, 3, 'got curl exit for bogus URL'); lei(qw(q --only http://127.0.0.1:99999/bogus/ t:m -o), "$home/junk"); - is($? >> 8, 3, 'got curl exit for bogus URL with Maildir'); + is($? >> 8, 3, 'got curl exit for bogus URL with Maildir') or + diag $lei_err; is($lei_out, '', 'no output'); }; # /SKIP }; @@ -153,4 +208,8 @@ test_lei(sub { $test_fail->(); }); +test_lei({ mods => [] }, sub { + lei_ok('sucks', \'no optional modules required'); +}); + done_testing; diff --git a/t/lei_dedupe.t b/t/lei_dedupe.t index bcb06a0a..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) }; @@ -74,10 +78,13 @@ ok(!$dd->is_dup($different), 'different is_dup with mid dedupe (augment)'); $different->header_set('Status', 'RO'); ok($dd->is_dup($different), 'different seen with oid dedupe Status removed'); -ok(!$dd->is_dup($eml, '01d'), '1st is_dup with oid dedupe'); -ok($dd->is_dup($different, '01d'), 'different content ignored if oid matches'); -ok($dd->is_dup($eml, '01D'), 'case insensitive oid comparison :P'); -ok(!$dd->is_dup($eml, '01dbad'), 'case insensitive oid comparison :P'); +$smsg = { blob => '01d' }; +ok(!$dd->is_dup($eml, $smsg), '1st is_dup with oid dedupe'); +ok($dd->is_dup($different, $smsg), 'different content ignored if oid matches'); +$smsg->{blob} = uc($smsg->{blob}); +ok($dd->is_dup($eml, $smsg), 'case insensitive oid comparison :P'); +$smsg->{blob} = '01dbad'; +ok(!$dd->is_dup($eml, $smsg), 'case insensitive oid comparison :P'); $smsg->{blob} = 'dead'; ok(!$dd->is_smsg_dup($smsg), 'smsg dedupe pass'); 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_lcat.t b/t/lei_lcat.t new file mode 100644 index 00000000..536abdea --- /dev/null +++ b/t/lei_lcat.t @@ -0,0 +1,44 @@ +#!perl -w +# Copyright (C) 2021 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +# unit test for "lei lcat" internals, see t/lei-lcat.t for functional test +use strict; +use v5.10.1; +use Test::More; +use_ok 'PublicInbox::LeiLcat'; +my $cb = \&PublicInbox::LeiLcat::extract_1; +my $ck = sub { + my ($txt, $exp, $t) = @_; + my $lei = {}; + is($cb->($lei, $txt), $exp, $txt); + ($t ? is_deeply($lei, { mset_opt => { threads => 1 } }, "-t $exp") + : is_deeply($lei, {}, "no -t for $exp")) or diag explain($lei); +}; + +for my $txt (qw(https://example.com/inbox/foo@bar/ + https://example.com/inbox/foo@bar + https://example.com/inbox/foo@bar/raw + id:foo@bar + mid:foo@bar + <foo@bar> + <https://example.com/inbox/foo@bar> + <https://example.com/inbox/foo@bar/raw> + <https://example.com/inbox/foo@bar/> + <nntp://example.com/foo@bar>)) { + $ck->($txt, 'mid:foo@bar'); +} + +for my $txt (qw(https://example.com/inbox/foo@bar/T/ + https://example.com/inbox/foo@bar/t/ + https://example.com/inbox/foo@bar/t.mbox.gz + <https://example.com/inbox/foo@bar/t.atom> + <https://example.com/inbox/foo@bar/t/>)) { + $ck->($txt, 'mid:foo@bar', '-t'); +} + +$ck->('https://example.com/x/foobar/T/', 'mid:foobar', '-t'); +$ck->('https://example.com/x/foobar/raw', 'mid:foobar'); +is($cb->(my $lei = {}, 'asdf'), undef, 'no Message-ID'); +is($cb->($lei = {}, 'm:x'), 'm:x', 'bare m: accepted'); + +done_testing; diff --git a/t/lei_mail_sync.t b/t/lei_mail_sync.t new file mode 100644 index 00000000..74a6c8aa --- /dev/null +++ b/t/lei_mail_sync.t @@ -0,0 +1,78 @@ +#!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 PublicInbox::TestCommon; +require_mods(qw(DBD::SQLite)); +require_ok 'PublicInbox::LeiMailSync'; +my ($dir, $for_destroy) = tmpdir(); +my $lms = PublicInbox::LeiMailSync->new("$dir/t.sqlite3"); + +$lms->lms_write_prepare; +my $ro = PublicInbox::LeiMailSync->new("$dir/t.sqlite3"); +is_deeply([$ro->folders], [], 'no folders, yet'); + +my $imap = 'imaps://bob@[::1]/INBOX;UIDVALIDITY=9'; +$lms->lms_write_prepare; +my $deadbeef = "\xde\xad\xbe\xef"; +is($lms->set_src($deadbeef, $imap, 1), 1, 'set IMAP once'); +ok($lms->set_src($deadbeef, $imap, 1) == 0, 'set IMAP idempotently'); +is_deeply([$ro->folders], [$imap], 'IMAP folder added'); +note explain([$ro->folders($imap)]); +note explain([$imap, [$ro->folders]]); +is_deeply([$ro->folders($imap)], [$imap], 'IMAP folder with full GLOB'); +is_deeply([$ro->folders('imaps://bob@[::1]/INBOX')], [$imap], + 'IMAP folder with partial GLOB'); + +is_deeply($ro->locations_for($deadbeef), + { $imap => [ 1 ] }, 'locations_for w/ imap'); + +my $maildir = 'maildir:/home/user/md'; +my $fname = 'foo:2,S'; +$lms->lms_write_prepare; +ok($lms->set_src($deadbeef, $maildir, \$fname), 'set Maildir once'); +ok($lms->set_src($deadbeef, $maildir, \$fname) == 0, 'set Maildir again'); +is_deeply($ro->locations_for($deadbeef), + { $imap => [ 1 ], $maildir => [ $fname ] }, + 'locations_for w/ maildir + imap'); + +if ('mess things up pretend old bug') { + $lms->lms_write_prepare; + diag "messing things up"; + $lms->{dbh}->do('UPDATE folders SET loc = ? WHERE loc = ?', undef, + "$maildir/", $maildir); + ok(delete $lms->{fmap}, 'clear folder map'); + + $lms->lms_write_prepare; + ok($lms->set_src($deadbeef, $maildir, \$fname), 'set Maildir once'); +}; + +is_deeply([sort($ro->folders)], [$imap, $maildir], 'both folders shown'); +my @res; +$ro->each_src($maildir, sub { + my ($oidbin, $id) = @_; + push @res, [ unpack('H*', $oidbin), $id ]; +}); +is_deeply(\@res, [ ['deadbeef', \$fname] ], 'each_src works on Maildir'); + +@res = (); +$ro->each_src($imap, sub { + my ($oidbin, $id) = @_; + push @res, [ unpack('H*', $oidbin), $id ]; +}); +is_deeply(\@res, [ ['deadbeef', 1] ], 'each_src works on IMAP'); + +is_deeply($ro->location_stats($maildir), { 'name.count' => 1 }, + 'Maildir location stats'); +is_deeply($ro->location_stats($imap), + { 'uid.count' => 1, 'uid.max' => 1, 'uid.min' => 1 }, + 'IMAP location stats'); +$lms->lms_write_prepare; +is($lms->clear_src($imap, 1), 1, 'clear_src on IMAP'); +is($lms->clear_src($maildir, \$fname), 1, 'clear_src on Maildir'); +ok($lms->clear_src($imap, 1) == 0, 'clear_src again on IMAP'); +ok($lms->clear_src($maildir, \$fname) == 0, 'clear_src again on Maildir'); +is_deeply($ro->location_stats($maildir), {}, 'nothing left'); + +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_saved_search.t b/t/lei_saved_search.t new file mode 100644 index 00000000..6d26cd2b --- /dev/null +++ b/t/lei_saved_search.t @@ -0,0 +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; +require_mods(qw(DBD::SQLite)); +use_ok 'PublicInbox::LeiSavedSearch'; + +done_testing; diff --git a/t/lei_store.t b/t/lei_store.t index c9360f8f..17ee0729 100644 --- a/t/lei_store.t +++ b/t/lei_store.t @@ -1,42 +1,29 @@ #!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'; my ($home, $for_destroy) = tmpdir(); my $opt = { 1 => \(my $out = ''), 2 => \(my $err = '') }; -my $store_dir = "$home/lst"; +my $store_dir = "$home/sto"; local $ENV{GIT_COMMITTER_EMAIL} = 'lei@example.com'; local $ENV{GIT_COMMITTER_NAME} = 'lei user'; -my $lst = PublicInbox::LeiStore->new($store_dir, { creat => 1 }); -ok($lst, '->new'); -my $smsg = $lst->add_eml(eml_load('t/data/0001.patch')); +my $sto = PublicInbox::LeiStore->new($store_dir, { creat => 1 }); +ok($sto, '->new'); +my $smsg = $sto->add_eml(eml_load('t/data/0001.patch')); like($smsg->{blob}, qr/\A[0-9a-f]+\z/, 'add returned OID'); my $eml = eml_load('t/data/0001.patch'); -is($lst->add_eml($eml), undef, 'idempotent'); -$lst->done; -is_deeply([$lst->mbox_keywords($eml)], [], 'no keywords'); -$eml->header_set('Status', 'RO'); -is_deeply([$lst->mbox_keywords($eml)], ['seen'], 'seen extracted'); -$eml->header_set('X-Status', 'A'); -is_deeply([$lst->mbox_keywords($eml)], [qw(answered seen)], - 'seen+answered extracted'); -$eml->header_set($_) for qw(Status X-Status); - -is_deeply([$lst->maildir_keywords('/foo:2,')], [], 'Maildir no keywords'); -is_deeply([$lst->maildir_keywords('/foo:2,S')], ['seen'], 'Maildir seen'); -is_deeply([$lst->maildir_keywords('/foo:2,RS')], ['answered', 'seen'], - 'Maildir answered + seen'); -is_deeply([$lst->maildir_keywords('/foo:2,RSZ')], ['answered', 'seen'], - 'Maildir answered + seen w/o Z'); +is($sto->add_eml($eml), undef, 'idempotent'); +$sto->done; { - my $es = $lst->search; + my $es = $sto->search; + ok($es->can('isrch'), ref($es). ' can ->isrch (for SolverGit)'); my $msgs = $es->over->query_xover(0, 1000); is(scalar(@$msgs), 1, 'one message'); is($msgs->[0]->{blob}, $smsg->{blob}, 'blob matches'); @@ -44,88 +31,125 @@ is_deeply([$lst->maildir_keywords('/foo:2,RSZ')], ['answered', 'seen'], is($mset->size, 1, 'search works'); is_deeply($es->mset_to_artnums($mset), [ $msgs->[0]->{num} ], 'mset_to_artnums'); - my @kw = $es->msg_keywords(($mset->items)[0]); + my $mi = ($mset->items)[0]; + my @kw = PublicInbox::Search::xap_terms('K', $mi->get_document); is_deeply(\@kw, [], 'no flags'); } for my $parallel (0, 1) { - $lst->{priv_eidx}->{parallel} = $parallel; - my $docids = $lst->set_eml_keywords($eml, qw(seen draft)); + $sto->{priv_eidx}->{parallel} = $parallel; + my $docids = $sto->set_eml_vmd($eml, { kw => [ qw(seen draft) ] }); is(scalar @$docids, 1, 'set keywords on one doc'); - $lst->done; - my @kw = $lst->search->msg_keywords($docids->[0]); + $sto->done; + my @kw = $sto->search->msg_keywords($docids->[0]); is_deeply(\@kw, [qw(draft seen)], 'kw matches'); - $docids = $lst->add_eml_keywords($eml, qw(seen draft)); - $lst->done; + $docids = $sto->add_eml_vmd($eml, {kw => [qw(seen draft)]}); + $sto->done; is(scalar @$docids, 1, 'idempotently added keywords to doc'); - @kw = $lst->search->msg_keywords($docids->[0]); + @kw = $sto->search->msg_keywords($docids->[0]); is_deeply(\@kw, [qw(draft seen)], 'kw matches after noop'); - $docids = $lst->remove_eml_keywords($eml, qw(seen draft)); + $docids = $sto->remove_eml_vmd($eml, {kw => [qw(seen draft)]}); is(scalar @$docids, 1, 'removed from one doc'); - $lst->done; - @kw = $lst->search->msg_keywords($docids->[0]); + $sto->done; + @kw = $sto->search->msg_keywords($docids->[0]); is_deeply(\@kw, [], 'kw matches after remove'); - $docids = $lst->remove_eml_keywords($eml, qw(answered)); + $docids = $sto->remove_eml_vmd($eml, {kw=> [qw(answered)]}); is(scalar @$docids, 1, 'removed from one doc (idempotently)'); - $lst->done; - @kw = $lst->search->msg_keywords($docids->[0]); + $sto->done; + @kw = $sto->search->msg_keywords($docids->[0]); is_deeply(\@kw, [], 'kw matches after remove (idempotent)'); - $docids = $lst->add_eml_keywords($eml, qw(answered)); + $docids = $sto->add_eml_vmd($eml, {kw => [qw(answered)]}); is(scalar @$docids, 1, 'added to empty doc'); - $lst->done; - @kw = $lst->search->msg_keywords($docids->[0]); + $sto->done; + @kw = $sto->search->msg_keywords($docids->[0]); is_deeply(\@kw, ['answered'], 'kw matches after add'); - $docids = $lst->set_eml_keywords($eml); + $docids = $sto->set_eml_vmd($eml, { kw => [] }); is(scalar @$docids, 1, 'set to clobber'); - $lst->done; - @kw = $lst->search->msg_keywords($docids->[0]); + $sto->done; + @kw = $sto->search->msg_keywords($docids->[0]); is_deeply(\@kw, [], 'set clobbers all'); my $set = eml_load('t/plack-qp.eml'); $set->header_set('Message-ID', "<set\@$parallel>"); - my $ret = $lst->set_eml($set, 'seen'); + my $ret = $sto->set_eml($set, { kw => [ 'seen' ] }); is(ref $ret, 'PublicInbox::Smsg', 'initial returns smsg'); - my $ids = $lst->set_eml($set, qw(seen)); + my $ids = $sto->set_eml($set, { kw => [ 'seen' ] }); is_deeply($ids, [ $ret->{num} ], 'set_eml idempotent'); - $ids = $lst->set_eml($set, qw(seen answered)); + $ids = $sto->set_eml($set, { kw => [ qw(seen answered) ] }); is_deeply($ids, [ $ret->{num} ], 'set_eml to change kw'); - $lst->done; - @kw = $lst->search->msg_keywords($ids->[0]); + $sto->done; + @kw = $sto->search->msg_keywords($ids->[0]); is_deeply(\@kw, [qw(answered seen)], 'set changed kw'); } SKIP: { require_mods(qw(Storable), 1); - ok($lst->can('ipc_do'), 'ipc_do works if we have Storable'); + ok($sto->can('ipc_do'), 'ipc_do works if we have Storable'); $eml->header_set('Message-ID', '<ipc-test@example>'); - my $pid = $lst->ipc_worker_spawn('lei-store'); + my $pid = $sto->ipc_worker_spawn('lei-store'); ok($pid > 0, 'got a worker'); - my $smsg = $lst->ipc_do('set_eml', $eml, qw(seen)); + my $smsg = $sto->ipc_do('set_eml', $eml, { kw => [ qw(seen) ] }); is(ref($smsg), 'PublicInbox::Smsg', 'set_eml works over ipc'); - my $ids = $lst->ipc_do('set_eml', $eml, qw(seen)); + my $ids = $sto->ipc_do('set_eml', $eml, { kw => [ qw(seen) ] }); is_deeply($ids, [ $smsg->{num} ], 'docid returned'); $eml->header_set('Message-ID'); - my $no_mid = $lst->ipc_do('set_eml', $eml, qw(seen)); - my $wait = $lst->ipc_do('done'); - my @kw = $lst->search->msg_keywords($no_mid->{num}); + my $no_mid = $sto->ipc_do('set_eml', $eml, { kw => [ qw(seen) ] }); + my $wait = $sto->ipc_do('done'); + my @kw = $sto->search->msg_keywords($no_mid->{num}); is_deeply(\@kw, [qw(seen)], 'ipc set changed kw'); is(ref($smsg), 'PublicInbox::Smsg', 'no mid works ipc'); - $ids = $lst->ipc_do('set_eml', $eml, qw(seen)); + $ids = $sto->ipc_do('set_eml', $eml, { kw => [ qw(seen) ] }); is_deeply($ids, [ $no_mid->{num} ], 'docid returned w/o mid w/ ipc'); - $lst->ipc_do('done'); - $lst->ipc_worker_stop; - $ids = $lst->ipc_do('set_eml', $eml, qw(seen answered)); + $sto->ipc_do('done'); + $sto->ipc_worker_stop; + $ids = $sto->ipc_do('set_eml', $eml, { kw => [ qw(seen answered) ] }); is_deeply($ids, [ $no_mid->{num} ], 'docid returned w/o mid w/o ipc'); - $wait = $lst->ipc_do('done'); - @kw = $lst->search->msg_keywords($no_mid->{num}); + $wait = $sto->ipc_do('done'); + + my $lse = $sto->search; + @kw = $lse->msg_keywords($no_mid->{num}); is_deeply(\@kw, [qw(answered seen)], 'set changed kw w/o ipc'); + is($lse->kw_changed($eml, [qw(answered seen)]), 0, + 'kw_changed false when unchanged'); + is($lse->kw_changed($eml, [qw(answered seen flagged)]), 1, + 'kw_changed true when +flagged'); + is($lse->kw_changed(eml_load('t/plack-qp.eml'), ['seen']), undef, + 'kw_changed undef on unknown message'); } +SKIP: { + require_mods(qw(HTTP::Date), 1); + my $now = HTTP::Date::time2str(time); + $now =~ s/GMT/+0000/ or xbail "no GMT in $now"; + my $eml = PublicInbox::Eml->new(<<"EOM"); +Received: (listserv\@example.com) by example.com via listexpand + id abcde (ORCPT <rfc822;u\@example.com>); + $now; +Date: $now +Subject: timezone-dependent test + +WHAT IS TIME ANYMORE? +EOM + + my $smsg = $sto->add_eml($eml); + ok($smsg && $smsg->{blob}, 'recently received message'); + $sto->done; + local $ENV{TZ} = 'GMT+5'; + my $lse = $sto->search; + my $qstr = 'rt:1.hour.ago.. s:timezone'; + $lse->query_approxidate($lse->git, $qstr); + my $mset = $lse->mset($qstr); + 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 7898cc48..dbd33909 100644 --- a/t/lei_to_mail.t +++ b/t/lei_to_mail.t @@ -1,13 +1,14 @@ #!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); -use PublicInbox::Spawn qw(popen_rd which); +use Fcntl qw(SEEK_SET O_RDONLY O_NONBLOCK); +use PublicInbox::Spawn qw(popen_rd); use List::Util qw(shuffle); require_mods(qw(DBD::SQLite)); require PublicInbox::MdirReader; @@ -28,7 +29,7 @@ for my $mbox (@MBOX) { my $s = $cb->(PublicInbox::Eml->new($from), $smsg); is(substr($$s, -1, 1), "\n", "trailing LF in normal $mbox"); my $eml = PublicInbox::Eml->new($s); - is($eml->header('Status'), 'OR', "Status: set by $m"); + is($eml->header('Status'), 'RO', "Status: set by $m"); is($eml->header('X-Status'), 'AF', "X-Status: set by $m"); if ($mbox eq 'mboxcl2') { like($eml->body_raw, qr/^From /, "From not escaped $m"); @@ -74,8 +75,8 @@ for my $mbox (@MBOX) { my ($tmpdir, $for_destroy) = tmpdir(); local $ENV{TMPDIR} = $tmpdir; -open my $err, '>>', "$tmpdir/lei.err" or BAIL_OUT $!; -my $lei = bless { 2 => $err }, 'PublicInbox::LEI'; +open my $err, '>>', "$tmpdir/lei.err"; +my $lei = bless { 2 => $err, cmd => 'test' }, 'PublicInbox::LEI'; my $commit = sub { $_[0] = undef; # wcb delete $lei->{1}; @@ -90,7 +91,7 @@ my $fn = "$tmpdir/x.mbox"; my ($mbox) = shuffle(@MBOX); # pick one, shouldn't matter my $wcb_get = sub { my ($fmt, $dst) = @_; - delete $lei->{dedupe}; + delete $lei->{dedupe}; # to be recreated $lei->{ovv} = bless { fmt => $fmt, dst => $dst @@ -114,24 +115,23 @@ 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; - local $lei->{opt} = { jobs => 2 }; $wcb = $wcb_get->($mbox, $fn); ok(-f $fn && !-s _, 'truncated mbox destination'); $wcb->(\($dup = $buf), $deadbeef); $commit->($wcb); - open $fh, '<', $fn or BAIL_OUT $!; - is(do { local $/; <$fh> }, $raw, 'jobs > 1'); + open $fh, '<', $fn; + is(do { local $/; <$fh> }, $raw, 'wrote identical content'); $raw; }; -test_lei(sub { - ok(lei(qw(import -F), $mbox, $fn), 'imported mbox'); - ok(lei(qw(q s:x)), 'lei q works') or diag $lei_err; +test_lei({tmpdir => "$tmpdir/using -F"}, sub { + lei_ok(qw(import -F), $mbox, $fn, \'imported mbox'); + lei_ok(qw(q s:x), \'lei q works') or diag $lei_err; my $res = json_utf8->decode($lei_out); my $x = $res->[0]; is($x->{'s'}, 'x', 'subject imported') or diag $lei_out; @@ -139,7 +139,7 @@ test_lei(sub { is($res->[1], undef, 'only one result'); }); -test_lei(sub { +test_lei({tmpdir => "$tmpdir/using TYPE: prefix"}, sub { lei_ok('import', "$mbox:$fn", \'imported mbox:/path') or diag $lei_err; lei_ok(qw(q s:x), \'lei q works') or diag $lei_err; my $res = json_utf8->decode($lei_out); @@ -149,8 +149,8 @@ test_lei(sub { is($res->[1], undef, 'only one result'); }); -for my $zsfx (qw(gz bz2 xz)) { # XXX should we support zst, zz, lzo, lzma? - my $zsfx2cmd = PublicInbox::LeiToMail->can('zsfx2cmd'); +my $zsfx2cmd = PublicInbox::MboxReader->can('zsfx2cmd'); +for my $zsfx (qw(gz bz2 xz)) { SKIP: { my $cmd = eval { $zsfx2cmd->($zsfx, 0, $lei) }; skip $@, 3 if $@; @@ -158,21 +158,20 @@ for my $zsfx (qw(gz bz2 xz)) { # XXX should we support zst, zz, lzo, lzma? ok($dc_cmd, "decompressor for .$zsfx"); my $f = "$fn.$zsfx"; my $wcb = $wcb_get->($mbox, $f); - $wcb->(\(my $dup = $buf), $deadbeef); + $wcb->(\(my $dup = $buf), { %$deadbeef }); $commit->($wcb); my $uncompressed = xqx([@$dc_cmd, $f]); is($uncompressed, $orig, "$zsfx works unlocked"); - local $lei->{opt} = { jobs => 2 }; # for atomic writes - unlink $f or BAIL_OUT "unlink $!"; + unlink $f; $wcb = $wcb_get->($mbox, $f); - $wcb->(\($dup = $buf), $deadbeef); + $wcb->(\($dup = $buf), { %$deadbeef }); $commit->($wcb); is(xqx([@$dc_cmd, $f]), $orig, "$zsfx matches with lock"); local $lei->{opt} = { augment => 1 }; $wcb = $wcb_get->($mbox, $f); - $wcb->(\($dup = $buf . "\nx\n"), $deadbeef); + $wcb->(\($dup = $buf . "\nx\n"), { %$deadbeef }); $commit->($wcb); my $cat = popen_rd([@$dc_cmd, $f]); @@ -182,9 +181,9 @@ for my $zsfx (qw(gz bz2 xz)) { # XXX should we support zst, zz, lzo, lzma? like($raw[1], qr/\nblah\n\nx\n\z/s, "augmented $zsfx"); like($raw[0], qr/\nblah\n\z/s, "original preserved $zsfx"); - local $lei->{opt} = { augment => 1, jobs => 2 }; + local $lei->{opt} = { augment => 1 }; $wcb = $wcb_get->($mbox, $f); - $wcb->(\($dup = $buf . "\ny\n"), $deadbeef); + $wcb->(\($dup = $buf . "\ny\n"), { %$deadbeef }); $commit->($wcb); my @raw3; @@ -203,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'); @@ -218,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'); @@ -227,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'); @@ -242,17 +241,18 @@ SKIP: { # FIFO support use POSIX qw(mkfifo); my $fn = "$tmpdir/fifo"; mkfifo($fn, 0600) or skip("mkfifo not supported: $!", 1); - my $cat = popen_rd([which('cat'), $fn]); + sysopen(my $cat, $fn, O_RDONLY|O_NONBLOCK); my $wcb = $wcb_get->('mboxo', $fn); $wcb->(\(my $x = $buf), $deadbeef); $commit->($wcb); my $cmp = ''; + $cat->blocking(1); PublicInbox::MboxReader->mboxo($cat, sub { $cmp .= $as_orig->(@_) }); is($cmp, $buf, 'message written to FIFO'); } { # Maildir support - my $each_file = PublicInbox::MdirReader->can('maildir_each_file'); + my $mdr = PublicInbox::MdirReader->new; my $md = "$tmpdir/maildir/"; my $wcb = $wcb_get->('maildir', $md); is(ref($wcb), 'CODE', 'got Maildir callback'); @@ -260,8 +260,8 @@ SKIP: { # FIFO support $wcb->(\(my $x = $buf), $b4dc0ffee); my @f; - $each_file->($md, sub { push @f, shift }); - open my $fh, $f[0] or BAIL_OUT $!; + $mdr->maildir_each_file($md, sub { push @f, shift }); + open my $fh, '<', $f[0]; is(do { local $/; <$fh> }, $buf, 'wrote to Maildir'); $wcb = $wcb_get->('maildir', $md); @@ -269,10 +269,10 @@ SKIP: { # FIFO support $wcb->(\($x = $buf."\nx\n"), $deadcafe); my @x = (); - $each_file->($md, sub { push @x, shift }); + $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; @@ -280,13 +280,13 @@ SKIP: { # FIFO support $wcb->(\($x = $buf."\ny\n"), $deadcafe); $wcb->(\($x = $buf."\ny\n"), $b4dc0ffee); # skipped by dedupe @f = (); - $each_file->($md, sub { push @f, shift }); + $mdr->maildir_each_file($md, sub { push @f, shift }); 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 f865ff43..977fb1e9 100644 --- a/t/lei_xsearch.t +++ b/t/lei_xsearch.t @@ -3,30 +3,24 @@ # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use v5.10.1; -use Test::More; -use List::Util qw(shuffle max); +use List::Util qw(shuffle); use PublicInbox::TestCommon; use PublicInbox::Eml; -use PublicInbox::InboxWritable; -require_mods(qw(DBD::SQLite Search::Xapian)); +require_mods(qw(DBD::SQLite Xapian)); require PublicInbox::ExtSearchIdx; require_git 2.6; require_ok 'PublicInbox::LeiXSearch'; +require_ok 'PublicInbox::LeiALE'; +require_ok 'PublicInbox::LEI'; my ($home, $for_destroy) = tmpdir(); my @ibx; for my $V (1..2) { for my $i (3..6) { - my $ibx = PublicInbox::InboxWritable->new({ - inboxdir => "$home/v$V-$i", - name => "test-v$V-$i", - version => $V, - indexlevel => 'medium', - -primary_address => "v$V-$i\@example.com", - }, { nproc => int(rand(8)) + 1 }); - push @ibx, $ibx; - my $im = $ibx->importer(0); - for my $j (0..9) { - my $eml = PublicInbox::Eml->new(<<EOF); + push @ibx, create_inbox("v$V-$i", indexlevel => 'full', + version => $V, sub { + my ($im, $ibx) = @_; + for my $j (0..9) { + my $eml = PublicInbox::Eml->new(<<EOM); From: x\@example.com To: $ibx->{-primary_address} Date: Fri, 02 Oct 1993 0$V:0$i:0$j +0000 @@ -34,14 +28,14 @@ Subject: v${V}i${i}j$j Message-ID: <v${V}i${i}j$j\@example> ${V}er ${i}on j$j -EOF - $im->add($eml); - } - $im->done; +EOM + $im->add($eml) or BAIL_OUT '->add'; + } + }); # create_inbox } } -my $first = shift @ibx; is($first->{name}, 'test-v1-3', 'first plucked'); -my $last = pop @ibx; is($last->{name}, 'test-v2-6', 'last plucked'); +my $first = shift @ibx; is($first->{name}, 'v1-3', 'first plucked'); +my $last = pop @ibx; is($last->{name}, 'v2-6', 'last plucked'); my $eidx = PublicInbox::ExtSearchIdx->new("$home/eidx"); $eidx->attach_inbox($first); $eidx->attach_inbox($last); @@ -67,15 +61,49 @@ 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 $max = max(map { $_->{docid} } @msgs); -is($lxs->smsg_for(($mset->items)[0])->{docid}, $max, - 'got highest docid'); my @ibxish = $lxs->locals; is(scalar(@ibxish), scalar(@ibx) + 1, 'got locals back'); is($lxs->search, $lxs, '->search works'); is($lxs->over, undef, '->over fails'); +{ + $lxs = PublicInbox::LeiXSearch->new; + my $v2ibx = create_inbox 'v2full', version => 2, sub { + $_[0]->add(eml_load('t/plack-qp.eml')); + }; + my $v1ibx = create_inbox 'v1medium', indexlevel => 'medium', + tmpdir => "$home/v1tmp", sub { + $_[0]->add(eml_load('t/utf8.eml')); + }; + $lxs->prepare_external($v1ibx); + $lxs->prepare_external($v2ibx); + for my $loc ($lxs->locals) { + $lxs->attach_external($loc); + } + my $mset = $lxs->mset('m:testmessage@example.com'); + is($mset->size, 1, 'got m: match on medium+full XSearch mix'); + my $mitem = ($mset->items)[0]; + my $smsg = $lxs->smsg_for($mitem) or BAIL_OUT 'smsg_for broken'; + + my $ale = PublicInbox::LeiALE::_new("$home/ale"); + my $lei = bless {}, 'PublicInbox::LEI'; + $ale->refresh_externals($lxs, $lei); + my $exp = [ $smsg->{blob}, 'blob', -s 't/utf8.eml' ]; + is_deeply([ $ale->git->check($smsg->{blob}) ], $exp, 'ale->git->check'); + + $lxs = PublicInbox::LeiXSearch->new; + $lxs->prepare_external($v2ibx); + $ale->refresh_externals($lxs, $lei); + is_deeply([ $ale->git->check($smsg->{blob}) ], $exp, + 'ale->git->check remembered inactive external'); + + rename("$home/v1tmp", "$home/v1moved") or BAIL_OUT "rename: $!"; + $ale->refresh_externals($lxs, $lei); + is($ale->git->check($smsg->{blob}), undef, + 'missing after directory gone'); +} + done_testing; 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 new file mode 100644 index 00000000..1fc828aa --- /dev/null +++ b/t/mbox_lock.t @@ -0,0 +1,103 @@ +#!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 autodie qw(chdir); +use POSIX qw(_exit); +use PublicInbox::DS qw(now); +use Errno qw(EAGAIN); +use PublicInbox::OnDestroy; +use_ok 'PublicInbox::MboxLock'; +my ($tmpdir, $for_destroy) = tmpdir(); +my $f = "$tmpdir/f"; +my $mbl = PublicInbox::MboxLock->acq($f, 1, ['dotlock']); +ok(-f "$f.lock", 'dotlock created'); +undef $mbl; +ok(!-f "$f.lock", 'dotlock gone'); +$mbl = PublicInbox::MboxLock->acq($f, 1, ['none']); +ok(!-f "$f.lock", 'no dotlock with none'); +undef $mbl; +{ + opendir my $cur, '.' 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 '/'; + ok(-f $abs, 'lock with abs path created'); + undef $rel; + ok(!-f $abs, 'lock gone despite being in the wrong dir'); +} + +eval { + PublicInbox::MboxLock->acq($f, 1, ['bogus']); + fail "should not succeed with `bogus'"; +}; +ok($@, "fails on `bogus' lock method"); +eval { + PublicInbox::MboxLock->acq($f, 1, ['timeout=1']); + fail "should not succeed with only timeout"; +}; +ok($@, "fails with only `timeout=' and no lock method"); + +my $defaults = PublicInbox::MboxLock->defaults; +is(ref($defaults), 'ARRAY', 'default lock methods'); +my $test_rw_lock = sub { + my ($func) = @_; + my $m = ["$func,timeout=0.000001"]; + for my $i (1..2) { + pipe(my ($r, $w)) or BAIL_OUT "pipe: $!"; + my $t0 = now; + my $pid = fork // BAIL_OUT "fork $!"; + if ($pid == 0) { + eval { PublicInbox::MboxLock->acq($f, 1, $m) }; + my $err = $@; + syswrite $w, "E: $err"; + _exit($err ? 0 : 1); + } + undef $w; + waitpid($pid, 0); + is($?, 0, "$func r/w lock behaved as expected #$i"); + my $d = now - $t0; + ok($d < 1, "$func r/w timeout #$i") or diag "elapsed=$d"; + my $err = do { local $/; <$r> }; + $! = EAGAIN; + my $msg = "$!"; + like($err, qr/\Q$msg\E/, "got EAGAIN in child #$i"); + } +}; + +my $test_ro_lock = sub { + my ($func) = @_; + for my $i (1..2) { + my $t0 = now; + my $pid = fork // BAIL_OUT "fork $!"; + if ($pid == 0) { + eval { PublicInbox::MboxLock->acq($f, 0, [ $func ]) }; + _exit($@ ? 1 : 0); + } + waitpid($pid, 0); + is($?, 0, "$func ro lock behaved as expected #$i"); + my $d = now - $t0; + ok($d < 1, "$func timeout respected #$i") or diag "elapsed=$d"; + } +}; + +SKIP: { + grep(/fcntl/, @$defaults) or skip 'File::FcntlLock not available', 1; + my $top = PublicInbox::MboxLock->acq($f, 1, $defaults); + ok($top, 'fcntl lock acquired'); + $test_rw_lock->('fcntl'); + undef $top; + $top = PublicInbox::MboxLock->acq($f, 0, $defaults); + ok($top, 'fcntl read lock acquired'); + $test_ro_lock->('fcntl'); +} +$mbl = PublicInbox::MboxLock->acq($f, 1, ['flock']); +ok($mbl, 'flock acquired'); +$test_rw_lock->('flock'); +undef $mbl; +$mbl = PublicInbox::MboxLock->acq($f, 0, ['flock']); +$test_ro_lock->('flock'); + +done_testing; diff --git a/t/mbox_reader.t b/t/mbox_reader.t index 18d0fd68..14248a2d 100644 --- a/t/mbox_reader.t +++ b/t/mbox_reader.t @@ -24,6 +24,16 @@ my %raw = ( (("b: ".('b' x 72)."\n") x 1000) . "From hell\n", ); +{ + my $eml = PublicInbox::Eml->new($raw{small}); + my $mbox_keywords = PublicInbox::MboxReader->can('mbox_keywords'); + is_deeply($mbox_keywords->($eml), [], 'no keywords'); + $eml->header_set('Status', 'RO'); + is_deeply($mbox_keywords->($eml), ['seen'], 'seen extracted'); + $eml->header_set('X-Status', 'A'); + is_deeply($mbox_keywords->($eml), [qw(answered seen)], + 'seen+answered extracted'); +} if ($ENV{TEST_EXTRA}) { for my $fn (glob('t/*.eml'), glob('t/*/*.{patch,eml}')) { @@ -61,6 +71,12 @@ my $check_fmt = sub { "Content-Length is correct $fmt $cur"); # clobber for ->as_string comparison below $eml->header_set('Content-Length'); + + # special case for t/solve/bare.patch, not sure if we + # should even handle it... + if ($cl[0] eq '0' && ${$eml->{hdr}} eq '') { + delete $eml->{bdy}; + } } else { is(scalar(@cl), 0, "Content-Length unset $fmt $cur"); } @@ -97,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 @@ -111,4 +127,25 @@ exit 1 is(scalar(grep(/Final/, @x)), 0, 'no incomplete bit'); } +{ + my $html = <<EOM; +<html><head><title>hi,</title></head><body>how are you</body></html> +EOM + for my $m (qw(mboxrd mboxcl mboxcl2 mboxo)) { + my (@w, @x); + local $SIG{__WARN__} = sub { push @w, @_ }; + open my $fh, '<', \$html or xbail 'PerlIO::scalar'; + PublicInbox::MboxReader->$m($fh, sub { + push @x, $_[0]->as_string + }); + if ($m =~ /\Amboxcl/) { + is_deeply(\@x, [], "messages in invalid $m"); + } else { + is_deeply(\@x, [ "\n$html" ], "body-only $m"); + } + is_deeply([grep(!/^W: leftover/, @w)], [], + "no extra warnings besides leftover ($m)"); + } +} + done_testing; @@ -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/mdir_reader.t b/t/mdir_reader.t index 51b38af4..c927e1a7 100644 --- a/t/mdir_reader.t +++ b/t/mdir_reader.t @@ -19,4 +19,9 @@ is(maildir_path_flags('/path/to/foo:2,'), '', 'no flags in path'); use_ok 'PublicInbox::InboxWritable', qw(eml_from_path); is(eml_from_path('.'), undef, 'eml_from_path fails on directory'); +is_deeply([PublicInbox::MdirReader::flags2kw('S')], [{ 'seen' => 1 }, []], + "`seen' kw set from flag"); +is_deeply([PublicInbox::MdirReader::flags2kw('Su')], [{ 'seen' => 1 }, ['u']], + 'unknown flag ignored'); + done_testing; 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 413579fb..ec837153 100644 --- a/t/miscsearch.t +++ b/t/miscsearch.t @@ -2,34 +2,26 @@ # Copyright (C) 2020-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 Test::More; use PublicInbox::TestCommon; -use PublicInbox::InboxWritable; -require_mods(qw(Search::Xapian DBD::SQLite)); +require_mods(qw(Xapian DBD::SQLite)); use_ok 'PublicInbox::MiscSearch'; use_ok 'PublicInbox::MiscIdx'; my ($tmp, $for_destroy) = tmpdir(); my $eidx = { xpfx => "$tmp/eidx", -no_fsync => 1 }; # mock ExtSearchIdx -{ - mkdir "$tmp/v1" or BAIL_OUT "mkdir $!"; - open my $fh, '>', "$tmp/v1/description" or BAIL_OUT "open: $!"; +my $v1 = create_inbox 'hope', address => [ 'nope@example.com' ], + indexlevel => 'basic', -no_gc => 1, sub { + my ($im, $ibx) = @_; + open my $fh, '>', "$ibx->{inboxdir}/description" or BAIL_OUT "open: $!"; print $fh "Everything sucks this year\n" or BAIL_OUT "print $!"; close $fh or BAIL_OUT "close $!"; -} -{ - my $v1 = PublicInbox::InboxWritable->new({ - inboxdir => "$tmp/v1", - name => 'hope', - address => [ 'nope@example.com' ], - indexlevel => 'basic', - version => 1, - }); - $v1->init_inbox; - my $mi = PublicInbox::MiscIdx->new($eidx); - $mi->index_ibx($v1); - $mi->commit_txn; -} +}; +my $midx = PublicInbox::MiscIdx->new($eidx); +$midx->index_ibx($v1); +$midx->commit_txn; +undef $v1; my $ms = PublicInbox::MiscSearch->new("$tmp/eidx/misc"); my $mset = $ms->mset('"everything sucks today"'); diff --git a/t/msg_iter.t b/t/msg_iter.t index e46d515c..ae3594da 100644 --- a/t/msg_iter.t +++ b/t/msg_iter.t @@ -1,10 +1,8 @@ # Copyright (C) 2016-2021 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::TestCommon; +use strict; use v5.10.1; use PublicInbox::TestCommon; use PublicInbox::Hval qw(ascii_html); +use MIME::QuotedPrint 3.05 qw(encode_qp); use_ok('PublicInbox::MsgIter'); { @@ -88,5 +86,62 @@ use_ok('PublicInbox::MsgIter'); is($check[1], $nq, 'long quoted section matches'); } +{ + open my $fh, '<', 't/utf8.eml' or BAIL_OUT $!; + my $expect = do { local $/; <$fh> }; + my $qp_patch = encode_qp($expect, "\r\n"); + my $common = <<EOM; +Content-Type: multipart/mixed; boundary="DEADBEEF" +MIME-Version: 1.0 + +--DEADBEEF +Content-Transfer-Encoding: quoted-printable +Content-Type: text/plain; + charset=utf-8 + +blah + +--DEADBEEF +Content-Disposition: attachment; + filename=foo.patch +Content-Type: application/octet-stream; + x-unix-mode=0644; + name="foo.patch" +Content-Transfer-Encoding: quoted-printable +EOM + my $eml = PublicInbox::Eml->new(<<EOM); +$common +$qp_patch +--DEADBEEF-- +EOM + my @parts; + $eml->each_part(sub { + my ($part, $level, @ex) = @{$_[0]}; + my ($s, $err) = msg_part_text($part, $part->content_type); + push @parts, $s; + }); + $expect =~ s/\n/\r\n/sg; + utf8::decode($expect); # aka "bytes2str" + is_deeply(\@parts, [ "blah\r\n", $expect ], + 'fallback to application/octet-stream as UTF-8 text'); + + my $qp_binary = encode_qp("Binary\0crap", "\r\n"); + $eml = PublicInbox::Eml->new(<<EOM); +$common +$qp_binary +--DEADBEEF-- +EOM + @parts = (); + my @err; + $eml->each_part(sub { + my ($part, $level, @ex) = @{$_[0]}; + my ($s, $err) = msg_part_text($part, $part->content_type); + push @parts, $s; + push @err, $err; + }); + is_deeply(\@parts, [ "blah\r\n", undef ], + 'non-text ignored in octet-stream'); + ok($err[1], 'got error for second element'); +} + done_testing(); -1; @@ -7,7 +7,8 @@ use PublicInbox::TestCommon; require_mods('DBD::SQLite'); use_ok 'PublicInbox::Msgmap'; my ($tmpdir, $for_destroy) = tmpdir(); -my $d = PublicInbox::Msgmap->new($tmpdir, 1); +my $f = "$tmpdir/msgmap.sqlite3"; +my $d = PublicInbox::Msgmap->new_file($f, 1); my %mid2num; my %num2mid; @@ -50,7 +51,7 @@ is($d->mid_delete('a@b') + 0, 0, 'delete again returns zero'); is(undef, $d->num_for('a@b'), 'num_for fails on deleted msg'); $d = undef; -ok($d = PublicInbox::Msgmap->new($tmpdir, 1), 'idempotent DB creation'); +ok($d = PublicInbox::Msgmap->new_file($f, 1), 'idempotent DB creation'); my ($min, $max) = $d->minmax; ok($min > 0, "article min OK"); ok($max > 0 && $max < 10, "article max OK"); diff --git a/t/multi-mid.t b/t/multi-mid.t index e9c3dd8c..4a5b8c32 100644 --- a/t/multi-mid.t +++ b/t/multi-mid.t @@ -4,11 +4,10 @@ use strict; use Test::More; use PublicInbox::Eml; use PublicInbox::TestCommon; -use PublicInbox::InboxWritable; require_git(2.6); require_mods(qw(DBD::SQLite)); require PublicInbox::SearchIdx; -my $delay = $ENV{TEST_DELAY_CONVERT}; +my $delay = $ENV{TEST_DELAY_CONVERT} // ''; my $addr = 'test@example.com'; my $bad = PublicInbox::Eml->new(<<EOF); @@ -28,34 +27,25 @@ Subject: good EOF +my $nr = 0; for my $order ([$bad, $good], [$good, $bad]) { - my $before; my ($tmpdir, $for_destroy) = tmpdir(); - my $ibx = PublicInbox::InboxWritable->new({ - inboxdir => "$tmpdir/v1", - name => 'test-v1', - indexlevel => 'basic', - -primary_address => $addr, - }, my $creat_opt = {}); - my @old; - if ('setup v1 inbox') { - my $im = $ibx->importer(0); - for (@$order) { - ok($im->add($_), 'added '.$_->header('Subject')); + my $ibx = create_inbox "test$delay.$nr", indexlevel => 'basic', sub { + my ($im) = @_; + for my $eml (@$order) { + $im->add($eml) or BAIL_OUT; sleep($delay) if $delay; } - $im->done; - my $s = PublicInbox::SearchIdx->new($ibx, 1); - $s->index_sync; - $before = [ $ibx->mm->minmax ]; - @old = ($ibx->over->get_art(1), $ibx->over->get_art(2)); - $ibx->cleanup; - } + }; + ++$nr; + my $before = [ $ibx->mm->minmax ]; + my @old = ($ibx->over->get_art(1), $ibx->over->get_art(2)); + $ibx->cleanup; my $rdr = { 1 => \(my $out = ''), 2 => \(my $err = '') }; my $cmd = [ '-convert', $ibx->{inboxdir}, "$tmpdir/v2" ]; my $env = { PI_DIR => "$tmpdir/.public-inbox" }; ok(run_script($cmd, $env, $rdr), 'convert to v2'); - $err =~ s!\AW: $tmpdir/v1 not configured[^\n]+\n!!s; + $err =~ s!\AW: \Q$ibx->{inboxdir}\E not configured[^\n]+\n!!s; is($err, '', 'no errors or warnings from -convert'); $ibx->{version} = 2; $ibx->{inboxdir} = "$tmpdir/v2"; diff --git a/t/net_reader-imap.t b/t/net_reader-imap.t index adcd6931..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(DBD::SQLite 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; @@ -33,7 +33,9 @@ is(scalar(@w), 0, 'no warnings'); ok($nr, 'got some emails'); is($eml{'PublicInbox::Eml'}, $nr, 'got expected Eml objects'); is(scalar keys %eml, 1, 'only got Eml objects'); -is($urls{$url}, $nr, 'one URL expected number of times'); +is(scalar(grep(/\A\Q$url\E;UIDVALIDITY=\d+\z/, keys %urls)), scalar(keys %urls), + 'UIDVALIDITY added to URL passed to callback'); +is_deeply([values %urls], [$nr], 'one URL expected number of times'); is(scalar keys %urls, 1, 'only got one URL'); is($args{blah}, $nr, 'got arg expected number of times'); is(scalar keys %args, 1, 'only got one arg'); diff --git a/t/netd.t b/t/netd.t new file mode 100644 index 00000000..abdde124 --- /dev/null +++ b/t/netd.t @@ -0,0 +1,85 @@ +#!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 Socket qw(IPPROTO_TCP SOL_SOCKET); +use PublicInbox::TestCommon; +# IO::Poll and Net::NNTP are part of the standard library, but +# distros may split them off... +require_mods(qw(-imapd IO::Socket::SSL Mail::IMAPClient IO::Poll Net::NNTP)); +my $imap_client = 'Mail::IMAPClient'; +$imap_client->can('starttls') or + plan skip_all => 'Mail::IMAPClient does not support TLS'; +Net::NNTP->can('starttls') or + plan skip_all => 'Net::NNTP does not support TLS'; +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/"; +} +use_ok 'PublicInbox::TLS'; +use_ok 'IO::Socket::SSL'; +require_git('2.6'); + +my ($tmpdir, $for_destroy) = tmpdir(); +my $err = "$tmpdir/stderr.log"; +my $out = "$tmpdir/stdout.log"; +my $pi_config; +my $group = 'test-netd'; +my $addr = $group . '@example.com'; + +# ensure we have free, low-numbered contiguous FDs from 3.. FD inheritance +my @pad_pipes; +for (1..3) { + pipe(my ($r, $w)) or xbail "pipe: $!"; + push @pad_pipes, $r, $w; +}; +my %srv = map { $_ => tcp_server() } qw(imap nntp imaps nntps); +my $ibx = create_inbox 'netd', version => 2, + -primary_address => $addr, indexlevel => 'basic', sub { + my ($im, $ibx) = @_; + $im->add(eml_load('t/data/0001.patch')) or BAIL_OUT '->add'; + $pi_config = "$ibx->{inboxdir}/pi_config"; + open my $fh, '>', $pi_config or BAIL_OUT "open: $!"; + print $fh <<EOF or BAIL_OUT "print: $!"; +[publicinbox "netd"] + inboxdir = $ibx->{inboxdir} + address = $addr + indexlevel = basic + newsgroup = $group +EOF + close $fh or BAIL_OUT "close: $!\n"; +}; +$pi_config //= "$ibx->{inboxdir}/pi_config"; +my @args = ("--cert=$cert", "--key=$key"); +my $rdr = {}; +my $fd = 3; +while (my ($k, $v) = each %srv) { + push @args, "-l$k://".tcp_host_port($v); + $rdr->{$fd++} = $v; +} +my $cmd = [ '-netd', '-W0', @args, "--stdout=$out", "--stderr=$err" ]; +my $env = { PI_CONFIG => $pi_config }; +my $td = start_script($cmd, $env, $rdr); +@pad_pipes = (); +undef $rdr; +my %o = ( + SSL_hostname => 'server.local', + SSL_verifycn_name => 'server.local', + SSL_verify_mode => SSL_VERIFY_PEER(), + SSL_ca_file => 'certs/test-ca.pem', +); +{ + my $c = tcp_connect($srv{imap}); + my $msg = <$c>; + like($msg, qr/IMAP4rev1/, 'connected to IMAP'); +} +{ + my $c = tcp_connect($srv{nntp}); + my $msg = <$c>; + like($msg, qr/^201 .*? ready - post via email/, 'connected to NNTP'); +} + +# TODO: more tests +done_testing; @@ -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'); @@ -126,7 +126,6 @@ use PublicInbox::Config; is_deeply([ $mime->header('Xref') ], [ 'example.com test:1' ], 'Xref: set'); - $ibx->{-base_url} = 'http://mirror.example.com/m/'; $smsg->{num} = 2; PublicInbox::NNTP::set_nntp_headers($hdr, $smsg); is_deeply([ $mime->header('Message-ID') ], [ "<$mid>" ], diff --git a/t/nntpd-tls.t b/t/nntpd-tls.t index 8dab4ca8..a16cc015 100644 --- a/t/nntpd-tls.t +++ b/t/nntpd-tls.t @@ -1,10 +1,9 @@ -# Copyright (C) 2019-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 Socket qw(SOCK_STREAM IPPROTO_TCP SOL_SOCKET); +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 # distros may split them off... require_mods(qw(DBD::SQLite IO::Socket::SSL Net::NNTP IO::Poll)); @@ -20,9 +19,6 @@ unless (-r $key && -r $cert) { use_ok 'PublicInbox::TLS'; use_ok 'IO::Socket::SSL'; -require PublicInbox::InboxWritable; -require PublicInbox::Eml; -require PublicInbox::SearchIdx; our $need_zlib; eval { require Compress::Raw::Zlib } or $need_zlib = 'Compress::Raw::Zlib missing'; @@ -31,45 +27,28 @@ require_git('2.6') if $version >= 2; my ($tmpdir, $for_destroy) = tmpdir(); my $err = "$tmpdir/stderr.log"; my $out = "$tmpdir/stdout.log"; -my $inboxdir = "$tmpdir"; -my $pi_config = "$tmpdir/pi_config"; my $group = 'test-nntpd-tls'; my $addr = $group . '@example.com'; my $starttls = tcp_server(); my $nntps = tcp_server(); -my $ibx = PublicInbox::Inbox->new({ - inboxdir => $inboxdir, - name => 'nntpd-tls', - version => $version, - -primary_address => $addr, - indexlevel => 'basic', -}); -$ibx = PublicInbox::InboxWritable->new($ibx, {nproc=>1}); -$ibx->init_inbox(0); -{ - open my $fh, '>', $pi_config or die "open: $!\n"; - print $fh <<EOF +my $pi_config; +my $ibx = create_inbox "v$version", version => $version, indexlevel => 'basic', + sub { + my ($im, $ibx) = @_; + $pi_config = "$ibx->{inboxdir}/pi_config"; + open my $fh, '>', $pi_config or BAIL_OUT "open: $!"; + print $fh <<EOF or BAIL_OUT; [publicinbox "nntpd-tls"] - inboxdir = $inboxdir + inboxdir = $ibx->{inboxdir} address = $addr indexlevel = basic newsgroup = $group EOF - ; - close $fh or die "close: $!\n"; -} - -{ - my $im = $ibx->importer(0); - my $mime = eml_load 't/data/0001.patch'; - ok($im->add($mime), 'message added'); - $im->done; - if ($version == 1) { - my $s = PublicInbox::SearchIdx->new($ibx, 1); - $s->index_sync; - } -} - + close $fh or BAIL_OUT "close: $!"; + $im->add(eml_load 't/data/0001.patch') or BAIL_OUT; +}; +$pi_config //= "$ibx->{inboxdir}/pi_config"; +undef $ibx; my $nntps_addr = tcp_host_port($nntps); my $starttls_addr = tcp_host_port($starttls); my $env = { PI_CONFIG => $pi_config }; @@ -166,6 +145,27 @@ for my $args ( is(sysread($slow, my $eof, 4096), 0, 'got EOF'); $slow = undef; + test_lei(sub { + lei_ok qw(ls-mail-source), "nntp://$starttls_addr", + \'STARTTLS not used by default'; + 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: { skip 'TCP_DEFER_ACCEPT is Linux-only', 2 if $^O ne 'linux'; my $var = eval { Socket::TCP_DEFER_ACCEPT() } // 9; @@ -175,18 +175,24 @@ 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 $var = PublicInbox::Daemon::SO_ACCEPTFILTER(); - my $x = getsockopt($nntps, SOL_SOCKET, $var); + my $x = getsockopt($nntps, SOL_SOCKET, + $PublicInbox::Daemon::SO_ACCEPTFILTER); like($x, qr/\Adataready\0+\z/, 'got dataready accf for NNTPS'); - $x = getsockopt($starttls, IPPROTO_TCP, $var); + $x = getsockopt($starttls, IPPROTO_TCP, + $PublicInbox::Daemon::SO_ACCEPTFILTER); 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; @@ -197,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(); @@ -1,74 +1,34 @@ -# 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 PublicInbox::TestCommon; -use PublicInbox::Spawn qw(which); -require_mods(qw(DBD::SQLite)); -require PublicInbox::InboxWritable; +use strict; use v5.10.1; use PublicInbox::TestCommon; +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 = which('lsof'); -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(); my $home = "$tmpdir/pi-home"; my $err = "$tmpdir/stderr.log"; my $out = "$tmpdir/stdout.log"; -my $inboxdir = "$tmpdir/main"; -my $otherdir = "$tmpdir/other"; +my $inboxdir = "$tmpdir/inbox"; my $group = 'test-nntpd'; my $addr = $group . '@example.com'; - -my %opts; my $sock = tcp_server(); my $host_port = tcp_host_port($sock); my $td; -my $len; - -my $ibx = { - inboxdir => $inboxdir, - name => $group, - version => $version, - -primary_address => $addr, - indexlevel => 'basic', -}; -$ibx = PublicInbox::Inbox->new($ibx); -{ - local $ENV{HOME} = $home; - my @cmd = ('-init', $group, $inboxdir, 'http://example.com/abc', $addr, - "-V$version", '-Lbasic', '--newsgroup', $group); - ok(run_script(\@cmd), "init $group"); - - @cmd = ('-init', 'xyz', $otherdir, 'http://example.com/xyz', - 'e@example.com', "-V$version", qw(-Lbasic --newsgroup x.y.z)); - ok(run_script(\@cmd), 'init xyz'); - is(xsys([qw(git config -f), "$home/.public-inbox/config", - qw(publicinboxmda.spamcheck none)]), 0, 'disable spamcheck'); - - open(my $fh, '<', 't/utf8.eml') or BAIL_OUT("open t/utf8.eml: $!"); - my $env = { ORIGINAL_RECIPIENT => 'e@example.com' }; - run_script([qw(-mda --no-precheck)], $env, { 0 => $fh }) or - BAIL_OUT('-mda delivery'); - my $len; - $ibx = PublicInbox::InboxWritable->new($ibx); - my $im = $ibx->importer(0); - - # ensure successful message delivery - { - my $mime = PublicInbox::Eml->new(<<EOF); +my $eml = PublicInbox::Eml->new(<<EOF); To: =?utf-8?Q?El=C3=A9anor?= <you\@example.com> From: =?utf-8?Q?El=C3=A9anor?= <me\@example.com> Cc: $addr @@ -81,21 +41,49 @@ References: <ref tab squeezed> This is a test message for El\xc3\xa9anor EOF - my $list_id = $addr; - $list_id =~ s/@/./; - $mime->header_set('List-Id', "<$list_id>"); - my $str = $mime->as_string; - $str =~ s/(?<!\r)\n/\r\n/sg; - $len = length($str); - undef $str; - $im->add($mime); - $im->done; - if ($version == 1) { - ok(run_script(['-index', $ibx->{inboxdir}]), - 'indexed v1'); - } - } +my $list_id = $addr; +$list_id =~ s/@/./; +$eml->header_set('List-Id', "<$list_id>"); +my $str = $eml->as_string; +$str =~ s/(?<!\r)\n/\r\n/sg; +my $len = length($str); +undef $str; + +my $ibx = create_inbox "v$version", version => $version, indexlevel => 'basic', + tmpdir => $inboxdir, sub { + my ($im, $ibx) = @_; + $im->add($eml) or BAIL_OUT; +}; +undef $eml; +my $other = create_inbox "other$version", version => $version, + indexlevel => 'basic', sub { + my ($im) = @_; + $im->add(eml_load 't/utf8.eml') or BAIL_OUT; +}; +local $ENV{HOME} = $home; +mkdir $home or BAIL_OUT $!; +mkdir "$home/.public-inbox" or BAIL_OUT $!; +open my $cfgfh, '>', "$home/.public-inbox/config" or BAIL_OUT $!; +print $cfgfh <<EOF or BAIL_OUT; +[publicinbox "$group"] + inboxdir = $inboxdir + url = http://example.com/abc + address = $addr + indexlevel = basic + newsgroup = $group +[publicinbox "xyz"] + inboxdir = $other->{inboxdir} + url = http://example.com/xyz + address = e\@example.com + indexlevel = basic + newsgroup = x.y.z +[publicinboxMda] + spamcheck = none +EOF +close $cfgfh or BAIL_OUT; + +{ my $cmd = [ '-nntpd', '-W0', "--stdout=$out", "--stderr=$err" ]; $td = start_script($cmd, undef, { 3 => $sock }); my $n = Net::NNTP->new($host_port); @@ -105,6 +93,13 @@ EOF 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: @@ -132,8 +127,8 @@ EOF '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'); @@ -258,12 +253,9 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000 my $long_hdr = 'for-leafnode-'.('y'x200).'@example.com'; $for_leafnode->header_set('Message-ID', "<$long_hdr>"); + my $im = $ibx->importer(0); $im->add($for_leafnode); $im->done; - if ($version == 1) { - ok(run_script(['-index', $ibx->{inboxdir}]), - 'indexed v1'); - } my $hdr = $n->head("<$long_hdr>"); my $expect = qr/\AMessage-ID: /i . qr/\Q<$long_hdr>\E/; ok(scalar(grep(/$expect/, @$hdr)), 'Message-ID not folded'); @@ -312,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); @@ -335,25 +327,26 @@ 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'); my $ex = eml_load('t/data/0001.patch'); is($n->article($ex->header('Message-ID')), undef, 'article did not exist'); + my $im = $ibx->importer(0); $im->add($ex); $im->done; { @@ -365,22 +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 @of = xqx([$lsof, '-p', $td->{pid}], undef, $noerr); - is(scalar(grep(/\(deleted\)/, @of)), 0, 'no deleted files'); + 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 { @@ -419,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 $!; @@ -442,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"; @@ -451,7 +446,7 @@ sub test_watch { my $w = start_script(['-watch'], undef, { 2 => $err_wr }); diag 'waiting for initial fetch...'; - PublicInbox::DS->EventLoop; + PublicInbox::DS::event_loop(); diag 'inbox unlocked on initial fetch'; $w->kill; $w->join; diff --git a/t/nodatacow.t b/t/nodatacow.t index 72860d43..0940d908 100644 --- a/t/nodatacow.t +++ b/t/nodatacow.t @@ -1,50 +1,42 @@ #!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 Test::More; +use strict; use v5.10.1; use PublicInbox::TestCommon; use File::Temp 0.19; -use PublicInbox::TestCommon; -use PublicInbox::Spawn qw(which); -use_ok 'PublicInbox::NDC_PP'; +use_ok 'PublicInbox::Syscall'; + +# btrfs on Linux is copy-on-write (COW) by default. As of Linux 5.7, +# this still leads to fragmentation for SQLite and Xapian files where +# random I/O happens, so we disable COW just for SQLite files and Xapian +# directories. Disabling COW disables checksumming, so we only do this +# for regeneratable files, and not canonical git storage (git doesn't +# checksum refs, only data under $GIT_DIR/objects). SKIP: { my $nr = 2; skip 'test is Linux-only', $nr if $^O ne 'linux'; my $dir = $ENV{BTRFS_TESTDIR}; skip 'BTRFS_TESTDIR not defined', $nr unless defined $dir; - skip 'chattr(1) not installed', $nr unless which('chattr'); - my $lsattr = which('lsattr') or skip 'lsattr(1) not installed', $nr; - my $tmp = File::Temp->newdir('nodatacow-XXXXX', DIR => $dir); + + my $lsattr = require_cmd('lsattr', 1) or + skip 'lsattr(1) not installed', $nr; + + my $tmp = File::Temp->newdir('nodatacow-XXXX', DIR => $dir); my $dn = $tmp->dirname; my $name = "$dn/pp.f"; open my $fh, '>', $name or BAIL_OUT "open($name): $!"; - my $pp_sub = \&PublicInbox::NDC_PP::nodatacow_fd; - $pp_sub->(fileno($fh)); + PublicInbox::Syscall::nodatacow_fh($fh); my $res = xqx([$lsattr, $name]); + + BAIL_OUT "lsattr(1) fails in $dir" if $?; like($res, qr/C.*\Q$name\E/, "`C' attribute set on fd with pure Perl"); $name = "$dn/pp.d"; mkdir($name) or BAIL_OUT "mkdir($name) $!"; - PublicInbox::NDC_PP::nodatacow_dir($name); + PublicInbox::Syscall::nodatacow_dir($name); $res = xqx([$lsattr, '-d', $name]); like($res, qr/C.*\Q$name\E/, "`C' attribute set on dir with pure Perl"); - - $name = "$dn/ic.f"; - my $ic_sub = \&PublicInbox::Spawn::nodatacow_fd; - $pp_sub == $ic_sub and - skip 'Inline::C or Linux kernel headers missing', 2; - open $fh, '>', $name or BAIL_OUT "open($name): $!"; - $ic_sub->(fileno($fh)); - $res = xqx([$lsattr, $name]); - like($res, qr/C.*\Q$name\E/, "`C' attribute set on fd with Inline::C"); - - $name = "$dn/ic.d"; - mkdir($name) or BAIL_OUT "mkdir($name) $!"; - PublicInbox::Spawn::nodatacow_dir($name); - $res = xqx([$lsattr, '-d', $name]); - like($res, qr/C.*\Q$name\E/, "`C' attribute set on dir with Inline::C"); }; done_testing; 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); } } @@ -90,8 +90,9 @@ $over->eidx_prep; 'example.kee:2018:deadbeefcafe' ], 'xref3 works forw two'); - @arg = qw(1349 adeadba7cafe example.key); - is($over->remove_xref3(@arg), 1, 'remove first'); + is($over->dbh->do(<<''), 1, 'remove first'); +DELETE FROM xref3 WHERE xnum = 2019 AND docid = 1349 + $xref3 = $over->get_xref3(1349); is_deeply($xref3, [ 'example.kee:2018:deadbeefcafe' ], 'confirm removal successful'); @@ -1,67 +1,48 @@ -# 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::TestCommon; my $psgi = "./examples/public-inbox.psgi"; -my ($tmpdir, $for_destroy) = tmpdir(); -my $pi_config = "$tmpdir/config"; -my $inboxdir = "$tmpdir/main.git"; -my $addr = 'test-public@example.com'; my @mods = qw(HTTP::Request::Common Plack::Test URI::Escape); require_mods(@mods); -use_ok 'PublicInbox::Import'; -use_ok 'PublicInbox::Git'; -my @ls; - foreach my $mod (@mods) { use_ok $mod; } -local $ENV{PI_CONFIG} = $pi_config; ok(-f $psgi, "psgi example file found"); +my ($tmpdir, $for_destroy) = tmpdir(); my $pfx = 'http://example.com/test'; -ok(run_script(['-init', 'test', $inboxdir, "$pfx/", $addr]), - 'initialized repo'); -xsys_e(qw(git config -f), $pi_config, - qw(publicinbox.test.newsgroup inbox.test)); -open my $fh, '>', "$inboxdir/description" or die "open: $!\n"; -print $fh "test for public-inbox\n"; -close $fh or die "close: $!\n"; -my $app = require $psgi; -my $git = PublicInbox::Git->new($inboxdir); -my $im = PublicInbox::Import->new($git, 'test', $addr); -# ensure successful message delivery -{ - my $mime = PublicInbox::Eml->new(<<EOF); +my $eml = eml_load('t/iso-2202-jp.eml'); +# ensure successful message deliveries +my $ibx = create_inbox('u8-2', sub { + my ($im, $ibx) = @_; + my $addr = $ibx->{-primary_address}; + $im->add($eml) or xbail '->add'; + $eml->header_set('Content-Type', + "text/plain; charset=\rso\rb\0gus\rithurts"); + $eml->header_set('Message-ID', '<broken@example.com>'); + $im->add($eml) or xbail '->add'; + $im->add(PublicInbox::Eml->new(<<EOF)) or xbail '->add'; From: Me <me\@example.com> To: You <you\@example.com> Cc: $addr Message-Id: <blah\@example.com> Subject: hihi Date: Fri, 02 Oct 1993 00:00:00 +0000 +Content-Type: text/plain; charset=iso-8859-1 > quoted text zzzzzz EOF - $im->add($mime); - $im->done; - my $rev = $git->qx(qw(rev-list HEAD)); - like($rev, qr/\A[a-f0-9]{40,}/, "good revision committed"); - @ls = $git->qx(qw(ls-tree -r --name-only HEAD)); - chomp @ls; - # multipart with two text bodies - $mime = eml_load 't/plack-2-txt-bodies.eml'; - $im->add($mime); + $im->add(eml_load('t/plack-2-txt-bodies.eml')) or BAIL_OUT '->add'; # multipart with attached patch + filename - $mime = eml_load 't/plack-attached-patch.eml'; - $im->add($mime); + $im->add(eml_load('t/plack-attached-patch.eml')) or BAIL_OUT '->add'; - # multipart collapsed to single quoted-printable text/plain - $mime = eml_load 't/plack-qp.eml'; - like($mime->body_raw, qr/hi =3D bye=/, 'our test used QP correctly'); - $im->add($mime); + $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; From: Me <me\@example.com> @@ -77,91 +58,90 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000 :( EOF $crlf =~ s/\n/\r\n/sg; - $im->add(PublicInbox::Eml->new($crlf)); + $im->add(PublicInbox::Eml->new($crlf)) or BAIL_OUT '->add'; - $im->done; -} + open my $fh, '>', "$ibx->{inboxdir}/description" or BAIL_OUT "open: $!"; + print $fh "test for public-inbox\n" or BAIL_OUT; + close $fh or BAIL_OUT "close: $!"; + open $fh, '>', "$ibx->{inboxdir}/pi_config"; + print $fh <<EOF or BAIL_OUT; +[publicinbox "test"] + inboxdir = $ibx->{inboxdir} + newsgroup = inbox.test + address = $addr + url = $pfx/ +EOF + close $fh or BAIL_OUT "close: $!"; +}); -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("$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, @@ -171,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)); @@ -202,80 +182,83 @@ 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', + 'charset from message used'); - $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'); -}); + $res = $cb->(GET($pfx . '/broken@example.com/raw')); + is($res->header('Content-Type'), 'text/plain; charset=UTF-8', + 'broken charset ignored'); + + $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($body = $res->content); + my $raw = PublicInbox::Eml->new(\$body); + is($raw->body_raw, $eml->body_raw, 'ISO-2022-JP body unmodified'); -# legacy redirects -foreach my $t (qw(m f)) { - test_psgi($app, sub { - my ($cb) = @_; - my $res = $cb->(GET($pfx . "/$t/blah\@example.com.txt")); + 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 + 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 (@ls) { - $path =~ tr!/!!d; - 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; @@ -288,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; diff --git a/t/pop3d.t b/t/pop3d.t new file mode 100644 index 00000000..ee19f2d7 --- /dev/null +++ b/t/pop3d.t @@ -0,0 +1,346 @@ +#!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 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 :fcntl_lock)); +require_git(v2.6); # for v2 +use_ok 'IO::Socket::SSL'; +use_ok 'PublicInbox::TLS'; +my ($tmpdir, $for_destroy) = tmpdir(); +mkdir("$tmpdir/p3state") or xbail "mkdir: $!"; +my $err = "$tmpdir/stderr.log"; +my $out = "$tmpdir/stdout.log"; +my $olderr = "$tmpdir/plain.err"; +my $group = 'test-pop3'; +my $addr = $group . '@example.com'; +my $stls = tcp_server(); +my $plain = tcp_server(); +my $pop3s = tcp_server(); +my $patch = eml_load('t/data/0001.patch'); +my $ibx = create_inbox 'pop3d', version => 2, -primary_address => $addr, + indexlevel => 'basic', sub { + my ($im, $ibx) = @_; + $im->add(eml_load('t/plack-qp.eml')) or BAIL_OUT '->add'; + $im->add($patch) or BAIL_OUT '->add'; +}; +my $pi_config = "$tmpdir/pi_config"; +open my $fh, '>', $pi_config or BAIL_OUT "open: $!"; +print $fh <<EOF or BAIL_OUT "print: $!"; +[publicinbox] + pop3state = $tmpdir/p3state +[publicinbox "pop3"] + inboxdir = $ibx->{inboxdir} + address = $addr + indexlevel = basic + newsgroup = $group +EOF +close $fh or BAIL_OUT "close: $!\n"; + +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 $old = start_script(['-pop3d', '-W0', + "--stdout=$tmpdir/plain.out", "--stderr=$olderr" ], + $env, { 3 => $plain }); +my @old_args = ($plain->sockhost, Port => $plain->sockport); +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'); + like($x->message, qr/unable to lock/, 'diagnostic message'); + + $x = Net::POP3->new(@old_args); + ok($x->apop($locked_mb, 'anonymous'), 'APOP lock acquire'); + + my $y = Net::POP3->new(@old_args); + ok(!$y->apop($locked_mb, 'anonymous'), 'APOP lock fails once'); + + undef $x; + $y = Net::POP3->new(@old_args); + ok($y->apop($locked_mb, 'anonymous'), 'APOP lock works after release'); +} + +for my $args ( + [ "--cert=$cert", "--key=$key", + "-lpop3s://$pop3s_addr", + "-lpop3://$stls_addr" ], +) { + for ($out, $err) { open my $fh, '>', $_ or BAIL_OUT "truncate: $!" } + my $cmd = [ '-netd', '-W0', @$args, "--stdout=$out", "--stderr=$err" ]; + my $td = start_script($cmd, $env, { 3 => $stls, 4 => $pop3s }); + + my %o = ( + SSL_hostname => 'server.local', + SSL_verifycn_name => 'server.local', + SSL_verify_mode => SSL_VERIFY_PEER(), + SSL_ca_file => 'certs/test-ca.pem', + ); + # start negotiating a slow TLS connection + my $slow = tcp_connect($pop3s, Blocking => 0); + $slow = IO::Socket::SSL->start_SSL($slow, SSL_startHandshake => 0, %o); + my $slow_done = $slow->connect_SSL; + my @poll; + if ($slow_done) { + diag('W: connect_SSL early OK, slow client test invalid'); + use PublicInbox::Syscall qw(EPOLLIN EPOLLOUT); + @poll = (fileno($slow), EPOLLIN | EPOLLOUT); + } else { + @poll = (fileno($slow), PublicInbox::TLS::epollbit()); + } + + my @p3s_args = ($pop3s->sockhost, + Port => $pop3s->sockport, SSL => 1, %o); + my $p3s = Net::POP3->new(@p3s_args); + my $capa = $p3s->capa; + ok(!exists $capa->{STLS}, 'no STLS CAPA for POP3S'); + ok($p3s->quit, 'QUIT works w/POP3S'); + { + $p3s = Net::POP3->new(@p3s_args); + ok(!$p3s->apop("$locked_mb.0", 'anonymous'), + 'APOP lock failure w/ another daemon'); + like($p3s->message, qr/unable to lock/, 'diagnostic message'); + } + + # slow TLS connection did not block the other fast clients while + # connecting, finish it off: + until ($slow_done) { + IO::Poll::_poll(-1, @poll); + $slow_done = $slow->connect_SSL and last; + @poll = (fileno($slow), PublicInbox::TLS::epollbit()); + } + $slow->blocking(1); + ok(sysread($slow, my $greet, 4096) > 0, 'slow got a greeting'); + my @np3_args = ($stls->sockhost, Port => $stls->sockport); + my $np3 = Net::POP3->new(@np3_args); + ok($np3->quit, 'plain QUIT works'); + $np3 = Net::POP3->new(@np3_args, %o); + $capa = $np3->capa; + ok(exists $capa->{STLS}, 'STLS CAPA advertised before STLS'); + ok($np3->starttls, 'STLS works'); + $capa = $np3->capa; + ok(!exists $capa->{STLS}, 'STLS CAPA not advertised after STLS'); + ok($np3->quit, 'QUIT works after STLS'); + + for my $mailbox (('x'x32)."\@$group", $group, ('a'x32)."\@z.$group") { + $np3 = Net::POP3->new(@np3_args); + ok(!$np3->user($mailbox), "USER $mailbox reject"); + ok($np3->quit, 'QUIT after USER fail'); + + $np3 = Net::POP3->new(@np3_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"); + ok($np3->pass('anonymous'), 'pass works'); + + my $list = $np3->list; + my $uidl = $np3->uidl; + is_deeply([sort keys %$list], [sort keys %$uidl], + 'LIST and UIDL keys match'); + 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"); + my @res = $np3->popstat; + is($res[0], 2, 'STAT knows about 2 messages'); + + my $msg = $np3->get(2); + $msg = join('', @$msg); + $msg =~ s/\r\n/\n/g; + is_deeply(PublicInbox::Eml->new($msg), $patch, + 't/data/0001.patch round-tripped'); + + ok(!$np3->get(22), 'missing message'); + + $msg = $np3->top(2, 0); + $msg = join('', @$msg); + $msg =~ s/\r\n/\n/g; + is($msg, $patch->header_obj->as_string . "\n", + 'TOP numlines=0'); + + ok(!$np3->top(2, -1), 'negative TOP numlines'); + + $msg = $np3->top(2, 1); + $msg = join('', @$msg); + $msg =~ s/\r\n/\n/g; + is($msg, $patch->header_obj->as_string . <<EOF, + +Filenames within a project tend to be reasonably stable within a +EOF + 'TOP numlines=1'); + + $msg = $np3->top(2, 10000); + $msg = join('', @$msg); + $msg =~ s/\r\n/\n/g; + is_deeply(PublicInbox::Eml->new($msg), $patch, + 'TOP numlines=10000 (excess)'); + + $np3 = Net::POP3->new(@np3_args, %o); + ok($np3->starttls, 'STLS works before APOP'); + ok($np3->apop($u, 'anonymous'), "APOP UUID\@$mailbox w/ STLS"); + + # undocumented: + ok($np3->_NOOP, 'NOOP works') if $np3->can('_NOOP'); + } + + SKIP: { + skip 'TCP_DEFER_ACCEPT is Linux-only', 2 if $^O ne 'linux'; + my $var = eval { Socket::TCP_DEFER_ACCEPT() } // 9; + my $x = getsockopt($pop3s, IPPROTO_TCP, $var) // + xbail "IPPROTO_TCP: $!"; + ok(unpack('i', $x) > 0, 'TCP_DEFER_ACCEPT set on POP3S'); + $x = getsockopt($stls, IPPROTO_TCP, $var) // + xbail "IPPROTO_TCP: $!"; + is(unpack('i', $x), 0, 'TCP_DEFER_ACCEPT is 0 on plain POP3'); + }; + SKIP: { + 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 POP3'); + }; + + $td->kill; + $td->join; + is($?, 0, 'no error in exited -netd'); + open my $fh, '<', $err or BAIL_OUT "open $err failed: $!"; + my $eout = do { local $/; <$fh> }; + unlike($eout, qr/wide/i, 'no Wide character warnings in -netd'); +} + +{ + my $capa = $oldc->capa; + ok(defined($capa->{PIPELINING}), 'pipelining supported by CAPA'); + is($capa->{EXPIRE}, 0, 'EXPIRE 0 set'); + ok(!exists $capa->{STLS}, 'STLS unset w/o daemon certs'); + + # ensure TOP doesn't trigger "EXPIRE 0" like RETR does (cf. RFC2449) + my $list = $oldc->list; + ok(scalar keys %$list, 'got a listing of messages'); + ok($oldc->top($_, 1), "TOP $_ 1") for keys %$list; + ok($oldc->quit, 'QUIT after TOP'); + + # clients which see "EXPIRE 0" can elide DELE requests + $oldc = Net::POP3->new(@old_args); + ok($oldc->apop("$locked_mb.0", 'anonymous'), 'APOP for RETR'); + is_deeply($oldc->capa, $capa, 'CAPA unchanged'); + is_deeply($oldc->list, $list, 'LIST unchanged by previous TOP'); + ok($oldc->get($_), "RETR $_") for keys %$list; + ok($oldc->quit, 'QUIT after RETR'); + + $oldc = Net::POP3->new(@old_args); + ok($oldc->apop("$locked_mb.0", 'anonymous'), 'APOP reconnect'); + my $cont = $oldc->list; + is_deeply($cont, {}, 'no messages after implicit DELE from EXPIRE 0'); + ok($oldc->quit, 'QUIT on noop'); + + # test w/o checking CAPA to trigger EXPIRE 0 + $oldc = Net::POP3->new(@old_args); + ok($oldc->apop($locked_mb, 'anonymous'), 'APOP on latest slice'); + my $l2 = $oldc->list; + is_deeply($l2, $list, 'different mailbox, different deletes'); + ok($oldc->get($_), "RETR $_") for keys %$list; + ok($oldc->quit, 'QUIT w/o EXPIRE nor DELE'); + + $oldc = Net::POP3->new(@old_args); + ok($oldc->apop($locked_mb, 'anonymous'), 'APOP again on latest'); + $l2 = $oldc->list; + is_deeply($l2, $list, 'no DELE nor EXPIRE preserves messages'); + ok($oldc->delete(2), 'explicit DELE on latest'); + ok($oldc->quit, 'QUIT w/ highest DELE'); + + # this is non-standard behavior, but necessary if we expect hundreds + # of thousands of users on cheap HW + $oldc = Net::POP3->new(@old_args); + ok($oldc->apop($locked_mb, 'anonymous'), 'APOP yet again on latest'); + is_deeply($oldc->list, {}, 'highest DELE deletes older messages, too'); +} + +# TODO: more tests, but mpop was really helpful in helping me +# figure out bugs with larger newsgroups (>50K messages) which +# probably isn't suited for this test suite. + +$old->kill; +$old->join; +is($?, 0, 'no error in exited -pop3d'); +open $fh, '<', $olderr or BAIL_OUT "open $olderr failed: $!"; +my $eout = do { local $/; <$fh> }; +unlike($eout, qr/wide/i, 'no Wide character warnings in -pop3d'); + +done_testing; 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 f53b7510..db551696 100644 --- a/t/psgi_attach.t +++ b/t/psgi_attach.t @@ -1,44 +1,37 @@ -# 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 Test::More; +use v5.10.1; use PublicInbox::TestCommon; -my ($tmpdir, $for_destroy) = tmpdir(); -my $inboxdir = "$tmpdir/main.git"; -my $addr = 'test-public@example.com'; my @mods = qw(HTTP::Request::Common Plack::Builder Plack::Test URI::Escape); require_mods(@mods); use_ok $_ foreach @mods; use_ok 'PublicInbox::WWW'; -use PublicInbox::Import; -use PublicInbox::Git; use PublicInbox::Config; use PublicInbox::Eml; use_ok 'PublicInbox::WwwAttach'; - -my $cfgpath = "$tmpdir/config"; -open my $fh, '>', $cfgpath or BAIL_OUT $!; -print $fh <<EOF or BAIL_OUT $!; +my $cfgpath; +my $creat_cb = sub { + my ($im, $ibx) = @_; + $im->add(eml_load('t/psgi_attach.eml')) or BAIL_OUT; + $im->add(eml_load('t/data/message_embed.eml')) or BAIL_OUT; + $cfgpath = "$ibx->{inboxdir}/pi_config"; + open my $fh, '>', $cfgpath or BAIL_OUT $!; + print $fh <<EOF or BAIL_OUT $!; [publicinbox "test"] - address = $addr - inboxdir = $inboxdir + address = $ibx->{-primary_address} + inboxdir = $ibx->{inboxdir} EOF -close $fh or BAIL_OUT $!; -my $config = PublicInbox::Config->new($cfgpath); -my $git = PublicInbox::Git->new($inboxdir); -my $im = PublicInbox::Import->new($git, 'test', $addr); -$im->init_bare; - + close $fh or BAIL_OUT $!; +}; +my $ibx = create_inbox 'test', $creat_cb; +$cfgpath //= "$ibx->{inboxdir}/pi_config"; my $qp = "abcdef=g\n==blah\n"; my $b64 = "b64\xde\xad\xbe\xef\n"; my $txt = "plain\ntext\npass\nthrough\n"; my $dot = "dotfile\n"; -$im->add(eml_load('t/psgi_attach.eml')); -$im->add(eml_load('t/data/message_embed.eml')); -$im->done; - -my $www = PublicInbox::WWW->new($config); +my $www = PublicInbox::WWW->new(PublicInbox::Config->new($cfgpath)); my $client = sub { my ($cb) = @_; my $res; @@ -104,20 +97,12 @@ my $client = sub { test_psgi(sub { $www->call(@_) }, $client); SKIP: { - diag 'testing with index indexed'; - require_mods('DBD::SQLite', 19); + 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 }; - ok(run_script(['-index', $inboxdir], $env), 'indexed'); - + $www = PublicInbox::WWW->new(PublicInbox::Config->new($cfgpath)); test_psgi(sub { $www->call(@_) }, $client); - - require_mods(qw(Plack::Test::ExternalServer), 18); - my $sock = tcp_server() or die; - my ($out, $err) = map { "$inboxdir/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(); +done_testing; diff --git a/t/psgi_bad_mids.t b/t/psgi_bad_mids.t index f23680f8..ac0eb3c3 100644 --- a/t/psgi_bad_mids.t +++ b/t/psgi_bad_mids.t @@ -1,31 +1,15 @@ -# Copyright (C) 2018-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 PublicInbox::Eml; -use PublicInbox::Config; +use v5.12; use PublicInbox::TestCommon; +use PublicInbox::Eml; my @mods = qw(DBD::SQLite HTTP::Request::Common Plack::Test - URI::Escape Plack::Builder PublicInbox::WWW); + URI::Escape Plack::Builder); require_git 2.6; require_mods(@mods); use_ok($_) for @mods; use_ok 'PublicInbox::WWW'; -use_ok 'PublicInbox::V2Writable'; -my ($inboxdir, $for_destroy) = tmpdir(); -my $cfgpfx = "publicinbox.bad-mids"; -my $ibx = { - inboxdir => $inboxdir, - name => 'bad-mids', - version => 2, - -primary_address => 'test@example.com', - indexlevel => 'basic', -}; -$ibx = PublicInbox::Inbox->new($ibx); -my $im = PublicInbox::V2Writable->new($ibx, 1); -$im->{parallel} = 0; - my $msgs = <<''; F1V5OR6NMF.3M649JTLO9IXD@tux.localdomain/hehe1"'<foo F1V5NB0PTU.3U0DCVGAJ750Z@tux.localdomain"'<>/foo @@ -36,27 +20,27 @@ F1V58X3CMU.2DCCVAKQZGADV@tux.localdomain/../../../../foo F1TVKINT3G.2S6I36MXMHYG6@tux.localdomain" onclick="alert(1)" my @mids = split(/\n/, $msgs); -my $i = 0; -foreach my $mid (@mids) { - my $data = << ""; +my $ibx = create_inbox 'bad-mids', version => 2, indexlevel => 'basic', sub { + my ($im) = @_; + my $i = 0; + for my $mid (@mids) { + $im->add(PublicInbox::Eml->new(<<"")) or BAIL_OUT; Subject: test Message-ID: <$mid> From: a\@example.com To: b\@example.com Date: Fri, 02 Oct 1993 00:00:0$i +0000 + $i++; + } +}; - my $mime = PublicInbox::Eml->new(\$data); - ok($im->add($mime), "added $mid"); - $i++ -} -$im->done; - -my $cfg = <<EOF; -$cfgpfx.address=$ibx->{-primary_address} -$cfgpfx.inboxdir=$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) = @_; @@ -67,7 +51,7 @@ test_psgi(sub { $www->call(@_) }, sub { ok(index($raw, $mid) < 0, "escaped $mid"); } - my (@xmids) = ($raw =~ m!\bhref="([^"]+)/t\.mbox\.gz"!sg); + my (@xmids) = ($raw =~ m!\bhref="([^"]+?)/T/#u"!sg); is(scalar(@xmids), scalar(@mids), 'got escaped links to all messages'); @@ -84,6 +68,4 @@ test_psgi(sub { $www->call(@_) }, sub { } }); -done_testing(); - -1; +done_testing; diff --git a/t/psgi_mount.t b/t/psgi_mount.t index 5836e9ce..e43b9f2d 100644 --- a/t/psgi_mount.t +++ b/t/psgi_mount.t @@ -1,44 +1,34 @@ -# 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 Test::More; +use v5.12; use PublicInbox::Eml; use PublicInbox::TestCommon; my ($tmpdir, $for_destroy) = tmpdir(); -my $maindir = "$tmpdir/main.git"; -my $addr = 'test-public@example.com'; -my $cfgpfx = "publicinbox.test"; +my $v1dir = "$tmpdir/v1.git"; my @mods = qw(HTTP::Request::Common Plack::Test URI::Escape Plack::Builder Plack::App::URLMap); require_mods(@mods); use_ok $_ foreach @mods; use_ok 'PublicInbox::WWW'; -use PublicInbox::Import; -use PublicInbox::Git; -use PublicInbox::Config; -my $cfg = PublicInbox::Config->new(\<<EOF); -$cfgpfx.address=$addr -$cfgpfx.inboxdir=$maindir -EOF -my $git = PublicInbox::Git->new($maindir); -my $im = PublicInbox::Import->new($git, 'test', $addr); -$im->init_bare; -{ - my $mime = PublicInbox::Eml->new(<<EOF); +my $ibx = create_inbox 'test', tmpdir => $v1dir, sub { + my ($im, $ibx) = @_; + $im->add(PublicInbox::Eml->new(<<EOF)) or BAIL_OUT; From: Me <me\@example.com> To: You <you\@example.com> -Cc: $addr +Cc: $ibx->{-primary_address} Message-Id: <blah\@example.com> Subject: hihi Date: Thu, 01 Jan 1970 00:00:00 +0000 zzzzzz EOF - $im->add($mime); - $im->done; -} - +}; +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 { enable('Head'); @@ -56,14 +46,9 @@ test_psgi($app, sub { unlike($res->content, qr!\b\Qhttp://[^/]+/test/\E!, 'No URLs which are not mount-aware'); - $res = $cb->(GET('/a/test/new.html')); - like($res->content, qr!git clone --mirror http://[^/]+/a/test\b!, - 'clone URL in new.html is mount-aware'); - - $res = $cb->(GET('/a/test/blah%40example.com/')); - is($res->code, 200, 'OK with URLMap mount'); - like($res->content, qr!git clone --mirror http://[^/]+/a/test\b!, - 'clone URL in /$INBOX/$MESSAGE_ID/ is mount-aware'); + $res = $cb->(GET('/a/test/_/text/mirror/')); + like($res->content, qr!git clone --mirror\s+.*?http://[^/]+/a/test\b!s, + 'clone URL in /text/mirror is mount-aware'); $res = $cb->(GET('/a/test/blah%40example.com/raw')); is($res->code, 200, 'OK with URLMap mount'); @@ -82,8 +67,7 @@ test_psgi($app, sub { }); SKIP: { - require_mods(qw(DBD::SQLite Search::Xapian IO::Uncompress::Gunzip), 3); - my $ibx = $cfg->lookup_name('test'); + 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 8edbe088..e7c43abf 100644 --- a/t/psgi_multipart_not.t +++ b/t/psgi_multipart_not.t @@ -1,29 +1,18 @@ -# Copyright (C) 2018-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 PublicInbox::Eml; -use PublicInbox::Config; +use v5.12; use PublicInbox::TestCommon; +use PublicInbox::Eml; 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)); use_ok 'PublicInbox::WWW'; -use_ok 'PublicInbox::V2Writable'; -my ($repo, $for_destroy) = tmpdir(); -my $ibx = PublicInbox::Inbox->new({ - inboxdir => $repo, - name => 'multipart-not', - version => 2, - -primary_address => 'test@example.com', -}); -my $im = PublicInbox::V2Writable->new($ibx, 1); -$im->{parallel} = 0; - -my $mime = PublicInbox::Eml->new(<<'EOF'); +my $ibx = create_inbox 'v2', version => 2, sub { + my ($im) = @_; + $im->add(PublicInbox::Eml->new(<<'EOF')) or BAIL_OUT; Message-Id: <200308111450.h7BEoOu20077@mail.osdl.org> To: linux-kernel@vger.kernel.org Subject: [OSDL] linux-2.6.0-test3 reaim results @@ -36,17 +25,13 @@ From: exmh user <x@example.com> Freed^Wmultipart ain't what it used to be EOF -ok($im->add($mime), 'added broken multipart message'); -$im->done; - -my $cfgpfx = "publicinbox.v2test"; -my $cfg = <<EOF; -$cfgpfx.address=$ibx->{-primary_address} -$cfgpfx.inboxdir=$repo +}; +my $tmpdir = tmpdir; +my $www = PublicInbox::WWW->new(cfg_new($tmpdir, <<EOF)); +[publicinbox "v2test"] + address = $ibx->{-primary_address} + inboxdir = $ibx->{inboxdir} EOF -my $config = PublicInbox::Config->new(\$cfg); -my $www = PublicInbox::WWW->new($config); - my ($res, $raw); test_psgi(sub { $www->call(@_) }, sub { my ($cb) = @_; @@ -58,6 +43,4 @@ test_psgi(sub { $www->call(@_) }, sub { ok(index($raw, 'Warning: decoded text') >= 0, $u.' warns'); } }); - -done_testing(); -1; +done_testing; diff --git a/t/psgi_scan_all.t b/t/psgi_scan_all.t index 80b855e1..4c28b553 100644 --- a/t/psgi_scan_all.t +++ b/t/psgi_scan_all.t @@ -1,53 +1,38 @@ -# Copyright (C) 2019-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 PublicInbox::Eml; -use PublicInbox::Config; +use v5.12; use PublicInbox::TestCommon; -my @mods = qw(HTTP::Request::Common Plack::Test URI::Escape DBD::SQLite); -require_git 2.6; -require_mods(@mods); -use_ok 'PublicInbox::V2Writable'; -foreach my $mod (@mods) { use_ok $mod; } -my ($tmp, $for_destroy) = tmpdir(); -my $cfg = ''; - +use PublicInbox::Eml; +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 $cfgpfx = "publicinbox.test-$i"; - my $addr = "test-$i\@example.com"; - my $inboxdir = "$tmp/$i"; - $cfg .= "$cfgpfx.address=$addr\n"; - $cfg .= "$cfgpfx.inboxdir=$inboxdir\n"; - $cfg .= "$cfgpfx.url=http://example.com/$i\n"; - my $opt = { - inboxdir => $inboxdir, - name => "test-$i", - version => 2, - indexlevel => 'basic', - -primary_address => $addr, - }; - my $ibx = PublicInbox::Inbox->new($opt); - my $im = PublicInbox::V2Writable->new($ibx, 1); - $im->{parallel} = 0; - $im->init_inbox(0); - my $mime = PublicInbox::Eml->new(<<EOF); + my $ibx = create_inbox "test-$i", version => 2, indexlevel => 'basic', + sub { + my ($im, $ibx) = @_; + $im->add(PublicInbox::Eml->new(<<EOF)) or BAIL_OUT; From: a\@example.com -To: $addr +To: $ibx->{-primary_address} Subject: s$i Message-ID: <a-mid-$i\@b> Date: Fri, 02 Oct 1993 00:00:00 +0000 hello world EOF - - ok($im->add($mime), "added message to $i"); - $im->done; + }; + $cfgtxt .= <<EOM; +[publicinbox "test-$i"] + address = $ibx->{-primary_address} + inboxdir = $ibx->{inboxdir} + url = http://example.com/$i +EOM } -my $config = PublicInbox::Config->new(\$cfg); -use_ok 'PublicInbox::WWW'; -my $www = PublicInbox::WWW->new($config); +my $tmpdir = tmpdir; +my $www = PublicInbox::WWW->new(cfg_new($tmpdir, $cfgtxt)); test_psgi(sub { $www->call(@_) }, sub { my ($cb) = @_; @@ -65,5 +50,4 @@ test_psgi(sub { $www->call(@_) }, sub { is($res->code, 404, "404 on $x"); } }); - -done_testing(); +done_testing; diff --git a/t/psgi_search.t b/t/psgi_search.t index 9facdf3d..8c981c6c 100644 --- a/t/psgi_search.t +++ b/t/psgi_search.t @@ -1,16 +1,12 @@ -# 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::TestCommon; use IO::Uncompress::Gunzip qw(gunzip); use PublicInbox::Eml; -use PublicInbox::Config; use PublicInbox::Inbox; -use PublicInbox::InboxWritable; -use bytes (); # only for bytes::length -use PublicInbox::TestCommon; -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)); @@ -19,58 +15,58 @@ use_ok 'PublicInbox::SearchIdx'; my ($tmpdir, $for_destroy) = tmpdir(); local $ENV{TZ} = 'UTC'; -my $ibx = PublicInbox::Inbox->new({ - inboxdir => $tmpdir, - address => 'git@vger.kernel.org', - name => 'test', -}); -$ibx = PublicInbox::InboxWritable->new($ibx); -$ibx->init_inbox(1); -my $im = $ibx->importer(0); my $digits = '10010260936330'; my $ua = 'Pine.LNX.4.10'; my $mid = "$ua.$digits.2460-100000\@penguin.transmeta.com"; - -# n.b. these headers are not properly RFC2047-encoded -my $mime = PublicInbox::Eml->new(<<EOF); +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; Subject: test Ævar Message-ID: <$mid> From: Ævar Arnfjörð Bjarmason <avarab\@example> To: git\@vger.kernel.org EOF -$im->add($mime); -$im->add(PublicInbox::Eml->new(<<"")); + $im->add(PublicInbox::Eml->new(<<"")) or BAIL_OUT; Message-ID: <reply\@asdf> From: replier <r\@example.com> In-Reply-To: <$mid> Subject: mismatch -$mime = PublicInbox::Eml->new(<<'EOF'); + $im->add(PublicInbox::Eml->new(<<'EOF')) or BAIL_OUT; Subject: Message-ID: <blank-subject@example.com> From: blank subject <blank-subject@example.com> To: git@vger.kernel.org EOF -$im->add($mime); -$mime = PublicInbox::Eml->new(<<'EOF'); + $im->add(PublicInbox::Eml->new(<<'EOF')) or BAIL_OUT; Message-ID: <no-subject-at-all@example.com> From: no subject at all <no-subject-at-all@example.com> To: git@vger.kernel.org EOF -$im->add($mime); + $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 -$im->done; -PublicInbox::SearchIdx->new($ibx, 1)->index_sync; +EOF +}; -my $cfgpfx = "publicinbox.test"; -my $cfg = PublicInbox::Config->new(\<<EOF); -$cfgpfx.address=git\@vger.kernel.org -$cfgpfx.inboxdir=$tmpdir +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 { @@ -101,8 +97,13 @@ test_psgi(sub { $www->call(@_) }, sub { is($res->code, 200, 'successful search result'); is_deeply([], $warn, 'no warnings from non-numeric comparison'); + $res = $cb->(GET('/test/?&q=s:test')); + is($res->code, 200, 'successful search result'); + is_deeply([], $warn, 'no warnings from black parameter'); + $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; @@ -113,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; @@ -161,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 81355f04..2b678fd8 100644 --- a/t/psgi_v2.t +++ b/t/psgi_v2.t @@ -1,96 +1,141 @@ -# Copyright (C) 2018-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::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 - URI::Escape Plack::Builder)); +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'; -use_ok 'PublicInbox::V2Writable'; -my ($inboxdir, $for_destroy) = tmpdir(); -my $cfgpath = "$inboxdir/$$.config"; -SKIP: { - require_mods(qw(Plack::Test::ExternalServer), 1); - open my $fh, '>', $cfgpath or BAIL_OUT $!; - print $fh <<EOF or BAIL_OUT $!; -[publicinbox "v2test"] - inboxdir = $inboxdir - address = test\@example.com -EOF - close $fh or BAIL_OUT $!; -} - -my $run_httpd = sub { - my ($client, $skip) = @_; - SKIP: { - require_mods(qw(Plack::Test::ExternalServer), $skip); - my $env = { PI_CONFIG => $cfgpath }; - my $sock = tcp_server() or die; - my ($out, $err) = map { "$inboxdir/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); - $td->join('TERM'); - open my $fh, '<', $err or BAIL_OUT $!; - my $e = do { local $/; <$fh> }; - if ($e =~ s/^Plack::Middleware::ReverseProxy missing,\n//gms) { - $e =~ s/^URL generation for redirects .*\n//gms; - } - is($e, '', 'no errors'); - } -}; - -my $ibx = { - inboxdir => $inboxdir, - name => 'test-v2writable', - version => 2, - -primary_address => 'test@example.com', +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 }; -$ibx = PublicInbox::Inbox->new($ibx); -my $new_mid; - -my $im = PublicInbox::V2Writable->new($ibx, 1); -$im->{parallel} = 0; -my $mime = PublicInbox::Eml->new(<<'EOF'); +my $eml = PublicInbox::Eml->new(<<'EOF'); From oldbug-pre-a0c07cba0e5d8b6a Fri Oct 2 00:00:00 1993 From: a@example.com To: test@example.com Subject: this is a subject Message-ID: <a-mid@b> Date: Fri, 02 Oct 1993 00:00:00 +0000 +Content-Type: text/plain; charset=iso-8859-1 hello world EOF -ok($im->add($mime), 'added one message'); -$mime->body_set("hello world!\n"); - -my @warn; -local $SIG{__WARN__} = sub { push @warn, @_ }; -$mime->header_set(Date => 'Fri, 02 Oct 1993 00:01:00 +0000'); -ok($im->add($mime), 'added duplicate-but-different message'); -is(scalar(@warn), 1, 'got one warning'); -my $mids = mids($mime->header_obj); -$new_mid = $mids->[1]; -$im->done; +my $new_mid; +my $ibx = create_inbox 'v2-1', version => 2, indexlevel => 'medium', + tmpdir => "$tmpdir/v2", sub { + my ($im, $ibx) = @_; + $im->add($eml) or BAIL_OUT; + $eml->body_set("hello world!\n"); + my @warn; + local $SIG{__WARN__} = sub { push @warn, @_ }; + $eml->header_set(Date => 'Fri, 02 Oct 1993 00:01:00 +0000'); + $im->add($eml) or BAIL_OUT; + is(scalar(@warn), 1, 'got one warning'); + my $mids = mids($eml->header_obj); + $new_mid = $mids->[1]; + open my $fh, '>', "$ibx->{inboxdir}/new_mid" or BAIL_OUT; + print $fh $new_mid or BAIL_OUT; + close $fh or BAIL_OUT; +}; +$new_mid //= do { + open my $fh, '<', "$ibx->{inboxdir}/new_mid" or BAIL_OUT; + 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 $!; + print $fh <<EOF or BAIL_OUT $!; +[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; +} my $msg = $ibx->msg_by_mid('a-mid@b'); like($$msg, qr/\AFrom oldbug/s, '"From_" line stored to test old bug workaround'); - -my $cfgpfx = "publicinbox.v2test"; -my $cfg = PublicInbox::Config->new(\<<EOF); -$cfgpfx.address=$ibx->{-primary_address} -$cfgpfx.inboxdir=$inboxdir -EOF +my $cfg = PublicInbox::Config->new($cfgpath); my $www = PublicInbox::WWW->new($cfg); my ($res, $raw, @from_); my $client0 = sub { @@ -99,6 +144,8 @@ my $client0 = sub { like($res->content, qr!\$INBOX_DIR/description missing!, 'got v2 description missing message'); $res = $cb->(GET('/v2test/a-mid@b/raw')); + is($res->header('Content-Type'), 'text/plain; charset=iso-8859-1', + 'charset from message used'); $raw = $res->content; unlike($raw, qr/^From oldbug/sm, 'buggy "From_" line omitted'); like($raw, qr/^hello world$/m, 'got first message'); @@ -123,23 +170,40 @@ my $client0 = sub { @bodies = ($res->content =~ /^(hello [^<]+)$/mg); is_deeply(\@bodies, [ "hello world!\n", "hello world\n" ], 'new.html ordering is chronological'); + + $res = $cb->(GET('/v2test/new.atom')); + my @dates = ($res->content =~ m!title><updated>([^<]+)</updated>!g); + is_deeply(\@dates, [ "1993-10-02T00:01:00Z", "1993-10-02T00:00:00Z" ], + 'Date headers made it through'); }; test_psgi(sub { $www->call(@_) }, $client0); -$run_httpd->($client0, 9); - -$mime->header_set('Message-Id', 'a-mid@b'); -$mime->body_set("hello ghosts\n"); -ok($im->add($mime), 'added 3rd duplicate-but-different message'); -is(scalar(@warn), 2, 'got another warning'); -like($warn[0], qr/mismatched/, 'warned about mismatched messages'); -is($warn[0], $warn[1], 'both warnings are the same'); +my $env = { TMPDIR => $tmpdir, PI_CONFIG => $cfgpath }; +test_httpd($env, $client0, 9); -$mids = mids($mime->header_obj); +$eml->header_set('Message-ID', 'a-mid@b'); +$eml->body_set("hello ghosts\n"); +my $im = $ibx->importer(0); +{ + my @warn; + local $SIG{__WARN__} = sub { push @warn, @_ }; + ok($im->add($eml), 'added 3rd duplicate-but-different message'); + is(scalar(@warn), 1, 'got another warning'); + like($warn[0], qr/mismatched/, 'warned about mismatched messages'); +} +my $mids = mids($eml->header_obj); my $third = $mids->[-1]; $im->done; my $client1 = sub { my ($cb) = @_; + $res = $cb->(GET('/v2test/_/text/config/raw')); + my $lm = $res->header('Last-Modified'); + ok($lm, 'Last-Modified set w/ ->mm'); + $lm = HTTP::Date::str2time($lm); + is($lm, $ibx->mm->created_at, + 'Last-Modified for text/config/raw matches ->created_at'); + delete $ibx->{mm}; + $res = $cb->(GET("/v2test/$third/raw")); $raw = $res->content; like($raw, qr/^hello ghosts$/m, 'got third message'); @@ -156,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'); @@ -180,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'); @@ -191,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'); @@ -220,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'); @@ -229,19 +293,28 @@ 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); -$run_httpd->($client1, 38); +test_httpd($env, $client1, 38); { my $exp = [ qw(<a-mid@b> <reuse@mid>) ]; - $mime->header_set('Message-Id', @$exp); - $mime->header_set('Subject', '4th dupe'); + $eml->header_set('Message-Id', @$exp); + $eml->header_set('Subject', '4th dupe'); local $SIG{__WARN__} = sub {}; - ok($im->add($mime), 'added one message'); + ok($im->add($eml), 'added one message'); $im->done; - my @h = $mime->header('Message-ID'); + my @h = $eml->header('Message-ID'); is_deeply($exp, \@h, 'reused existing Message-ID'); $cfg->each_inbox(sub { $_[0]->search->reopen }); } @@ -274,16 +347,16 @@ my $client2 = sub { }; test_psgi(sub { $www->call(@_) }, $client2); -$run_httpd->($client2, 8); +test_httpd($env, $client2, 8); { # ensure conflicted attachments can be resolved + local $SIG{__WARN__} = sub {}; foreach my $body (qw(old new)) { - $mime = eml_load "t/psgi_v2-$body.eml"; - ok($im->add($mime), "added attachment $body"); + $im->add(eml_load "t/psgi_v2-$body.eml") or BAIL_OUT; } $im->done; - $cfg->each_inbox(sub { $_[0]->search->reopen }); } +$cfg->each_inbox(sub { $_[0]->search->reopen }); my $client3 = sub { my ($cb) = @_; @@ -299,13 +372,80 @@ my $client3 = sub { } $res = $cb->(GET('/v2test/?t=1970'.'01'.'01'.'000000')); is($res->code, 404, '404 for out-of-range t= param'); - @warn = (); + my @warn = (); + 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); -$run_httpd->($client3, 4); - -done_testing(); +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); + } +} -1; +done_testing; @@ -16,6 +16,7 @@ my $ibx = PublicInbox::Inbox->new({ inboxdir => $inboxdir, name => 'test-v2purge', version => 2, + -no_fsync => 1, -primary_address => 'test@example.com', indexlevel => 'basic', }); @@ -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/reindex-time-range.t b/t/reindex-time-range.t new file mode 100644 index 00000000..59f5c2aa --- /dev/null +++ b/t/reindex-time-range.t @@ -0,0 +1,58 @@ +# 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); +my $tmp = tmpdir(); +my $eml; +my $cb = sub { + my ($im, $ibx) = @_; + $eml //= eml_load 't/utf8.eml'; + for my $i (1..3) { + $eml->header_set('Message-ID', "<$i\@example.com>"); + my $d = "Thu, 01 Jan 1970 0$i:30:00 +0000"; + $eml->header_set('Date', $d); + $im->add($eml); + } +}; +my %ibx = map {; + "v$_" => create_inbox("v$_", version => $_, + indexlevel => 'basic', tmpdir => "$tmp/v$_", $cb); +} (1, 2); + +my $env = { TZ => 'UTC' }; +my ($out, $err); +for my $v (sort keys %ibx) { + my $opt = { -C => $ibx{$v}->{inboxdir}, 1 => \$out, 2 => \$err }; + + ($out, $err) = ('', ''); + run_script([ qw(-index -vv) ], $env, $opt); + is($?, 0, 'no error on initial index'); + + for my $x (qw(until before)) { + ($out, $err) = ('', ''); + run_script([ qw(-index --reindex -vv), + "--$x=1970-01-01T02:00:00Z" ], $env, $opt); + is($?, 0, "no error with --$x"); + like($err, qr! 1/1\b!, "$x only indexed one message"); + } + for my $x (qw(after since)) { + ($out, $err) = ('', ''); + run_script([ qw(-index --reindex -vv), + "--$x=1970-01-01T02:00:00Z" ], $env, $opt); + is($?, 0, "no error with --$x"); + like($err, qr! 2/2\b!, "$x only indexed one message"); + } + + ($out, $err) = ('', ''); + run_script([ qw(-index --reindex -vv) ], $env, $opt); + is($?, 0, 'no error on initial index'); + + for my $x (qw(since before after until)) { + ($out, $err) = ('', ''); + run_script([ qw(-index -v), "--$x=1970-01-01T02:00:00Z" ], + $env, $opt); + isnt($?, 0, "--$x fails on --reindex"); + } +} + +done_testing; diff --git a/t/rename_noreplace.t b/t/rename_noreplace.t new file mode 100644 index 00000000..bd1c4e92 --- /dev/null +++ b/t/rename_noreplace.t @@ -0,0 +1,26 @@ +#!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 PublicInbox::TestCommon; +use_ok 'PublicInbox::Syscall', 'rename_noreplace'; +my ($tmpdir, $for_destroy) = tmpdir; + +open my $fh, '>', "$tmpdir/a" or xbail $!; +my @sa = stat($fh); +is(rename_noreplace("$tmpdir/a", "$tmpdir/b"), 1, 'rename_noreplace'); +my @sb = stat("$tmpdir/b"); +ok(scalar(@sb), 'new file exists'); +ok(!-e "$tmpdir/a", 'original gone'); +is("@sa[0,1]", "@sb[0,1]", 'same st_dev + st_ino'); + +is(rename_noreplace("$tmpdir/a", "$tmpdir/c"), undef, 'undef on ENOENT'); +ok($!{ENOENT}, 'ENOENT set when missing'); + +open $fh, '>', "$tmpdir/a" or xbail $!; +is(rename_noreplace("$tmpdir/a", "$tmpdir/b"), undef, 'undef on EEXIST'); +ok($!{EEXIST}, 'EEXIST set when missing'); +is_deeply([stat("$tmpdir/b")], \@sb, 'target unchanged on EEXIST'); + +done_testing; diff --git a/t/replace.t b/t/replace.t index 51bdb964..a61c3ca0 100644 --- a/t/replace.t +++ b/t/replace.t @@ -20,6 +20,7 @@ sub test_replace ($$$) { inboxdir => "$tmpdir/testbox", name => $this, version => $v, + -no_fsync => 1, -primary_address => 'test@example.com', indexlevel => $level, }); @@ -48,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>']) { @@ -125,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}; @@ -186,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 }; @@ -1,8 +1,9 @@ +#!perl -w # Copyright (C) 2017-2021 all contributors <meta@public-inbox.org> # License: AGPL-3+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; -use warnings; use Test::More; +use PublicInbox::Config; use PublicInbox::Eml; use_ok 'PublicInbox::Reply'; @@ -15,7 +16,7 @@ my @q = ( while (@q) { my $input = shift @q; my $expect = shift @q; - my $res = PublicInbox::Reply::squote_maybe($input); + my $res = PublicInbox::Config::squote_maybe($input); is($res, $expect, "quote $input => $res"); } @@ -36,7 +37,7 @@ my $exp = [ '--in-reply-to=blah@example.com', '--to=from@example.com', '--cc=cc@example.com', - '--cc=to@example.com' + '--cc=to@example.com', ]; is_deeply($arg, $exp, 'default reply is to :all'); @@ -53,7 +54,7 @@ $exp = [ '--in-reply-to=blah@example.com', '--to=primary@example.com', '--cc=cc@example.com', - '--cc=to@example.com' + '--cc=to@example.com', ]; $ibx->{replyto} = ':list,Cc,To'; ($arg, $link) = PublicInbox::Reply::mailto_arg_link($ibx, $hdr); @@ -71,7 +72,7 @@ $exp = [ '--in-reply-to=blah@example.com', '--to=from@example$(echo .)com', '--cc=cc@example$(echo .)com', - '--cc=to@example$(echo .)com' + '--cc=to@example$(echo .)com', ]; is_deeply($arg, $exp, 'address obfuscation works'); is($link, '', 'no mailto: link given'); diff --git a/t/run.perl b/t/run.perl deleted file mode 100755 index e8512e18..00000000 --- a/t/run.perl +++ /dev/null @@ -1,211 +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 Getopt::Long qw(:config gnu_getopt no_ignore_case auto_abbrev); -use Errno qw(EINTR); -use Fcntl qw(:seek); -use POSIX qw(_POSIX_PIPE_BUF WNOHANG); -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); - -key2sub($_) for @tests; # precache - -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) = @_; - 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; - $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 - DIE join('', map { "E: $_\n" } @err) if @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; - } - push @err, "job[$j] ($?)" if $?; - # 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; diff --git a/t/search-thr-index.t b/t/search-thr-index.t index fc1b666a..aecd064f 100644 --- a/t/search-thr-index.t +++ b/t/search-thr-index.t @@ -1,13 +1,13 @@ +#!perl -w # Copyright (C) 2017-2021 all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; -use warnings; -use bytes (); # only for bytes::length +use v5.10.1; 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; @@ -45,7 +45,7 @@ foreach (reverse split(/\n\n/, $data)) { my $mime = PublicInbox::Eml->new(\$_); $mime->header_set('From' => 'bw@g'); $mime->header_set('To' => 'git@vger.kernel.org'); - my $bytes = bytes::length($mime->as_string); + my $bytes = length($mime->as_string); my $mid = mids($mime->header_obj)->[0]; my $smsg = bless { bytes => $bytes, @@ -92,7 +92,7 @@ To: git@vger.kernel.org my $tid0 = $dbh->selectrow_array(<<'', undef, $num); SELECT tid FROM over WHERE num = ? LIMIT 1 - my $bytes = bytes::length($mime->as_string); + my $bytes = length($mime->as_string); my $mid = mids($mime->header_obj)->[0]; my $smsg = bless { bytes => $bytes, @@ -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; } @@ -533,6 +530,30 @@ $ibx->with_umask(sub { is($query->('s:"mail header experiments"')->[0]->{mid}, '20200418222508.GA13918@dcvr', 'Subject search reaches inside message/rfc822'); + + 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'); + is_deeply($res, [], 'no results against trailer'); + $res = $query->('IcmZPo000310RR91'); + is_deeply($res, [], 'no results against 1-byte binary patch'); + $res = $query->('"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"'); + is_deeply($s, [], 'no results for wrong size'); }); SKIP: { @@ -550,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)]); @@ -561,9 +585,9 @@ SKIP: { is(strftime('%Y-%m-%d', gmtime($1//0)), '2010-10-02', 'rt: end expand'); $q = $s->query_argv_to_string($g, [qw(something dt:2010-10-02..)]); like($q, qr/\Asomething dt:20101002\d{6}\.\./, 'dt: expansion'); - $q = $s->query_argv_to_string($g, [qw(x d:yesterday.. y)]); - is($q, strftime('x d:%Y%m%d.. y', gmtime(time - 86400)), - '"yesterday" handled'); + $q = $s->query_argv_to_string($g, [qw(x dt:yesterday.. y)]); + my $exp = strftime('%Y%m%d', gmtime(time - 86400)); + like($q, qr/x dt:$exp[0-9]{6}\.\. y/, '"yesterday" handled'); $q = $s->query_argv_to_string($g, [qw(x dt:20101002054123)]); is($q, 'x dt:20101002054123..20101003054123', 'single dt: expanded'); $q = $s->query_argv_to_string($g, [qw(x dt:2010-10-02T05:41:23Z)]); @@ -600,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 @@ -612,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]; @@ -620,20 +644,26 @@ 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'); } my $x_days_ago = strftime('%Y%m%d', gmtime(time - (5 * 86400))); $orig = $qs = qq[broken d:5.days.ago..]; $s->query_approxidate($g, $qs); - is($qs, qq[broken d:$x_days_ago..], 'date.phrase.with.dots'); + like($qs, qr/\Abroken dt:$x_days_ago[0-9]{6}\.\./, + 'date.phrase.with.dots'); + + $orig = $qs = 'd:20101002..now'; + $s->query_approxidate($g, $qs); + like($qs, qr/\Adt:20101002000000\.\.[0-9]{14}\z/, + 'approxidate on range-end only'); $ENV{TEST_EXPENSIVE} or 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; diff --git a/t/shared_kv.t b/t/shared_kv.t index 251b7f39..8dfd3b25 100644 --- a/t/shared_kv.t +++ b/t/shared_kv.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; @@ -26,10 +26,6 @@ is($skv->get($dead), $cafe, 'get after xchg'); is($skv->xchg($dead, undef), $cafe, 'xchg to undef'); is($skv->get($dead), undef, 'get after xchg to undef'); is($skv->get($cafe), $dead, 'get after set_maybe'); -ok($skv->index_values, 'index_values works'); -is($skv->replace_values($dead, $cafe), 1, 'replaced one by value'); -is($skv->get($cafe), $cafe, 'value updated'); -is($skv->replace_values($dead, $cafe), 0, 'replaced none by value'); is($skv->xchg($dead, $cafe), undef, 'xchg from undef'); is($skv->count, 2, 'count works'); @@ -39,17 +35,15 @@ while (my ($k, $v) = $sth->fetchrow_array) { $seen{$k} = $v; } is($seen{$dead}, $cafe, '$dead has expected value'); -is($seen{$cafe}, $cafe, '$cafe has expected value'); +is($seen{$cafe}, $dead, '$cafe has expected value'); is(scalar keys %seen, 2, 'iterated through all'); -is($skv->replace_values($cafe, $dead), 2, 'replaced 2 by value'); -is($skv->delete_by_val('bogus'), 0, 'delete_by_val misses'); -is($skv->delete_by_val($dead), 2, 'delete_by_val hits'); -is($skv->delete_by_val($dead), 0, 'delete_by_val misses again'); - undef $skv; ok(!-d $skv_tmpdir, 'temporary dir gone'); $skv = PublicInbox::SharedKV->new("$tmpdir/dir", 'base'); ok(-e "$tmpdir/dir/base.sqlite3", 'file created'); +$skv->dbh; +ok($skv->set_maybe('02', '2'), "`02' set"); +ok($skv->set_maybe('2', '2'), "`2' set (no match on `02')"); done_testing; @@ -1,34 +1,42 @@ -# 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); -use PublicInbox::Syscall qw(SFD_NONBLOCK); require_ok 'PublicInbox::Sigfd'; +use PublicInbox::DS; +my ($linux_sigfd, $has_sigfd); SKIP: { if ($^O ne 'linux' && !eval { require IO::KQueue }) { skip 'signalfd requires Linux or IO::KQueue to emulate', 10; } - my $new = POSIX::SigSet->new; - $new->fillset or die "sigfillset: $!"; - my $old = POSIX::SigSet->new; - sigprocmask(SIG_SETMASK, $new, $old) or die "sigprocmask $!"; + + 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) { - require PublicInbox::DS; + $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 = ''; @@ -38,28 +46,44 @@ 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, SFD_NONBLOCK); + 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 - PublicInbox::DS->EventLoop; - is($hit->{HUP}->{sigfd}, 2, 'HUP sigfd fired in event loop'); + 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 kill('TERM', $$) or die "kill $!"; kill('HUP', $$) or die "kill $!"; - PublicInbox::DS->EventLoop; + PublicInbox::DS::event_loop(); 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/solve/bare.patch b/t/solve/bare.patch new file mode 100644 index 00000000..25d7f344 --- /dev/null +++ b/t/solve/bare.patch @@ -0,0 +1,8 @@ +diff --git a/script/public-inbox-extindex b/script/public-inbox-extindex +old mode 100644 +new mode 100755 +index 15ac20eb..771486c4 +--- a/script/public-inbox-extindex ++++ b/script/public-inbox-extindex +@@ -4 +3,0 @@ +-# Basic tool to create a Xapian search index for a public-inbox. diff --git a/t/solver_git.t b/t/solver_git.t index 3ae7259a..db672904 100644 --- a/t/solver_git.t +++ b/t/solver_git.t @@ -1,54 +1,165 @@ -# Copyright (C) 2019-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 Cwd qw(abs_path); +use v5.12; use PublicInbox::TestCommon; -require_git(2.6); -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 Cwd qw(abs_path); +require_git v2.6; +use PublicInbox::ContentHash qw(git_sha); +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 ($inboxdir, $for_destroy) = tmpdir(); -my $opts = { - inboxdir => $inboxdir, - name => 'test-v2writable', - version => 2, - -primary_address => 'test@example.com', -}; -my $ibx = PublicInbox::Inbox->new($opts); -my $im = PublicInbox::V2Writable->new($ibx, 1); -$im->{parallel} = 0; +my $patch2 = eml_load 't/solve/0002-rename-with-modifications.patch'; +my $patch2_oid = git_sha(1, $patch2)->hexdigest; -my $deliver_patch = sub ($) { - $im->add(eml_load($_[0])); - $im->done; +my ($tmpdir, $for_destroy) = tmpdir(); +my $ibx = create_inbox 'v2', version => 2, + indexlevel => 'medium', sub { + my ($im) = @_; + $im->add(eml_load 't/solve/0001-simple-mod.patch') or BAIL_OUT; + $im->add($patch2) or BAIL_OUT; }; +my $md = "$tmpdir/md"; +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: $!"; -$deliver_patch->('t/solve/0001-simple-mod.patch'); +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}, + \'--mail works for existing oid'); + is($lei_out, $patch2->as_string, 'blob matches'); + ok(!lei('blob', '--mail', '69df7d5', '-I', $ibx->{inboxdir}), + "--mail won't run solver"); + like($lei_err, qr/\b69df7d5\b/, 'OID in error by git(1)'); + + lei_ok('blob', '69df7d5', '-I', $ibx->{inboxdir}); + is(git_sha(1, \$lei_out)->hexdigest, $expect, 'blob contents output'); + my $prev = $lei_out; + lei_ok(qw(blob --no-mail 69df7d5 -I), $ibx->{inboxdir}); + is($lei_out, $prev, '--no-mail works'); + ok(!lei(qw(blob -I), $ibx->{inboxdir}, $non_existent), + 'non-existent blob fails'); + my $abbrev = substr($non_existent, 0, 7); + like($lei_err, qr/could not find $abbrev/, 'failed abbreviation noted'); + SKIP: { + skip '/.git exists', 1 if -e '/.git'; + lei_ok(qw(-C / blob 69df7d5 -I), $ibx->{inboxdir}, + "--git-dir=$git_dir"); + is($lei_out, $prev, '--git-dir works'); + + ok(!lei(qw(-C / blob --no-cwd 69df7d5 -I), $ibx->{inboxdir}), + '--no-cwd works'); + like($lei_err, qr/no --git-dir to try/, + 'lack of --git-dir noted'); + + ok(!lei(qw(-C / blob -I), $ibx->{inboxdir}, $non_existent), + 'non-existent blob fails'); + like($lei_err, qr/no --git-dir to try/, + 'lack of --git-dir noted'); + } + + # fallbacks + lei_ok('blob', $v1_0_0_tag, '-I', $ibx->{inboxdir}); + lei_ok('blob', $v1_0_0_tag_short, '-I', $ibx->{inboxdir}); +}); + +test_lei({tmpdir => "$tmpdir/rediff"}, sub { + lei_ok(qw(rediff -q -U9 t/solve/0001-simple-mod.patch)); + like($lei_out, qr!^\Q+++\E b/TODO\n@@ -103,9 \+103,11 @@!sm, + 'got more context with -U9'); + + my (undef, $re) = split(/\n\n/, $lei_out, 2); + $re =~ s/^/> /sgm; + substr($re, 0, 0, <<EOM); +From: me\@example.com +Subject: Re: awesome advice + +WEB DESIGN EXPERT wrote: +EOM + lei_ok([qw(rediff --full-index -U16 --drq)], undef, + { 0 => \$re, %$lei_opt }); + my $exp = <<'EOM'; +From: me@example.com +Subject: Re: awesome advice + +EOM + like($lei_out, qr/\Q$exp\E/, '--drq preserved header'); + + # n.b. --drq can requote the attribution line ("So-and-so wrote:"), + # but it's probably not worth preventing... + + $exp = <<'EOM'; +> --- +> TODO | 2 ++ +> Ω | 5 -- +> 1 file changed, 2 insertions(+) +> +> diff --git a/TODO b/TODO +> index 605013e4904baabecd4a0a55997aebd8e8477a8f..69df7d565d49fbaaeb0a067910f03dc22cd52bd0 100644 +> --- a/TODO +> +++ b/TODO +> @@ -96,16 +96,18 @@ all need to be considered for everything we introduce) +EOM + $exp =~ s/^>$/> /sgm; # re-add trailing white space + like($lei_out, qr/\Q$exp\E/, '--drq diffstat + context'); + + lei_ok(qw(rediff -q --full-index -U9 t/solve/bare.patch)); + $exp = <<'EOM'; +diff --git a/script/public-inbox-extindex b/script/public-inbox-extindex +old mode 100644 +new mode 100755 +index 15ac20eb871bf47697377e58a27db23102a38fca..771486c425b315bae70fd8a82d62ab0331e0a827 +--- a/script/public-inbox-extindex ++++ b/script/public-inbox-extindex +@@ -1,13 +1,12 @@ + #!perl -w +EOM + like($lei_out, qr/\Q$exp\E/, + 'preserve mode, regen header + context from -U0 patch'); + is($lei_err, '', 'no warnings from bare patch'); + my $e = { GIT_DIR => "$ENV{HOME}/.local/share/lei/store/ALL.git" }; + my @x = xqx([qw(git cat-file --batch-all-objects --batch-check)], $e); + is_deeply(\@x, [], 'no objects stored') or diag explain(\@x); +}); + +test_lei({tmpdir => "$tmpdir/index-eml-only"}, sub { + lei_ok(qw(index), $md); + lei_ok(qw(blob 69df7d5)); # hits LeiSearch->smsg_eml -> lms->local_blob +}); my $git = PublicInbox::Git->new($git_dir); $ibx->{-repo_objs} = [ $git ]; my $res; my $solver = PublicInbox::SolverGit->new($ibx, sub { $res = $_[0] }); -open my $log, '+>>', "$inboxdir/solve.log" or die "open: $!"; +open my $log, '+>>', "$tmpdir/solve.log" or die "open: $!"; my $psgi_env = { 'psgi.errors' => \*STDERR, 'psgi.url_scheme' => 'http', 'HTTP_HOST' => 'example.com' }; $solver->solve($psgi_env, $log, '69df7d5', {}); ok($res, 'solved a blob!'); my $wt_git = $res->[0]; is(ref($wt_git), 'PublicInbox::Git', 'got a git object for the blob'); -my $expect = '69df7d565d49fbaaeb0a067910f03dc22cd52bd0'; is($res->[1], $expect, 'resolved blob to unabbreviated identifier'); is($res->[2], 'blob', 'type specified'); is($res->[3], 4405, 'size returned'); @@ -57,12 +168,6 @@ is(ref($wt_git->cat_file($res->[1])), 'SCALAR', 'wt cat-file works'); is_deeply([$expect, 'blob', 4405], [$wt_git->check($res->[1])], 'wt check works'); -if (0) { # TODO: check this? - seek($log, 0, 0); - my $z = do { local $/; <$log> }; - diag $z; -} - my $oid = $expect; for my $i (1..2) { my $more; @@ -87,7 +192,6 @@ $solver = PublicInbox::SolverGit->new($ibx, sub { $res = $_[0] }); $solver->solve($psgi_env, $log, $git_v2_20_1_tag, {}); is($res, undef, 'no error on a tag not in our repo'); -$deliver_patch->('t/solve/0002-rename-with-modifications.patch'); $solver = PublicInbox::SolverGit->new($ibx, sub { $res = $_[0] }); $solver->solve($psgi_env, $log, '0a92431', {}); ok($res, 'resolved without hints'); @@ -104,13 +208,14 @@ 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; - my $binfoo = "$inboxdir/binfoo.git"; - require PublicInbox::Import; - PublicInbox::Import::init_bare($binfoo); + require PublicInbox::WWW; + my $binfoo = "$ibx->{inboxdir}/binfoo.git"; + my $l = "$ibx->{inboxdir}/inbox.lock"; + -f $l or BAIL_OUT "BUG: $l missing: $!"; require_ok 'PublicInbox::ViewVCS'; my $big_size = do { no warnings 'once'; @@ -118,27 +223,63 @@ SKIP: { }; my %bin = (big => $big_size, small => 1); my %oid; # (small|big) => OID - my $cmd = [ qw(git hash-object -w --stdin) ]; - my $env = { GIT_DIR => $binfoo }; - while (my ($label, $size) = each %bin) { - pipe(my ($rin, $win)) or die; - my $rout = popen_rd($cmd , $env, { 0 => $rin }); - $rin = undef; - print { $win } ("\0" x $size) or die; - close $win or die; - chomp($oid{$label} = <$rout>); - close $rout or die "$?"; - } + require PublicInbox::Lock; + my $lk = PublicInbox::Lock->new($l); + my $acq = $lk->lock_for_scope; + 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 }; + while (my ($label, $size) = each %bin) { + 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; + } + undef $acq; # ensure the PSGI frontend (ViewVCS) works: my $name = $ibx->{name}; my $cfgpfx = "publicinbox.$name"; - my $cfgpath = "$inboxdir/httpd-config"; + my $cfgpath = "$tmpdir/httpd-config"; open my $cfgfh, '>', $cfgpath or die; print $cfgfh <<EOF or die; +[coderepo] + snapshots = tar.gz [publicinbox "$name"] - address = $ibx->{address}; - inboxdir = $inboxdir + address = $ibx->{-primary_address} + inboxdir = $ibx->{inboxdir} coderepo = public-inbox coderepo = binfoo url = http://example.com/$name @@ -150,9 +291,18 @@ 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 $non_existent = 'ee5e32211bf62ab6531bdf39b84b6920d0b6775a'; my $client = sub { my ($cb) = @_; my $mid = '20190401081523.16213-1-BOFH@YHBT.net'; @@ -171,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)'); @@ -180,26 +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 { "$inboxdir/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); - } + 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 { + 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,18 +20,39 @@ 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'); is(waitpid($pid, 0), $pid, 'waitpid succeeds on spawned process'); is($?, 0, 'true exited successfully'); pipe(my ($r, $w)) or BAIL_OUT; - $pid = eval { spawn(['true'], undef, { pgid => 1, 2 => $w }) }; + + # Find invalid PID to try to join its process group. + my $wrong_pgid = 1; + for (my $i=0x7fffffff; $i >= 2; $i--) { + if (kill(0, $i) == 0) { + $wrong_pgid = $i; + last; + } + } + + # Test spawn behavior when it can't join the requested process group. + $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'); @@ -51,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); } @@ -85,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: '.$?); } @@ -129,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) }; @@ -160,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/thread-cycle.t b/t/thread-cycle.t index 613c142e..1e5dfb51 100644 --- a/t/thread-cycle.t +++ b/t/thread-cycle.t @@ -1,19 +1,16 @@ # Copyright (C) 2016-2021 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::TestCommon; -require_mods 'Email::Simple'; +use strict; use v5.10.1; use PublicInbox::TestCommon; use_ok('PublicInbox::SearchThread'); my $mt = eval { require Mail::Thread; no warnings 'once'; $Mail::Thread::nosubject = 1; $Mail::Thread::noprune = 1; + require Email::Simple; # required by Mail::Thread (via Email::Abstract) }; -sub make_objs { +my $make_objs = sub { my @simples; my $n = 0; my @msgs = map { @@ -21,17 +18,19 @@ sub make_objs { $msg->{ds} ||= ++$n; $msg->{references} =~ s/\s+/ /sg if $msg->{references}; $msg->{blob} = '0'x40; # any dummy value will do, here - my $simple = Email::Simple->create(header => [ - 'Message-ID' => "<$msg->{mid}>", - 'References' => $msg->{references}, - ]); - push @simples, $simple; + if ($mt) { + my $simple = Email::Simple->create(header => [ + 'Message-ID' => "<$msg->{mid}>", + 'References' => $msg->{references}, + ]); + push @simples, $simple; + } bless $msg, 'PublicInbox::Smsg' } @_; (\@simples, \@msgs); -} +}; -my ($simples, $smsgs) = make_objs( +my ($simples, $smsgs) = $make_objs->( # data from t/testbox-6 in Mail::Thread 2.55: { mid => '20021124145312.GA1759@nlin.net' }, { mid => 'slrnau448m.7l4.markj+0111@cloaked.freeserve.co.uk', @@ -79,13 +78,13 @@ my @backwards = ( { mid => 8, references => '' } ); -($simples, $smsgs) = make_objs(@backwards); +($simples, $smsgs) = $make_objs->(@backwards); my $backward = thread_to_s($smsgs); SKIP: { skip 'Mail::Thread missing', 1 unless $mt; check_mt($backward, $simples, 'matches Mail::Thread backwards'); } -($simples, $smsgs) = make_objs(reverse @backwards); +($simples, $smsgs) = $make_objs->(reverse @backwards); my $forward = thread_to_s($smsgs); unless ('Mail::Thread sorts by Date') { SKIP: { @@ -97,12 +96,31 @@ if ('sorting by Date') { is("\n".$backward, "\n".$forward, 'forward and backward matches'); } -done_testing(); +SKIP: { + require_mods 'Devel::Cycle', 1; + Devel::Cycle->import('find_cycle'); + my @dup = ( + { mid => 5, references => '<6>' }, + { mid => 5, references => '<6> <1>' }, + ); + open my $fh, '+>', \(my $out = '') or xbail "open: $!"; + (undef, $smsgs) = $make_objs->(@dup); + eval 'package EmptyInbox; sub smsg_by_mid { undef }'; + my $ctx = { ibx => bless {}, 'EmptyInbox' }; + my $rootset = PublicInbox::SearchThread::thread($smsgs, sub { + @{$_[0]} = sort { $a->{mid} cmp $b->{mid} } @{$_[0]} }, $ctx); + my $oldout = select $fh; + find_cycle($rootset); + select $oldout; + is($out, '', 'nothing from find_cycle'); +} # Devel::Cycle check + +done_testing; sub thread_to_s { my ($msgs) = @_; my $rootset = PublicInbox::SearchThread::thread($msgs, sub { - [ sort { $a->{mid} cmp $b->{mid} } @{$_[0]} ] }); + @{$_[0]} = sort { $a->{mid} cmp $b->{mid} } @{$_[0]} }); my $st = ''; my @q = map { (0, $_) } @$rootset; while (@q) { diff --git a/t/thread-index-gap.t b/t/thread-index-gap.t index 125c5cbd..15c362f0 100644 --- a/t/thread-index-gap.t +++ b/t/thread-index-gap.t @@ -3,10 +3,8 @@ # 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::Eml; -use PublicInbox::InboxWritable; use PublicInbox::Config; use List::Util qw(shuffle); require_mods(qw(DBD::SQLite)); @@ -31,26 +29,26 @@ References: <20201202045540.31248-1-j@example.com> EOF my ($home, $for_destroy) = tmpdir(); -local $ENV{HOME} = $home; for my $msgs (['orig', reverse @msgs], ['shuffle', shuffle(@msgs)]) { my $desc = shift @$msgs; - my $n = "index-cap-$desc"; - run_script([qw(-init -L basic -V2), $n, "$home/$n", - "http://example.com/$n", "$n\@example.com"]) or - BAIL_OUT 'init'; - my $ibx = PublicInbox::Config->new->lookup_name($n); - my $im = PublicInbox::InboxWritable->new($ibx)->importer(0); - for my $m (@$msgs) { - $im->add(PublicInbox::Eml->new("$m\nFrom: x\@example.com\n\n")); - } - $im->done; + my $n = "index-cap-$desc-basic"; + # yes, the shuffle case gets memoized by create_inbox, oh well + my $ibx = create_inbox $desc, version => 2, indexlevel => 'basic', + tmpdir => "$home/$desc", sub { + my ($im) = @_; + for my $m (@$msgs) { + my $x = "$m\nFrom: x\@example.com\n\n"; + $im->add(PublicInbox::Eml->new(\$x)); + } + }; my $over = $ibx->over; my $dbh = $over->dbh; my $tid = $dbh->selectall_arrayref('SELECT DISTINCT(tid) FROM over'); is(scalar(@$tid), 1, "only one thread initially ($desc)"); $over->dbh_close; + my $env = { HOME => $home }; run_script([qw(-index --no-fsync --reindex --rethread), - $ibx->{inboxdir}]) or BAIL_OUT 'rethread'; + $ibx->{inboxdir}], $env) or BAIL_OUT 'rethread'; $tid = $dbh->selectall_arrayref('SELECT DISTINCT(tid) FROM over'); is(scalar(@$tid), 1, "only one thread after rethread ($desc)"); } diff --git a/t/uri_imap.t b/t/uri_imap.t index f7c78665..7a97f875 100644 --- a/t/uri_imap.t +++ b/t/uri_imap.t @@ -2,7 +2,7 @@ # Copyright (C) 2020-2021 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.10.1; use PublicInbox::TestCommon; require_mods 'URI::Split'; use_ok 'PublicInbox::URIimap'; @@ -54,6 +54,7 @@ is(PublicInbox::URIimap->new('imaps://0:993/')->canonical->as_string, $uri = PublicInbox::URIimap->new('imap://NSA:Hunter2@0/INBOX'); is($uri->user, 'NSA'); is($uri->password, 'Hunter2'); +is($uri->uidvalidity, undef, 'no UIDVALIDITY'); $uri = PublicInbox::URIimap->new('imap://0/%'); is($uri->mailbox, '%', "RFC 2192 '%' supported"); @@ -61,6 +62,92 @@ $uri = PublicInbox::URIimap->new('imap://0/%25'); $uri = PublicInbox::URIimap->new('imap://0/*'); is($uri->mailbox, '*', "RFC 2192 '*' supported"); -# TODO: support UIDVALIDITY and other params +$uri = PublicInbox::URIimap->new('imap://0/mmm;UIDVALIDITY=1'); +is($uri->mailbox, 'mmm', 'mailbox works with UIDVALIDITY'); +is($uri->uidvalidity, 1, 'single-digit UIDVALIDITY'); +$uri = PublicInbox::URIimap->new('imap://0/mmm;UIDVALIDITY=21'); +is($uri->uidvalidity, 21, 'multi-digit UIDVALIDITY'); +$uri = PublicInbox::URIimap->new('imap://0/mmm;UIDVALIDITY=bogus'); +is($uri->uidvalidity, undef, 'bogus UIDVALIDITY'); +is($uri->uidvalidity(2), 2, 'uid set'); +is($$uri, 'imap://0/mmm;UIDVALIDITY=2', 'bogus uidvalidity replaced'); +is($uri->uidvalidity(13), 13, 'uid set'); +is($$uri, 'imap://0/mmm;UIDVALIDITY=13', 'valid uidvalidity replaced'); + +$uri = PublicInbox::URIimap->new('imap://0/mmm'); +is($uri->uidvalidity(2), 2, 'uid set'); +is($$uri, 'imap://0/mmm;UIDVALIDITY=2', 'uidvalidity appended'); +is($uri->uid, undef, 'no uid'); + +is(PublicInbox::URIimap->new('imap://0/x;uidvalidity=1')->canonical->as_string, + 'imap://0/x;UIDVALIDITY=1', 'capitalized UIDVALIDITY'); + +$uri = PublicInbox::URIimap->new('imap://0/mmm/;uid=8'); +is($uri->canonical->as_string, 'imap://0/mmm/;UID=8', 'canonicalized UID'); +is($uri->mailbox, 'mmm', 'mailbox works with uid'); +is($uri->uid, 8, 'uid extracted'); +is($uri->uid(9), 9, 'uid set'); +is($$uri, 'imap://0/mmm/;UID=9', 'correct uid when stringified'); +is($uri->uidvalidity(1), 1, 'set uidvalidity with uid'); +is($$uri, 'imap://0/mmm;UIDVALIDITY=1/;UID=9', + 'uidvalidity added with uid'); +is($uri->uidvalidity(4), 4, 'set uidvalidity with uid'); +is($$uri, 'imap://0/mmm;UIDVALIDITY=4/;UID=9', + 'uidvalidity replaced with uid'); +is($uri->uid(3), 3, 'uid set with uidvalidity'); +is($$uri, 'imap://0/mmm;UIDVALIDITY=4/;UID=3', 'uid replaced properly'); + +my $lc = lc($$uri); +is(PublicInbox::URIimap->new($lc)->canonical->as_string, "$$uri", + 'canonical uppercased both params'); + +is($uri->uid(undef), undef, 'uid can be clobbered'); +is($$uri, 'imap://0/mmm;UIDVALIDITY=4', 'uid dropped'); + +$uri->auth('ANONYMOUS'); +is($$uri, 'imap://;AUTH=ANONYMOUS@0/mmm;UIDVALIDITY=4', 'AUTH= set'); +is($uri->user, undef, 'user is undef w/ AUTH='); +is($uri->password, undef, 'password is undef w/ AUTH='); + +$uri->user('foo'); +is($$uri, 'imap://foo;AUTH=ANONYMOUS@0/mmm;UIDVALIDITY=4', 'user set w/AUTH'); +is($uri->password, undef, 'password is undef w/ AUTH= & user'); +$uri->auth(undef); +is($$uri, 'imap://foo@0/mmm;UIDVALIDITY=4', 'user remains set w/o auth'); +is($uri->password, undef, 'password is undef w/ user only'); + +$uri->user('bar'); +is($$uri, 'imap://bar@0/mmm;UIDVALIDITY=4', 'user set w/o AUTH'); +$uri->auth('NTML'); +is($$uri, 'imap://bar;AUTH=NTML@0/mmm;UIDVALIDITY=4', 'auth set w/user'); +$uri->auth(undef); +$uri->user(undef); +is($$uri, 'imap://0/mmm;UIDVALIDITY=4', 'auth and user both cleared'); +is($uri->user, undef, 'user is undef'); +is($uri->auth, undef, 'auth is undef'); +is($uri->password, undef, 'password is undef'); +$uri = PublicInbox::URIimap->new('imap://[::1]:36281/'); +my $cred = bless { username => $uri->user, password => $uri->password }; +is($cred->{username}, undef, 'user is undef in array context'); +is($cred->{password}, undef, 'password is undef in array context'); +$uri = PublicInbox::URIimap->new('imap://u@example.com/slash/separator'); +is($uri->mailbox, 'slash/separator', "`/' separator accepted"); +is($uri->uidvalidity(6), 6, "UIDVALIDITY set with `/' separator"); +is($$uri, 'imap://u@example.com/slash/separator;UIDVALIDITY=6', + "URI correct after adding UIDVALIDITY w/ `/' separator"); + +$uri = PublicInbox::URIimap->new('imap://u@example.com/a/b;UIDVALIDITY=3'); +is($uri->uidvalidity, 3, "UIDVALIDITY w/ `/' separator"); +is($uri->mailbox, 'a/b', "mailbox w/ `/' separator + UIDVALIDITY"); +is($uri->uidvalidity(4), 4, "UIDVALIDITY set w/ `/' separator"); +is($$uri, 'imap://u@example.com/a/b;UIDVALIDITY=4', + "URI correct after replacing UIDVALIDITY w/ `/' separator"); +is($uri->uid(5), 5, "set /;UID= w/ `/' separator"); + +$uri = PublicInbox::URIimap->new('imap://u@example.com/a/b/;UID=9'); +is($uri->uid, 9, "UID read with `/' separator w/o UIDVALIDITY"); +is($uri->uid(8), 8, "UID set with `/' separator w/o UIDVALIDITY"); +is($$uri, 'imap://u@example.com/a/b/;UID=8', + "URI correct after replacing UID w/ `/' separator"); done_testing; diff --git a/t/uri_nntps.t b/t/uri_nntps.t index babd8088..6b123a9b 100644 --- a/t/uri_nntps.t +++ b/t/uri_nntps.t @@ -37,4 +37,7 @@ is(PublicInbox::URInntps->new('nntps://0:563/')->canonical->as_string, $uri = PublicInbox::URInntps->new('nntps://NSA:Hunter2@0/inbox'); is($uri->userinfo, 'NSA:Hunter2', 'userinfo accepted w/ pass'); +$uri = PublicInbox::URInntps->new('nntps://NSA:Hunter2@0/inbox.test/9-10'); +is_deeply([$uri->group], [ 'inbox.test', 9, 10 ], 'ranges work'); + 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 36cefda5..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'; @@ -18,6 +18,7 @@ my $ibx_config = { name => 'test-v1reindex', -primary_address => 'test@example.com', indexlevel => 'full', + -no_fsync => 1, }; my $mime = PublicInbox::Eml->new(<<'EOF'); From: a@example.com diff --git a/t/v2-add-remove-add.t b/t/v2-add-remove-add.t index b325e521..ddf8d248 100644 --- a/t/v2-add-remove-add.t +++ b/t/v2-add-remove-add.t @@ -6,13 +6,14 @@ 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 = { inboxdir => "$inboxdir/v2", name => 'test-v2writable', version => 2, + -no_fsync => 1, -primary_address => 'test@example.com', }; $ibx = PublicInbox::Inbox->new($ibx); @@ -31,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'); diff --git a/t/v2dupindex.t b/t/v2dupindex.t index 4b20c8e0..3339cc10 100644 --- a/t/v2dupindex.t +++ b/t/v2dupindex.t @@ -4,49 +4,49 @@ # we can index a message from a mirror which bypasses dedupe. use strict; -use Test::More; +use v5.10.1; use PublicInbox::TestCommon; +use PublicInbox::Import; +use PublicInbox::Git; require_git(2.6); require_mods(qw(DBD::SQLite)); my ($tmpdir, $for_destroy) = tmpdir(); -use_ok 'PublicInbox::Import'; -use_ok 'PublicInbox::Git'; -use_ok 'PublicInbox::InboxWritable'; -my $ibx = PublicInbox::InboxWritable->new({ - inboxdir => $tmpdir, - name => 'test-v2dupindex', - version => 2, - indexlevel => 'basic', - -primary_address => 'test@example.com', -}, { nproc => 1 }); -$ibx->init_inbox(1); -my $v2w = $ibx->importer; -$v2w->add(eml_load('t/plack-qp.eml')); -$v2w->add(eml_load('t/mda-mime.eml')); -$v2w->done; - -my $git0 = PublicInbox::Git->new("$tmpdir/git/0.git"); -my $im = PublicInbox::Import->new($git0, undef, undef, $ibx); -$im->{path_type} = 'v2'; -$im->{lock_path} = undef; - -# bypass duplicate filters (->header_set is optional) -my $eml = eml_load('t/plack-qp.eml'); -$eml->header_set('X-This-Is-Not-Checked-By-ContentHash', 'blah'); -ok($im->add($eml), 'add seen message directly'); -ok($im->add(eml_load('t/mda-mime.eml')), 'add another seen message directly'); - -ok($im->add(eml_load('t/iso-2202-jp.eml')), 'add another new message'); -$im->done; - -# mimic a fresh clone by dropping indices -my @sqlite = (glob("$tmpdir/*sqlite3*"), glob("$tmpdir/xap*/*sqlite3*")); -is(unlink(@sqlite), scalar(@sqlite), 'unlinked SQLite indices'); -my @shards = glob("$tmpdir/xap*/?"); -is(scalar(@shards), 0, 'no Xapian shards to drop'); - +my $inboxdir = "$tmpdir/test"; +my $ibx = create_inbox('test', indexlevel => 'basic', version => 2, + tmpdir => $inboxdir, sub { + my ($im, $ibx) = @_; + $im->add(eml_load('t/plack-qp.eml')); + $im->add(eml_load('t/mda-mime.eml')); + $im->done; + + # bypass duplicate filters (->header_set is optional) + my $git0 = PublicInbox::Git->new("$ibx->{inboxdir}/git/0.git"); + $_[0] = undef; + $im = PublicInbox::Import->new($git0, undef, undef, $ibx); + $im->{path_type} = 'v2'; + $im->{lock_path} = undef; + + my $eml = eml_load('t/plack-qp.eml'); + $eml->header_set('X-This-Is-Not-Checked-By-ContentHash', 'blah'); + $im->add($eml) or BAIL_OUT 'add seen message directly'; + $im->add(eml_load('t/mda-mime.eml')) or + BAIL_OUT 'add another seen message directly'; + $im->add(eml_load('t/iso-2202-jp.eml')) or + BAIL_OUT 'add another new message'; + $im->done; + # mimic a fresh clone by dropping indices + my $dir = $ibx->{inboxdir}; + my @sqlite = (glob("$dir/*sqlite3*"), glob("$dir/xap*/*sqlite3*")); + unlink(@sqlite) == scalar(@sqlite) or + BAIL_OUT 'did not unlink SQLite indices'; + my @shards = glob("$dir/xap*/?"); + scalar(@shards) == 0 or BAIL_OUT 'Xapian shards created unexpectedly'; + open my $fh, '>', "$dir/empty" or BAIL_OUT; + rmdir($_) for glob("$dir/xap*"); +}); +my $env = { PI_CONFIG => "$inboxdir/empty" }; my $rdr = { 2 => \(my $err = '') }; -ok(run_script([qw(-index -Lbasic), $tmpdir], undef, $rdr), '-indexed'); +ok(run_script([qw(-index -Lbasic), $inboxdir ], $env, $rdr), '-indexed'); my @n = $ibx->over->dbh->selectrow_array('SELECT COUNT(*) FROM over'); is_deeply(\@n, [ 3 ], 'identical message not re-indexed'); my $mm = $ibx->mm->{dbh}->selectall_arrayref(<<''); diff --git a/t/v2index-late-dupe.t b/t/v2index-late-dupe.t new file mode 100644 index 00000000..d43e833b --- /dev/null +++ b/t/v2index-late-dupe.t @@ -0,0 +1,38 @@ +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +# +# this simulates a mirror path: git fetch && -index +use strict; use v5.10.1; use PublicInbox::TestCommon; +use Test::More; # redundant, used for bisect +require_mods 'v2'; +require PublicInbox::Import; +require PublicInbox::Inbox; +require PublicInbox::Git; +my ($tmpdir, $for_destroy) = tmpdir(); +my $inboxdir = "$tmpdir/i"; +local $ENV{HOME} = $tmpdir; +PublicInbox::Import::init_bare(my $e0 = "$inboxdir/git/0.git"); +open my $fh, '>', "$inboxdir/inbox.lock" or xbail $!; +my $git = PublicInbox::Git->new($e0); +my $im = PublicInbox::Import->new($git, qw(i i@example.com)); +$im->{lock_path} = undef; +$im->{path_type} = 'v2'; +my $eml = eml_load('t/plack-qp.eml'); +ok($im->add($eml), 'add original'); +$im->done; +run_script([qw(-index -Lbasic), $inboxdir]); +is($?, 0, 'basic index'); +my $ibx = PublicInbox::Inbox->new({ inboxdir => $inboxdir }); +my $orig = $ibx->over->get_art(1); + +my @mid = $eml->header_raw('Message-ID'); +$eml->header_set('Message-ID', @mid, '<extra@z>'); +ok($im->add($eml), 'add another'); +$im->done; +run_script([qw(-index -Lbasic), $inboxdir]); +is($?, 0, 'basic index again'); + +my $after = $ibx->over->get_art(1); +is_deeply($after, $orig, 'original unchanged') or note explain([$orig,$after]); + +done_testing; @@ -1,16 +1,17 @@ -# Copyright (C) 2018-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 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 = { @@ -46,10 +47,6 @@ local $ENV{ORIGINAL_RECIPIENT} = 'test@example.com'; ok(run_script(['-mda'], undef, $rdr), 'mda delivered a message'); $ibx = PublicInbox::Inbox->new($ibx); - -if ($V == 1) { - ok(run_script([ '-index', "$tmpdir/inbox" ]), 'v1 indexed'); -} my $msgs = $ibx->over->recent; is(scalar(@$msgs), 1, 'only got one message'); my $eml = $ibx->smsg_eml($msgs->[0]); @@ -92,6 +89,36 @@ is($eml->as_string, $mime->as_string, 'injected message'); $pre = $ibx->search->mset_to_smsg($ibx, $pre); $post = $ibx->search->mset_to_smsg($ibx, $post); is($post->[0]->{blob}, $pre->[0]->{blob}, 'same message in both cases'); + + # git patch-id --stable <t/data/0001.patch | awk '{print $1}' + my $patchid = '91ee6b761fc7f47cad9f2b09b10489f313eb5b71'; + my $mset = $ibx->search->mset("patchid:$patchid"); + 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 12e3fcd0..b8824182 100644 --- a/t/v2mirror.t +++ b/t/v2mirror.t @@ -1,19 +1,20 @@ -# 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 warnings; -use Test::More; +use v5.10.1; use PublicInbox::TestCommon; -use File::Path qw(remove_tree); +use File::Path qw(remove_tree make_path); use Cwd qw(abs_path); +use Carp (); +use PublicInbox::Spawn qw(which); require_git(2.6); +require_cmd('curl'); local $ENV{HOME} = abs_path('t'); +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)); -use IO::Socket; -use POSIX qw(dup2); + HTTP::Date HTTP::Status Xapian DBD::SQLite)); use_ok 'PublicInbox::V2Writable'; use PublicInbox::InboxWritable; use PublicInbox::Eml; @@ -25,7 +26,8 @@ my $pi_config = "$tmpdir/config"; open my $fh, '>', $pi_config or die "open($pi_config): $!"; print $fh <<"" or die "print $pi_config: $!"; [publicinbox "v2"] - inboxdir = $tmpdir/in +; using "mainrepo" rather than "inboxdir" for v1.1.0-pre1 WWW compat below + mainrepo = $tmpdir/in address = test\@example.com close $fh or die "close($pi_config): $!"; @@ -36,6 +38,7 @@ my $cfg = PublicInbox::Config->new($pi_config); my $ibx = $cfg->lookup('test@example.com'); ok($ibx, 'inbox found'); $ibx->{version} = 2; +$ibx->{-no_fsync} = 1; my $v2w = PublicInbox::V2Writable->new($ibx, 1); ok $v2w, 'v2w loaded'; $v2w->{parallel} = 0; @@ -63,21 +66,17 @@ $v2w->done; } $ibx->cleanup; -my $sock = tcp_server(); -my $cmd = [ '-httpd', '-W0', "--stdout=$tmpdir/out", "--stderr=$tmpdir/err" ]; -my $td = start_script($cmd, undef, { 3 => $sock }); -my ($host, $port) = tcp_host_port($sock); -$sock = undef; +local $ENV{TEST_IPV4_ONLY} = 1; # plackup (below) doesn't do IPv6 +my $rdr = { 3 => tcp_server() }; +my @cmd = ('-httpd', '-W0', "--stdout=$tmpdir/out", "--stderr=$tmpdir/err"); +my $td = start_script(\@cmd, undef, $rdr); +my ($host, $port) = tcp_host_port(delete $rdr->{3}); -my @cmd; -foreach my $i (0..$epoch_max) { - my $sfx = $i == 0 ? '.git' : ''; - @cmd = (qw(git clone --mirror -q), - "http://$host:$port/v2/$i$sfx", - "$tmpdir/m/git/$i.git"); +@cmd = (qw(-clone -q), "http://$host:$port/v2/", "$tmpdir/m"); +run_script(\@cmd) or xbail '-clone'; - is(xsys(@cmd), 0, "cloned $i.git"); - ok(-d "$tmpdir/m/git/$i.git", "mirror $i OK"); +for my $i (0..$epoch_max) { + ok(-d "$tmpdir/m/git/$i.git", "epoch $i cloned"); } @cmd = ("-init", '-j1', '-V2', 'm', "$tmpdir/m", 'http://example.com/m', @@ -92,7 +91,6 @@ my $mibx = { inboxdir => "$tmpdir/m", address => 'alt@example.com' }; $mibx = PublicInbox::Inbox->new($mibx); is_deeply([$mibx->mm->minmax], [$ibx->mm->minmax], 'index synched minmax'); -$v2w->{rotate_bytes} = $old_rotate_bytes; for my $i (10..15) { $mime->header_set('Message-ID', "<$i\@example.com>"); $mime->header_set('Subject', "subject = $i"); @@ -101,12 +99,16 @@ for my $i (10..15) { $v2w->done; $ibx->cleanup; +my @new_epochs; my $fetch_each_epoch = sub { - foreach my $i (0..$epoch_max) { - my $dir = "$tmpdir/m/git/$i.git"; - is(xsys('git', "--git-dir=$dir", 'fetch', '-q'), 0, - 'fetch successful'); - } + my %before = map { $_ => 1 } glob("$tmpdir/m/git/*"); + run_script([qw(-fetch --exit-code -q)], undef, {-C => "$tmpdir/m"}) or + xbail('-fetch fail ', + [ xqx([which('find'), "$tmpdir/m", qw(-type f -ls) ]) ], + Carp::longmess()); + is($?, 0, '--exit-code 0 after fetch updated'); + my @after = grep { !$before{$_} } glob("$tmpdir/m/git/*"); + push @new_epochs, @after; }; $fetch_each_epoch->(); @@ -232,10 +234,169 @@ EOF $mset = $mibx->search->reopen->mset('m:2big@a'); is(scalar($mset->items), 0, 'large message not re-indexed'); } +ok(scalar(@new_epochs), 'new epochs were created and fetched'); +for my $d (@new_epochs) { + is(xqx(['git', "--git-dir=$d", 'config', qw(include.path)]), + "../../all.git/config\n", + 'include.path set'); +} + +if ('test read-only epoch dirs') { + my @git = ('git', "--git-dir=$new_epochs[0]"); + my $get_objs = [@git, + qw(cat-file --buffer --batch-check --batch-all-objects)]; + my $before = [sort xqx($get_objs)]; + + remove_tree(map { "$new_epochs[0]/$_" } qw(objects refs/heads)); + chmod(0555, $new_epochs[0]) or xbail "chmod: $!"; + + # force a refetch + unlink("$tmpdir/m/manifest.js.gz") or xbail "unlink: $!"; + + run_script([qw(-fetch -q)], undef, {-C => "$tmpdir/m"}) or + xbail '-fetch failed'; + + ok(!-d "$new_epochs[0]/objects", 'no objects after fetch to R/O dir'); + + chmod(0755, $new_epochs[0]) or xbail "chmod: $!"; + mkdir("$new_epochs[0]/objects") or xbail "mkdir: $!"; + mkdir("$new_epochs[0]/refs/heads") or xbail "mkdir: $!"; + + my $err = ''; + run_script([qw(-fetch -q)], undef, {-C => "$tmpdir/m", 2 => \$err}) or + xbail '-fetch failed '.$err; + is_deeply([ sort xqx($get_objs) ], $before, + 'fetch restored objects once GIT_DIR became writable'); +} + +{ + my $dst = "$tmpdir/partial"; + run_script([qw(-clone -q --epoch=~0), "http://$host:$port/v2/", $dst]); + is($?, 0, 'no error from partial clone'); + my @g = glob("$dst/git/*.git"); + my @w = grep { -w $_ } @g; + my @r = grep { ! -w $_ } @g; + if ($> == 0) { + @w = grep { (stat($_))[2] & 0200 } @g; + @r = grep { !((stat($_))[2] & 0200) } @g; + } + is(scalar(@w), 1, 'one writable directory'); + my ($w) = ($w[0] =~ m!/([0-9]+)\.git\z!); + is((grep { + m!/([0-9]+)\.git\z! or xbail "no digit in $_"; + $w > ($1 + 0) + } @r), scalar(@r), 'writable epoch # exceeds read-only ones'); + run_script([qw(-fetch -q)], undef, { -C => $dst }); + is($?, 0, 'no error from partial fetch'); + remove_tree($dst); -ok($td->kill, 'killed httpd'); -$td->join; + run_script([qw(-clone -q --epoch=~1..), + "http://$host:$port/v2/", $dst]); + my @g2 = glob("$dst/git/*.git") ; + is_deeply(\@g2, \@g, 'cloned again'); + is(scalar(grep { (stat($_))[2] & 0200 } @g2), scalar(@w) + 1, + 'got one more cloned epoch'); -done_testing(); + # make 0.git writable and fetch into it, relies on culled manifest + chmod(0755, $g2[0]) or xbail "chmod: $!"; + my @before = glob("$g2[0]/objects/*/*"); + run_script([qw(-fetch -q)], undef, { -C => $dst }); + is($?, 0, 'no error from partial fetch'); + my @after = glob("$g2[0]/objects/*/*"); + ok(scalar(@before) < scalar(@after), 'fetched after chmod 0755 0.git'); + + # ensure culled manifest is maintained after fetch + gunzip("$dst/manifest.js.gz" => \(my $m), MultiStream => 1) or + xbail "gunzip: $GunzipError"; + $m = PublicInbox::Config->json->decode($m); + for my $k (keys %$m) { # /$name/git/$N.git + my ($nr) = ($k =~ m!/git/([0-9]+)\.git\z!); + ok(-w "$dst/git/$nr.git", "writable $nr.git in manifest"); + } + for my $ro (grep { !-w $_ } @g2) { + my ($nr) = ($ro =~ m!/git/([0-9]+)\.git\z!); + is(grep(m!/git/$nr\.git\z!, keys %$m), 0, + "read-only $nr.git not in manifest") + or xbail([sort keys %$m]); + } +} + +my $err = ''; +my $oldrev = '0b3e19584c90d958a723ac2d3dec3f84f5513688~1'; +# 3e0e596105198cfa (wwwlisting: allow hiding entries from manifest, 2019-06-09) +$oldrev = xqx([qw(git rev-parse), $oldrev], undef, { 2 => \$err }); +SKIP: { + skip("no detected public-inbox GIT_DIR ($err)", 1) if $?; + 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 = 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 = PublicInbox::Lock->new(__FILE__); + $lk->lock_acquire; + my $psgi = "$wt/app.psgi"; + if (!-f $psgi) { # checkout a pre-manifest.js.gz version + my $t = File::Temp->new(TEMPLATE => 'g-XXXX', TMPDIR => 1); + my $env = { GIT_INDEX_FILE => $t->filename }; + xsys([qw(git read-tree), $oldrev], $env) and xbail 'read-tree'; + xsys([qw(git checkout-index -a), "--prefix=$wt/"], $env) + and xbail 'checkout-index'; + my $f = "$wt/app.psgi.tmp.$$"; + open my $fh, '>', $f or xbail $!; + print $fh <<'EOM' or xbail $!; +use Plack::Builder; +use PublicInbox::WWW; +my $www = PublicInbox::WWW->new; +builder { enable 'Head'; sub { $www->call(@_) } } +EOM + close $fh or xbail $!; + rename($f, $psgi) or xbail $!; + } + $lk->lock_release; + + $rdr->{run_mode} = 0; + $rdr->{-C} = $wt; + my $cmd = [$plackup, qw(-Enone -Ilib), "--host=$host", "--port=$port"]; + $td->join('TERM'); + open $rdr->{2}, '>>', "$tmpdir/plackup.err.log" or xbail "open: $!"; + open $rdr->{1}, '>>&', $rdr->{2} or xbail "open: $!"; + my $env = { PERL5LIB => 'lib', PERL_INLINE_DIRECTORY => undef }; + $td = start_script($cmd, $env, $rdr); + # wait for plackup socket()+bind()+listen() + my %opt = ( Proto => 'tcp', Type => Socket::SOCK_STREAM(), + PeerAddr => "$host:$port" ); + 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 = '') }); + is($?, 0, 'scraping clone on old PublicInbox::WWW') + or diag $err; + my @g_all = glob("$dst/git/*.git"); + ok(scalar(@g_all) > 1, 'cloned multiple epochs'); + + remove_tree($dst); + @cmd = (qw(-clone -q --epoch=~0), "http://$host:$port/v2", $dst); + run_script(\@cmd, undef, { 2 => \($err = '') }); + is($?, 0, 'partial scraping clone on old PublicInbox::WWW'); + my @g_last = grep { (stat($_))[2] & 0200 } glob("$dst/git/*.git"); + is_deeply(\@g_last, [ $g_all[-1] ], 'partial clone of ~0 worked'); + + chmod(0755, $g_all[0]) or xbail "chmod $!"; + my @before = glob("$g_all[0]/objects/*/*"); + run_script([qw(-fetch -v)], undef, { -C => $dst, 2 => \($err = '') }); + is($?, 0, 'scraping fetch on old PublicInbox::WWW') or diag $err; + my @after = glob("$g_all[0]/objects/*/*"); + ok(scalar(@before) < scalar(@after), + 'fetched 0.git after enabling write-bit'); + + $td->join('TERM'); +} -1; +done_testing; diff --git a/t/v2reindex.t b/t/v2reindex.t index 05ea952f..8c49e154 100644 --- a/t/v2reindex.t +++ b/t/v2reindex.t @@ -1,14 +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 warnings; -use Test::More; +use strict; use v5.10.1; use PublicInbox::TestCommon; use PublicInbox::Eml; use PublicInbox::ContentHash qw(content_digest); use File::Path qw(remove_tree); -use PublicInbox::TestCommon; 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(); @@ -18,6 +15,7 @@ my $ibx_config = { version => 2, -primary_address => 'test@example.com', indexlevel => 'full', + -no_fsync => 1, }; my $agpl = do { open my $fh, '<', 'COPYING' or die "can't open COPYING: $!"; @@ -543,4 +541,16 @@ EOF $check_rethread->('3-headed-monster once'); $check_rethread->('3-headed-monster twice'); +my $rdr = { 2 => \(my $err = '') }; +my $env = { PI_CONFIG => '/dev/null' }; +ok(run_script([qw(-index --reindex --xapian-only), $inboxdir], $env, $rdr), + '--xapian-only works'); +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 $rdr = { 2 => \(my $null_err) }; + 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 f0fa8a79..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; @@ -17,6 +17,7 @@ my $ibx = { inboxdir => $inboxdir, name => 'test-v2writable', version => 2, + -no_fsync => 1, -primary_address => 'test@example.com', }; $ibx = PublicInbox::Inbox->new($ibx); @@ -148,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'; @@ -282,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', @@ -307,7 +324,7 @@ ok($@, 'V2Writable fails on non-existent dir'); open $fh, '<', $alt or die $!; my $before = do { local $/; <$fh> }; - ok($v2w->git_init(3), 'init a new epoch'); + ok($v2w->{mg}->add_epoch(3), 'init a new epoch'); open $fh, '<', $alt or die $!; my $after = do { local $/; <$fh> }; ok(index($after, $before) > 0, diff --git a/t/watch_filter_rubylang.t b/t/watch_filter_rubylang.t index 29a9f793..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,17 +22,13 @@ 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"; my $addr = "test-$v\@example.com"; - my @cmd = ('-init', "-$v", $v, $inboxdir, + my @cmd = ('-init', '-Lfull', "-$v", $v, $inboxdir, "http://example.com/$v", $addr); - ok(run_script(\@cmd), 'public-inbox init OK'); - if ($v eq 'V1') { - ok(run_script(['-index', $inboxdir]), 'v1 indexed'); - } + ok(run_script(\@cmd), 'public-inbox init'); PublicInbox::Emergency->new($spamdir); for my $i (1..15) { @@ -63,17 +56,18 @@ 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'); my $w = PublicInbox::Watch->new($cfg); @@ -101,8 +95,12 @@ 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'); is_deeply([], \@warn, 'no warnings'); 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 e74b512f..a12ceefd 100644 --- a/t/watch_maildir.t +++ b/t/watch_maildir.t @@ -1,22 +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 @@ -26,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'); @@ -34,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 @@ -57,14 +58,15 @@ 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(qw(rev-list refs/heads/master)); +my @list = $git->qx('rev-list', $default_branch); is(scalar @list, 1, 'one revision in rev-list'); my $write_spam = sub { @@ -80,12 +82,16 @@ my $write_spam = sub { $write_spam->(); is(unlink(glob("$maildir/new/*")), 1, 'unlinked old spam'); PublicInbox::Watch->new($cfg)->scan('full'); -@list = $git->qx(qw(rev-list refs/heads/master)); +@list = $git->qx('rev-list', $default_branch); is(scalar @list, 2, 'two revisions in rev-list'); -@list = $git->qx(qw(ls-tree -r --name-only refs/heads/master)); +@list = $git->qx('ls-tree', '-r', '--name-only', $default_branch); 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(-- @@ -94,17 +100,18 @@ the body of a message to majordomo\@vger.kernel.org More majordomo info at http://vger.kernel.org/majordomo-info.html\n); PublicInbox::Emergency->new($maildir)->prepare(\$msg); PublicInbox::Watch->new($cfg)->scan('full'); - @list = $git->qx(qw(ls-tree -r --name-only refs/heads/master)); + @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'); is(unlink(glob("$maildir/new/*")), 1, 'unlinked spam'); $write_spam->(); PublicInbox::Watch->new($cfg)->scan('full'); - @list = $git->qx(qw(ls-tree -r --name-only refs/heads/master)); + @list = $git->qx('ls-tree', '-r', '--name-only', $default_branch); is(scalar @list, 0, 'tree is empty'); - @list = $git->qx(qw(rev-list refs/heads/master)); + @list = $git->qx('rev-list', $default_branch); is(scalar @list, 4, 'four revisions in rev-list'); is(unlink(glob("$spamdir/cur/*")), 1, 'unlinked trained spam'); } @@ -120,7 +127,7 @@ More majordomo info at http://vger.kernel.org/majordomo-info.html\n); local $SIG{__WARN__} = sub {}; # quiet spam check warning PublicInbox::Watch->new($cfg)->scan('full'); } - @list = $git->qx(qw(ls-tree -r --name-only refs/heads/master)); + @list = $git->qx('ls-tree', '-r', '--name-only', $default_branch); is(scalar @list, 0, 'tree has no files spamc checked'); is(unlink(glob("$maildir/new/*")), 1); } @@ -132,16 +139,13 @@ More majordomo info at http://vger.kernel.org/majordomo-info.html\n); local $ENV{PATH} = $main_path; PublicInbox::Emergency->new($maildir)->prepare(\$msg); $cfg->{'publicinboxwatch.spamcheck'} = 'spamc'; - @list = $git->qx(qw(ls-tree -r --name-only refs/heads/master)); + @list = $git->qx('ls-tree', '-r', '--name-only', $default_branch); PublicInbox::Watch->new($cfg)->scan('full'); - @list = $git->qx(qw(ls-tree -r --name-only refs/heads/master)); + @list = $git->qx('ls-tree', '-r', '--name-only', $default_branch); is(scalar @list, 1, 'tree has one file after spamc checked'); + chomp(@list); - # 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); - - my $mref = $git->cat_file('refs/heads/master:'.$list[0]); + my $mref = $git->cat_file($default_branch.':'.$list[0]); like($$mref, qr/something\n\z/s, 'message scrubbed on import'); } @@ -150,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); @@ -169,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 { @@ -199,14 +208,33 @@ 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->EventLoop; + 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 195e238b..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,15 +36,18 @@ 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; PublicInbox::Watch->new($cfg)->scan('full'); my $total = scalar @{$ibx->over->recent}; @@ -146,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 @@ -184,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 784acc8b..7ad4a1d2 100644 --- a/t/www_altid.t +++ b/t/www_altid.t @@ -1,56 +1,46 @@ -# 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 PublicInbox::TestCommon; -use PublicInbox::Inbox; -use PublicInbox::InboxWritable; +use strict; use v5.10.1; use PublicInbox::TestCommon; use PublicInbox::Config; -use PublicInbox::Spawn qw(which spawn); -which('sqlite3') or plan skip_all => 'sqlite3 binary missing'; +use PublicInbox::Spawn qw(spawn); +require_cmd('sqlite3'); require_mods(qw(DBD::SQLite HTTP::Request::Common Plack::Test URI::Escape - Plack::Builder IO::Uncompress::Gunzip)); + Plack::Builder IO::Uncompress::Gunzip Xapian)); use_ok($_) for qw(Plack::Test HTTP::Request::Common); require_ok 'PublicInbox::Msgmap'; require_ok 'PublicInbox::AltId'; require_ok 'PublicInbox::WWW'; -my ($inboxdir, $for_destroy) = tmpdir(); +my ($tmpdir, $for_destroy) = tmpdir(); my $aid = 'xyz'; +my $cfgpath; my $spec = "serial:$aid:file=blah.sqlite3"; -if ('setup') { - my $opts = { - inboxdir => $inboxdir, - name => 'test', - -primary_address => 'test@example.com', - }; - my $ibx = PublicInbox::Inbox->new($opts); - $ibx = PublicInbox::InboxWritable->new($ibx, 1); - my $im = $ibx->importer(0); - my $mime = PublicInbox::Eml->new(<<'EOF'); -From: a@example.com -Message-Id: <a@example.com> - -EOF - $im->add($mime); - $im->done; - mkdir "$inboxdir/public-inbox" or die; +my $ibx = create_inbox 'test-altid', indexlevel => 'medium', + altid => [ $spec ], sub { + my ($im, $ibx) = @_; my $altid = PublicInbox::AltId->new($ibx, $spec, 1); $altid->mm_alt->mid_set(1, 'a@example.com'); -} - -my $cfgpath = "$inboxdir/cfg"; -open my $fh, '>', $cfgpath or die; -print $fh <<EOF or die; + undef $altid; + $cfgpath = "$ibx->{inboxdir}/cfg"; + open my $fh, '>', $cfgpath or BAIL_OUT "open $cfgpath: $!"; + print $fh <<EOF or BAIL_OUT $!; [publicinbox "test"] - inboxdir = $inboxdir - address = test\@example.com + inboxdir = $ibx->{inboxdir} + address = $ibx->{-primary_address} altid = $spec url = http://example.com/test EOF -close $fh or die; + close $fh or BAIL_OUT $!; + $im->add(PublicInbox::Eml->new(<<'EOF')) or BAIL_OUT; +From: a@example.com +Message-Id: <a@example.com> + +EOF +}; +$cfgpath //= "$ibx->{inboxdir}/cfg"; my $cfg = PublicInbox::Config->new($cfgpath); my $www = PublicInbox::WWW->new($cfg); -my $cmpfile = "$inboxdir/cmp.sqlite3"; +my $cmpfile = "$tmpdir/cmp.sqlite3"; my $client = sub { my ($cb) = @_; my $res = $cb->(POST("/test/$aid.sql.gz")); @@ -67,17 +57,15 @@ my $client = sub { is($mm_cmp->mid_for(1), 'a@example.com', 'sqlite3 dump valid'); $mm_cmp = undef; unlink $cmpfile or die; + + $res = $cb->(GET('/test/?q=xyz:1')); + is $res->code, 200, 'altid search hit'; + $res = $cb->(GET('/test/?q=xyz:10')); + is $res->code, 404, 'altid search miss'; }; 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 { "$inboxdir/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 6a2892de..0a4c79e8 100644 --- a/t/www_listing.t +++ b/t/www_listing.t @@ -1,14 +1,12 @@ -# Copyright (C) 2019-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> # manifest.js.gz generation and grok-pull integration test -use strict; -use warnings; -use Test::More; -use PublicInbox::Spawn qw(which); -use PublicInbox::TestCommon; +use v5.12; use PublicInbox::TestCommon; use PublicInbox::Import; -require_mods(qw(json URI::Escape Plack::Builder Digest::SHA - IO::Compress::Gzip IO::Uncompress::Gunzip HTTP::Tiny)); +use IO::Uncompress::Gunzip qw(gunzip); +require_mods(qw(json URI::Escape Plack::Builder HTTP::Tiny)); +require_cmd 'curl'; require PublicInbox::WwwListing; require PublicInbox::ManifestJsGz; use PublicInbox::Config; @@ -32,27 +30,29 @@ like($bare->manifest_entry->{fingerprint}, qr/\A[a-f0-9]{40}\z/, 'got fingerprint with non-empty repo'); sub tiny_test { - my ($json, $host, $port) = @_; - my $tmp; + my ($json, $host, $port, $html) = @_; + my ($tmp, $res); my $http = HTTP::Tiny->new; - my $res = $http->get("http://$host:$port/"); - is($res->{status}, 200, 'got HTML listing'); - like($res->{content}, qr!</html>!si, 'listing looks like HTML'); - - $res = $http->get("http://$host:$port/", {'Accept-Encoding'=>'gzip'}); - is($res->{status}, 200, 'got gzipped HTML listing'); - IO::Uncompress::Gunzip::gunzip(\(delete $res->{content}) => \$tmp); - like($tmp, qr!</html>!si, 'unzipped listing looks like HTML'); + if ($html) { + $res = $http->get("http://$host:$port/"); + is($res->{status}, 200, 'got HTML listing'); + like($res->{content}, qr!</html>!si, 'listing looks like HTML'); + $res = $http->get("http://$host:$port/", + {'Accept-Encoding'=>'gzip'}); + is($res->{status}, 200, 'got gzipped HTML listing'); + gunzip(\(delete $res->{content}) => \$tmp); + like($tmp, qr!</html>!si, 'unzipped listing looks like HTML'); + } $res = $http->get("http://$host:$port/manifest.js.gz"); is($res->{status}, 200, 'got manifest'); - IO::Uncompress::Gunzip::gunzip(\(delete $res->{content}) => \$tmp); + gunzip(\(delete $res->{content}) => \$tmp); unlike($tmp, qr/"modified":\s*"/, 'modified is an integer'); my $manifest = $json->decode($tmp); ok(my $clone = $manifest->{'/alt'}, '/alt in manifest'); is($clone->{owner}, "lorelei \x{100}", 'owner set'); is($clone->{reference}, '/bare', 'reference detected'); - is($clone->{description}, "we're all clones", 'description read'); + is($clone->{description}, "we're \x{100}ll clones", 'description read'); ok(my $bare = $manifest->{'/bare'}, '/bare in manifest'); is($bare->{description}, 'Unnamed repository', 'missing $GIT_DIR/description fallback'); @@ -69,10 +69,15 @@ sub tiny_test { ok(my $v2epoch1 = $manifest->{'/v2/git/1.git'}, 'v2 epoch 1 appeared'); like($v2epoch1->{description}, qr/ \[epoch 1\]\z/, 'epoch 1 in description'); + + $res = $http->get("http://$host:$port/alt/description"); + is($res->{content}, "we're \xc4\x80ll clones\n", 'UTF-8 description') + or diag explain($res); } my $td; SKIP: { + require_git_http_backend 1; my $err = "$tmpdir/stderr.log"; my $out = "$tmpdir/stdout.log"; my $alt = "$tmpdir/alt.git"; @@ -88,17 +93,19 @@ 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, '>', "$alt/description" or die; - print $fh "we're all clones\n" or die; - close $fh or die; + 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 $!"; is(xsys('git', "--git-dir=$alt", qw(config gitweb.owner), "lorelei \xc4\x80"), 0, 'set gitweb user'); - ok(unlink("$bare->{git_dir}/description"), 'removed bare/description'); - open $fh, '>', $cfgfile or die; - print $fh <<"" or die; -[publicinbox] - wwwlisting = all + open $fh, '>', $cfgfile or xbail "open $cfgfile: $!"; + $fh->autoflush(1); + print $fh <<"" or xbail "print $!"; [publicinbox "bare"] inboxdir = $bare->{git_dir} url = http://$host/bare @@ -112,35 +119,111 @@ SKIP: { url = http://$host/v2 address = v2\@example.com - close $fh or die; 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 }); - $sock = undef; + # default publicinboxGrokManifest match=domain default tiny_test($json, $host, $port); - my $grok_pull = which('grok-pull') or + # 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 $!"; +[publicinbox] + wwwlisting = all + + close $fh or xbail "close $!"; + $td = start_script($cmd, $env, { 3 => $sock }); + 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); my ($grok_version) = (xqx([$grok_pull, "--version"]) =~ /(\d+)\.(?:\d+)(?:\.(\d+))?/); $grok_version >= 2 or skip('grok-pull v2 or later not available', 12); + my $grok_loglevel = $ENV{TEST_GROK_LOGLEVEL} // 'info'; ok(mkdir("$tmpdir/mirror"), 'prepare grok mirror dest'); - open $fh, '>', "$tmpdir/repos.conf" or die; - print $fh <<"" or die; + my $tail = tail_f("$tmpdir/grok.log"); + open $fh, '>', "$tmpdir/repos.conf" or xbail $!; + print $fh <<"" or xbail $!; [core] toplevel = $tmpdir/mirror manifest = $tmpdir/local-manifest.js.gz +log = $tmpdir/grok.log +loglevel = $grok_loglevel [remote] site = http://$host:$port manifest = \${site}/manifest.js.gz [pull] [fsck] - close $fh or die; - + close $fh or xbail $!; xsys($grok_pull, '-c', "$tmpdir/repos.conf"); is($? >> 8, 0, 'grok-pull exit code as expected'); for (qw(alt bare v2/git/0.git v2/git/1.git v2/git/2.git)) { @@ -149,24 +232,33 @@ manifest = \${site}/manifest.js.gz # support per-inbox manifests, handy for v2: # /$INBOX/v2/manifest.js.gz - open $fh, '>', "$tmpdir/per-inbox.conf" or die; - print $fh <<"" or die; + open $fh, '>', "$tmpdir/per-inbox.conf" or xbail $!; + print $fh <<"" or xbail $!; [core] toplevel = $tmpdir/per-inbox manifest = $tmpdir/per-inbox-manifest.js.gz +log = $tmpdir/grok.log +loglevel = $grok_loglevel [remote] site = http://$host:$port manifest = \${site}/v2/manifest.js.gz [pull] [fsck] - close $fh or die; + close $fh or xbail $!; ok(mkdir("$tmpdir/per-inbox"), 'prepare single-v2-inbox mirror'); xsys($grok_pull, '-c', "$tmpdir/per-inbox.conf"); is($? >> 8, 0, 'grok-pull exit code as expected'); for (qw(v2/git/0.git v2/git/1.git v2/git/2.git)) { ok(-d "$tmpdir/per-inbox/$_", "grok-pull created $_"); } + $td->kill; + $td->join; + is($?, 0, 'no error in exited process'); + open $fh, '<', $err or BAIL_OUT("open $err failed: $!"); + my $eout = do { local $/; <$fh> }; + unlike($eout, qr/wide/i, 'no Wide character warnings'); + unlike($eout, qr/uninitialized/i, 'no uninitialized warnings'); } done_testing(); 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 1b726f1a..7797aaaf 100644 --- a/t/xcpdb-reshard.t +++ b/t/xcpdb-reshard.t @@ -1,52 +1,50 @@ +#!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> use strict; -use warnings; -use Test::More; +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; -use PublicInbox::InboxWritable; require PublicInbox::Search; -my $mime = PublicInbox::Eml->new(<<'EOF'); +my ($tmpdir, $for_destroy) = tmpdir(); +my $nproc = 8; +my $ndoc = 13; +my $ibx = create_inbox 'test', version => 2, indexlevel => 'medium', + tmpdir => "$tmpdir/testbox", nproc => $nproc, sub { + my ($im, $ibx) = @_; + my $eml = PublicInbox::Eml->new(<<'EOF'); From: a@example.com To: test@example.com Subject: this is a subject Date: Fri, 02 Oct 1993 00:00:00 +0000 EOF -my ($this) = (split('/', $0))[-1]; -my ($tmpdir, $for_destroy) = tmpdir(); -local $ENV{PI_CONFIG} = "$tmpdir/config"; -my $ibx = PublicInbox::Inbox->new({ - inboxdir => "$tmpdir/testbox", - name => $this, - version => 2, - -primary_address => 'test@example.com', - indexlevel => 'medium', -}); -my @xcpdb = qw(-xcpdb -q); -my $nproc = 8; -my $ndoc = 13; -my $im = PublicInbox::InboxWritable->new($ibx, {nproc => $nproc})->importer; -for my $i (1..$ndoc) { - $mime->header_set('Message-ID', "<m$i\@example.com>"); - ok($im->add($mime), "message $i added"); -} -$im->done; + for my $i (1..$ndoc) { + $eml->header_set('Message-ID', "<m$i\@example.com>"); + ok($im->add($eml), "message $i added"); + } + open my $fh, '>', "$ibx->{inboxdir}/empty" or BAIL_OUT "open $!"; +}; +my $env = { PI_CONFIG => "$ibx->{inboxdir}/empty" }; my @shards = grep(m!/\d+\z!, glob("$ibx->{inboxdir}/xap*/*")); is(scalar(@shards), $nproc - 1, 'got expected shards'); my $orig = $ibx->over->query_xover(1, $ndoc); my %nums = map {; "$_->{num}" => 1 } @$orig; +my @xcpdb = qw(-xcpdb -q); +my $XapianDatabase = do { + no warnings 'once'; + $PublicInbox::Search::X{Database}; +}; # ensure we can go up or down in shards, or stay the same: 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; - ok(run_script($cmd), "xcpdb -R$R"); + 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'); my $mset = $ibx->search->mset('s:this'); @@ -60,10 +58,6 @@ for my $R (qw(2 4 1 3 3)) { # ensure docids in Xapian match NNTP article numbers my $tot = 0; my %tmp = %nums; - my $XapianDatabase = do { - no warnings 'once'; - $PublicInbox::Search::X{Database}; - }; foreach my $d (@new_shards) { my $xdb = $XapianDatabase->new($d); $tot += $xdb->get_doccount; @@ -78,6 +72,4 @@ for my $R (qw(2 4 1 3 3)) { } is(scalar keys %tmp, 0, 'all docids seen'); } - -done_testing(); -1; +done_testing; |