diff options
Diffstat (limited to 't')
194 files changed, 11925 insertions, 2693 deletions
diff --git a/t/address.t b/t/address.t index 6f4bff6c..86f47395 100644 --- a/t/address.t +++ b/t/address.t @@ -1,32 +1,59 @@ -# Copyright (C) 2016-2020 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'; sub test_pkg { my ($pkg) = @_; - my $emails = \&{"${pkg}::emails"}; - my $names = \&{"${pkg}::names"}; + 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')], 'address extraction works as expected'); + is_deeply($pairs->('User <e@example.com>, e@example.org'), + [[qw(User e@example.com)], [undef, 'e@example.org']], + "pair extraction works ($pkg)"); + is_deeply(['user@example.com'], [$emails->('<user@example.com (Comment)>')], 'comment after domain accepted before >'); + is_deeply($pairs->('<user@example.com (Comment)>'), + [[qw(Comment user@example.com)]], "comment as name ($pkg)"); - my @names = $names->( - 'User <e@e>, e@e, "John A. Doe" <j@d>, <x@x>, <y@x> (xyz), '. - 'U Ser <u@x> (do not use)'); + my $s = 'User <e@e>, e@e, "John A. Doe" <j@d>, <x@x>, <y@x> (xyz), '. + 'U Ser <u@x> (do not use)'; + my @names = $names->($s); is_deeply(\@names, ['User', 'e', 'John A. Doe', 'x', 'xyz', 'U Ser'], 'name extraction works as expected'); + is_deeply($pairs->($s), [ [ 'User', 'e@e' ], [ undef, 'e@e' ], + [ 'John A. Doe', 'j@d' ], [ undef, 'x@x' ], + [ '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'); + is_deeply($pairs->('"user@example.com" <user@example.com>'), + [ [ 'user@example.com', 'user@example.com' ] ], + "pairs for $pkg"); { my $backwards = 'u@example.com (John Q. Public)'; @@ -34,15 +61,26 @@ sub test_pkg { is_deeply(\@names, ['John Q. Public'], 'backwards name OK'); my @emails = $emails->($backwards); is_deeply(\@emails, ['u@example.com'], 'backwards emails OK'); + + is_deeply($pairs->($backwards), + [ [ 'John Q. Public', 'u@example.com' ] ], + "backwards pairs $pkg"); } - @names = $names->('"Quote Unneeded" <user@example.com>'); + $s = '"Quote Unneeded" <user@example.com>'; + @names = $names->($s); is_deeply(['Quote Unneeded'], \@names, 'extra quotes dropped'); + is_deeply($pairs->($s), [ [ 'Quote Unneeded', 'user@example.com' ] ], + "extra quotes dropped in pairs $pkg"); my @emails = $emails->('Local User <user>'); 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,28 +1,51 @@ -# Copyright (C) 2019-2020 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', qw(resolve_repo_dir); +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; + }; +}; + +*resolve_inboxdir = \&PublicInbox::Admin::resolve_inboxdir; +*resolve_git_dir = \&PublicInbox::Admin::resolve_git_dir; -PublicInbox::Import::init_bare($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_repo_dir($git_dir), $git_dir, 'top-level GIT_DIR resolved'); -is(resolve_repo_dir("$git_dir/objects"), $git_dir, 'GIT_DIR/objects resolved'); +is(resolve_inboxdir($git_dir), $git_dir, 'top-level GIT_DIR resolved'); +is(resolve_inboxdir("$git_dir/objects"), $git_dir, 'GIT_DIR/objects resolved'); ok(chdir($git_dir), 'chdir GIT_DIR works'); -is(resolve_repo_dir(), $git_dir, 'resolve_repo_dir works in GIT_DIR'); +is(resolve_inboxdir(), $git_dir, 'resolve_inboxdir works in GIT_DIR'); ok(chdir("$git_dir/objects"), 'chdir GIT_DIR/objects works'); -is(resolve_repo_dir(), $git_dir, 'resolve_repo_dir works in GIT_DIR'); -$res = resolve_repo_dir(undef, \$v); +is(resolve_inboxdir(), $git_dir, 'resolve_inboxdir works in GIT_DIR'); +$res = resolve_inboxdir(undef, \$v); is($v, 1, 'version 1 detected'); is($res, $git_dir, 'detects directory along with version'); @@ -36,13 +59,13 @@ SKIP: { ok(chdir($no_vcs_dir), 'chdir to a non-inbox'); open STDERR, '>&', $null or die "redirect stderr to /dev/null: $!"; - $res = eval { resolve_repo_dir() }; + $res = eval { resolve_inboxdir() }; open STDERR, '>&', $olderr or die "restore stderr: $!"; is($res, undef, 'fails inside non-version-controlled dir'); ok(chdir($tmpdir), 'back to test-specific $tmpdir'); open STDERR, '>&', $null or die "redirect stderr to /dev/null: $!"; - $res = eval { resolve_repo_dir($no_vcs_dir) }; + $res = eval { resolve_inboxdir($no_vcs_dir) }; $err = $@; open STDERR, '>&', $olderr or die "restore stderr: $!"; is($res, undef, 'fails on non-version-controlled dir'); @@ -50,34 +73,26 @@ 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'); - is(resolve_repo_dir($v2_dir), $v2_dir, - 'resolve_repo_dir works on v2_dir'); - ok(chdir($v2_dir), 'chdir v2_dir OK'); - is(resolve_repo_dir(), $v2_dir, 'resolve_repo_dir works inside v2_dir'); - $res = resolve_repo_dir(undef, \$v); +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: $!"; + is(resolve_inboxdir(), $v2_dir, 'resolve_inboxdir works inside v2_dir'); + $res = resolve_inboxdir(undef, \$v); is($v, 2, 'version 2 detected'); is($res, $v2_dir, 'detects directory along with version'); # TODO: should work from inside Xapian dirs, and git dirs, here... + 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'); + chdir($objdir) or BAIL_OUT "chdir objdir: $!"; + is(resolve_inboxdir(undef, \$v), $v2_dir, 'inside $objdir'); + is($v, 2, 'version 2 detected inside $objdir'); } -chdir '/'; +chdir '/' or BAIL_OUT "chdir: $!"; my @pairs = ( '1g' => 1024 ** 3, 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 @@ -# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org> +#!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 f04b547b..6bc90453 100644 --- a/t/altid_v2.t +++ b/t/altid_v2.t @@ -1,37 +1,23 @@ -# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org> +#!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; @@ -1,71 +1,38 @@ -# Copyright (C) 2014-2020 all contributors <meta@public-inbox.org> +#!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> -# FIXME: this test is too slow and most non-CGI-requirements -# should be moved over to things which use test_psgi use strict; -use warnings; -use Test::More; -use PublicInbox::Eml; +use v5.10.1; use PublicInbox::TestCommon; -use PublicInbox::Import; -require_mods(qw(Plack::Handler::CGI Plack::Util)); +use IO::Uncompress::Gunzip qw(gunzip); +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'; - -{ - is(1, mkdir($home, 0755), "setup ~/ for testing"); - is(1, mkdir($pi_home, 0755), "setup ~/.public-inbox"); - PublicInbox::Import::init_bare($maindir); - - open my $fh, '>', "$maindir/description" or die "open: $!\n"; - print $fh "test for public-inbox\n"; - close $fh or die "close: $!\n"; - open $fh, '>>', $pi_config or die; - print $fh <<EOF or die; -[publicinbox "test"] - address = $addr - inboxdir = $maindir - indexlevel = basic -EOF - close $fh or die "close: $!\n"; -} - -use_ok 'PublicInbox::Inbox'; -use_ok 'PublicInbox::InboxWritable'; -use_ok 'PublicInbox::Config'; -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_str_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 @@ -76,46 +43,54 @@ 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"); } # retrieve thread as an mbox -{ +SKIP: { local $ENV{HOME} = $home; my $path = "/test/blahblah\@example.com/t.mbox.gz"; 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) { $res = cgi_run($path); like($res->{head}, qr/^Status: 200 /, "search returned mbox"); - eval { - require IO::Uncompress::Gunzip; - my $in = $res->{body}; - my $out; - IO::Uncompress::Gunzip::gunzip(\$in => \$out); - like($out, qr/^From /m, "From lines in mbox"); - }; + my $in = $res->{body}; + my $out; + gunzip(\$in => \$out); + like($out, qr/^From /m, "From lines in mbox"); $res = cgi_run('/test/toobig@example.com/'); like($res->{head}, qr/^Status: 300 /, 'did not index or return >max-size message'); @@ -123,29 +98,24 @@ EOF 'warned about skipping large OID'); } else { like($res->{head}, qr/^Status: 501 /, "search not available"); - SKIP: { skip 'DBD::SQLite not available', 4 }; - } - - my $have_xml_treepp = eval { require XML::TreePP; 1 } if $indexed; - if ($have_xml_treepp) { - $path = "/test/blahblah\@example.com/t.atom"; - $res = cgi_run($path); - like($res->{head}, qr/^Status: 200 /, "atom returned 200"); - like($res->{head}, qr!^Content-Type: application/atom\+xml!m, - "search returned atom"); - my $t = XML::TreePP->new->parse($res->{body}); - is(scalar @{$t->{feed}->{entry}}, 3, "parsed three entries"); - like($t->{feed}->{-xmlns}, qr/\bAtom\b/, - 'looks like an an Atom feed'); - } else { - SKIP: { skip 'DBD::SQLite or XML::TreePP missing', 2 }; + skip('DBD::SQLite not available', 7); # (4 - 1) above, 4 below } + require_mods('XML::TreePP', 4); + $path = "/test/blahblah\@example.com/t.atom"; + $res = cgi_run($path); + like($res->{head}, qr/^Status: 200 /, "atom returned 200"); + like($res->{head}, qr!^Content-Type: application/atom\+xml!m, + "search returned atom"); + my $t = XML::TreePP->new->parse($res->{body}); + is(scalar @{$t->{feed}->{entry}}, 3, "parsed three entries"); + like($t->{feed}->{-xmlns}, qr/\bAtom\b/, + 'looks like an an Atom feed'); } done_testing(); sub cgi_run { - my %env = ( + my $env = { PATH_INFO => $_[0], QUERY_STRING => $_[1] || "", SCRIPT_NAME => '', @@ -154,11 +124,11 @@ sub cgi_run { GATEWAY_INTERFACE => 'CGI/1.1', HTTP_ACCEPT => '*/*', HTTP_HOST => 'test.example.com', - ); + }; my ($in, $out, $err) = ("", "", ""); my $rdr = { 0 => \$in, 1 => \$out, 2 => \$err }; - run_script(['.cgi'], \%env, $rdr); - die "unexpected error: \$?=$? ($err)" if $?; + run_script(['.cgi'], $env, $rdr); + fail "unexpected error: \$?=$? ($err)" if $?; my ($head, $body) = split(/\r\n\r\n/, $out, 2); { head => $head, body => $body, err => $err } } diff --git a/t/check-www-inbox.perl b/t/check-www-inbox.perl index dc463ea8..46f9ce1e 100644 --- a/t/check-www-inbox.perl +++ b/t/check-www-inbox.perl @@ -1,5 +1,5 @@ #!/usr/bin/perl -w -# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org> +# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> # Parallel WWW checker my $usage = "$0 [-j JOBS] [-s SLOW_THRESHOLD] URL_OF_INBOX\n"; @@ -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 new file mode 100644 index 00000000..c973c6f0 --- /dev/null +++ b/t/cmd_ipc.t @@ -0,0 +1,155 @@ +#!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; +use Socket qw(AF_UNIX SOCK_STREAM SOCK_SEQPACKET); +pipe(my $r, my $w); +my ($send, $recv); +require_ok 'PublicInbox::Spawn'; +require POSIX; + +my $do_test = sub { SKIP: { + my ($type, $flag, $desc) = @_; + my ($s1, $s2); + my $src = 'some payload' x 40; + 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); + is($buf, $src, 'got buffer payload '.$desc); + my ($r1, $w1, $s1a); + my $opens = sub { + ok(open($r1, '<&=', $fds[0]), 'opened received $r'); + ok(open($w1, '>&=', $fds[1]), 'opened received $w'); + ok(open($s1a, '+>&=', $fds[2]), 'opened received $s1'); + }; + $opens->(); + my @exp = stat $r; + my @cur = stat $r1; + is("$exp[0]\0$exp[1]", "$cur[0]\0$cur[1]", '$r dev/ino matches'); + @exp = stat $w; + @cur = stat $w1; + is("$exp[0]\0$exp[1]", "$cur[0]\0$cur[1]", '$w dev/ino matches'); + @exp = stat $s1; + @cur = stat $s1a; + is("$exp[0]\0$exp[1]", "$cur[0]\0$cur[1]", '$s1 dev/ino matches'); + if ($type == SOCK_SEQPACKET) { + $r1 = $w1 = $s1a = undef; + $src = (',' x 1023) . '-' .('.' x 1024); + $send->($s1, $sfds, $src, $flag); + (@fds) = $recv->($s2, $buf, 1024); + is($buf, (',' x 1023) . '-', 'silently truncated buf'); + $opens->(); + $r1 = $w1 = $s1a = undef; + + $s2->blocking(0); + @fds = $recv->($s2, $buf, length($src) + 1); + ok($!{EAGAIN}, "EAGAIN set by ($desc)"); + is($buf, '', "recv buffer emptied on EAGAIN ($desc)"); + is_deeply(\@fds, [ undef ], "EAGAIN $desc"); + $s2->blocking(1); + + if ('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'); + } + + @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); + $s1->blocking(0); + my $nsent = 0; + my $srclen = length($src); + while (defined(my $n = $send->($s1, $sfds, $src, $flag))) { + $nsent += $n; + fail "sent $n bytes of $srclen" if $srclen != $n; + } + 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); + is($send->($s1, [], $src, $flag), length($src), 'sent w/o FDs'); + $buf = 'nope'; + @fds = $recv->($s2, $buf, length($src)); + is(scalar(@fds), 0, 'no FDs received'); + is($buf, $src, 'recv w/o FDs'); + + my $nr = 2 * 1024 * 1024; + while (1) { + vec(my $vec = '', $nr - 1, 8) = 1; + my $n = $send->($s1, [], $vec, $flag); + if (defined($n)) { + $n == length($vec) or + fail "short send: $n != ".length($vec); + diag "sent $nr, retrying with more"; + $nr += 2 * 1024 * 1024; + } else { + ok($!{EMSGSIZE} || $!{ENOBUFS}, + 'got EMSGSIZE or ENOBUFS') or + diag "$nr bytes fails with: $!"; + last; + } + } + } +} }; + +my $send_ic = PublicInbox::Spawn->can('send_cmd4'); +my $recv_ic = PublicInbox::Spawn->can('recv_cmd4'); +SKIP: { + ($send_ic && $recv_ic) or skip 'Inline::C not installed/enabled', 12; + $send = $send_ic; + $recv = $recv_ic; + $do_test->(SOCK_STREAM, 0, 'Inline::C stream'); + $do_test->(SOCK_SEQPACKET, 0, 'Inline::C seqpacket'); +} + +SKIP: { + require_mods('Socket::MsgHdr', 13); + require_ok 'PublicInbox::CmdIPC4'; + $send = PublicInbox::CmdIPC4->can('send_cmd4'); + $recv = PublicInbox::CmdIPC4->can('recv_cmd4'); + $do_test->(SOCK_STREAM, 0, 'MsgHdr stream'); + $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'); + } +} + +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-2020 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); @@ -41,9 +60,7 @@ my ($tmpdir, $for_destroy) = tmpdir(); 'url' => [ 'http://example.com/meta' ], -primary_address => 'meta@public-inbox.org', 'name' => 'meta', - feedmax => 25, -httpbackend_limiter => undef, - nntpserver => undef, }, "lookup matches expected output"); is($cfg->lookup('blah@example.com'), undef, @@ -58,37 +75,37 @@ my ($tmpdir, $for_destroy) = tmpdir(); 'inboxdir' => '/home/pi/test-main.git', 'domain' => 'public-inbox.org', 'name' => 'test', - feedmax => 25, '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', @@ -96,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, @@ -161,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 @@ -177,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"); } { @@ -200,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'); } @@ -236,21 +267,70 @@ EOF } SKIP: { - 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 $!; -[imap "imap://*.example.com"] + # XXX wildcard match requires git 2.26+ + 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 0da8903d..f4d99080 100644 --- a/t/config_limiter.t +++ b/t/config_limiter.t @@ -1,15 +1,14 @@ -# Copyright (C) 2016-2020 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/content_hash.t b/t/content_hash.t index 646aab07..060665f6 100644 --- a/t/content_hash.t +++ b/t/content_hash.t @@ -1,7 +1,8 @@ -# Copyright (C) 2018-2020 all contributors <meta@public-inbox.org> +#!perl -w +# Copyright (C) 2018-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 v5.10.1; use Test::More; use PublicInbox::ContentHash qw(content_hash); use PublicInbox::Eml; @@ -19,6 +20,17 @@ EOF my $orig = content_hash($mime); my $reload = content_hash(PublicInbox::Eml->new($mime->as_string)); is($orig, $reload, 'content_hash matches after serialization'); +{ + my $s1 = PublicInbox::Eml->new($mime->as_string); + $s1->header_set('Sender', 's@example.com'); + is(content_hash($s1), $orig, "Sender ignored when 'From' present"); + my $s2 = PublicInbox::Eml->new($s1->as_string); + $s1->header_set('Sender', 'sender@example.com'); + is(content_hash($s2), $orig, "Sender really ignored 'From'"); + $_->header_set('From') for ($s1, $s2); + isnt(content_hash($s1), content_hash($s2), + 'sender accounted when From missing'); +} foreach my $h (qw(From To Cc)) { my $n = q("Quoted N'Ame" <foo@EXAMPLE.com>); diff --git a/t/convert-compact.t b/t/convert-compact.t index e479476d..b123f17b 100644 --- a/t/convert-compact.t +++ b/t/convert-compact.t @@ -1,31 +1,27 @@ -# Copyright (C) 2018-2020 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'); -ok(PublicInbox::Import::run_die([qw(git) , "--git-dir=$ibx->{inboxdir}", - qw(config core.sharedRepository 0644)]), 'set sharedRepository'); -$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/data/message_embed.eml b/t/data/message_embed.eml index a7aa88ac..95758084 100644 --- a/t/data/message_embed.eml +++ b/t/data/message_embed.eml @@ -63,7 +63,7 @@ index 00000000..166baf91 --- /dev/null +++ b/lib/PublicInbox/MailHeader.pm @@ -0,0 +1,55 @@ -+# Copyright (C) 2020 all contributors <meta@public-inbox.org> ++# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +package PublicInbox::MailHeader; +use strict; diff --git a/t/dir_idle.t b/t/dir_idle.t index 587599e8..8d085d6e 100644 --- a/t/dir_idle.t +++ b/t/dir_idle.t @@ -1,6 +1,47 @@ #!perl -w -# Copyright (C) 2020 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 718567d6..87f7199d 100644 --- a/t/ds-kqxs.t +++ b/t/ds-kqxs.t @@ -1,13 +1,14 @@ -# Copyright (C) 2019-2020 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 72bf0379..f39985e0 100644 --- a/t/ds-leak.t +++ b/t/ds-leak.t @@ -1,28 +1,25 @@ -# Copyright (C) 2019-2020 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 3771059b..22dbc802 100644 --- a/t/ds-poll.t +++ b/t/ds-poll.t @@ -1,50 +1,64 @@ -# Copyright (C) 2019-2020 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 = []; -my $n = $p->epoll_wait(9, 0, $events); +$p->ep_wait(0, $events); is_deeply($events, [], 'no events set'); -is($n, 0, 'nothing ready, yet'); -is($p->epoll_ctl(EPOLL_CTL_ADD, fileno($w), EPOLLOUT|EPOLLONESHOT), 0, - 'add EPOLLOUT|EPOLLONESHOT'); -$n = $p->epoll_wait(9, -1, $events); -is($n, 1, 'got POLLOUT event'); -is($events->[0]->[0], fileno($w), '$w ready'); +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'); -$n = $p->epoll_wait(9, 0, $events); -is($n, 0, 'nothing ready after oneshot'); +$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) { - $n = $p->epoll_wait(9, $t, $events); - is($events->[0]->[0], fileno($r), "level-trigger POLLIN ready #$t"); - is($n, 1, "only event ready #$t"); + $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'); -is($p->epoll_wait(9, -1, $events), 2, 'epoll_wait has 2 ready'); -my @fds = sort(map { $_->[0] } @$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'); -$n = $p->epoll_wait(9, 0, $events); -is($n, 0, 'nothing ready after EPOLL_CTL_DEL'); +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-2020 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"); diff --git a/t/emergency.t b/t/emergency.t index 74cc1d2e..60dba2ad 100644 --- a/t/emergency.t +++ b/t/emergency.t @@ -1,4 +1,4 @@ -# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org> +# 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; @@ -1,13 +1,16 @@ #!perl -w -# Copyright (C) 2020 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); SKIP: { require_mods('Email::MIME', 1); + # TODO: Email::MIME behavior is not consistent in newer versions + # we need to evaluate and possibly adjust our behavior to decide + # between DWIM-ness with historical mail... push @classes, 'PublicInbox::MIME'; }; use_ok $_ for @classes; @@ -23,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) { @@ -211,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" @@ -260,6 +276,9 @@ EOF } for my $cls (@classes) { +SKIP: { + skip 'newer Email::MIME behavior inconsistent', 1 if + $cls eq 'PublicInbox::MIME'; my $s = <<EOF; # buggy git-send-email versions, again? Content-Type: text/plain; =?ISO-8859-1?Q?=20charset=3D=1BOF?= Content-Transfer-Encoding: 8bit @@ -269,7 +288,8 @@ Object-Id: ab0440d8cd6d843bee9a27709a459ce3b2bdb94d (lore/kvm) EOF my $eml = $cls->new(\$s); my ($str, $err) = msg_part_text($eml, $eml->content_type); - is($str, "\x{100}\n", "got wide character by assuming utf-8"); + is($str, "\x{100}\n", "got wide character by assuming utf-8 ($cls)"); +} # SKIP } if ('we differ from Email::MIME with final "\n" on missing epilogue') { @@ -335,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)) { @@ -383,8 +403,12 @@ SKIP: { $msg->parts_set([$old[-1]]); is(scalar $msg->subparts, 1, 'only last remains'); } - is($eml->as_string, $mime->as_string, - 'as_string matches after parts_set'); + + # some versions of Email::MIME or Email::MIME::* will drop + # unnecessary ", while PublicInbox::Eml will preserve the original + my $exp = $mime->as_string; + $exp =~ s/; boundary=b\b/; boundary="b"/; + is($eml->as_string, $exp, 'as_string matches after parts_set'); } for my $cls (@classes) { @@ -393,12 +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'); + 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 @@ -413,10 +439,14 @@ Content-Type: text/x-patch; name="=?utf-8?q?vtpm-fakefile.patch?=" b --b-- EOF - my @tmp; - $cls->new($s)->each_part(sub { push @tmp, $_[0]->[0]->filename }); - is_deeply(['vtpm-makefile.patch', 'vtpm-fakefile.patch'], \@tmp, - 'got filename for both attachments'); + SKIP: { + skip 'newer Email::MIME is inconsistent here', 1 + if $cls eq 'PublicInbox::MIME'; + my @x; + $cls->new($s)->each_part(sub { push @x, $_[0]->[0]->filename }); + is_deeply(['vtpm-makefile.patch', 'vtpm-fakefile.patch'], \@x, + "got filename for both attachments ($cls)"); + } } done_testing; diff --git a/t/eml_content_disposition.t b/t/eml_content_disposition.t index 9bdacc05..099587f8 100644 --- a/t/eml_content_disposition.t +++ b/t/eml_content_disposition.t @@ -1,5 +1,5 @@ #!perl -w -# Copyright (C) 2020 all contributors <meta@public-inbox.org> +# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> # Copyright (C) 2004- Simon Cozens, Casey West, Ricardo SIGNES # This library is free software; you can redistribute it and/or modify # it under the same terms as Perl itself. diff --git a/t/eml_content_type.t b/t/eml_content_type.t index 5acd51ad..ab8d4b2d 100644 --- a/t/eml_content_type.t +++ b/t/eml_content_type.t @@ -1,5 +1,5 @@ #!perl -w -# Copyright (C) 2020 all contributors <meta@public-inbox.org> +# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> # Copyright (C) 2004- Simon Cozens, Casey West, Ricardo SIGNES # This library is free software; you can redistribute it and/or modify # it under the same terms as Perl itself. @@ -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; -is(epoll_wait($epfd, 100, 10000, \@events), 1, 'epoll_wait returns'); +$ep->ep_wait(10000, \@events); is(scalar(@events), 1, 'got one event'); -is($events[0]->[0], fileno($w), 'got expected FD'); -is($events[0]->[1], EPOLLOUT, 'got expected event'); +is($events[0], fileno($w), 'got expected FD'); close $w; -is(epoll_wait($epfd, 100, 0, \@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 new file mode 100644 index 00000000..797aa8f5 --- /dev/null +++ b/t/extsearch.t @@ -0,0 +1,596 @@ +#!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::Config; +use PublicInbox::InboxWritable; +require_git(2.6); +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 ($home, $for_destroy) = tmpdir(); +local $ENV{HOME} = $home; +mkdir "$home/.public-inbox" or BAIL_OUT $!; +my $cfg_path = "$home/.public-inbox/config"; +PublicInbox::IO::write_file '>', $cfg_path, <<EOF; +[publicinboxMda] + spamcheck = none +EOF +my $v2addr = 'v2test@example.com'; +my $v1addr = 'v1test@example.com'; +ok(run_script([qw(-init -Lbasic -V2 v2test --newsgroup v2.example), + "$home/v2test", 'http://example.com/v2test', $v2addr ]), 'v2test init'); +my $env = { ORIGINAL_RECIPIENT => $v2addr }; +my $eml = eml_load('t/utf8.eml'); + +$eml->header_set('List-Id', '<v2.example.com>'); + +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>'); +$in = \$eml->as_string; + +$env = { ORIGINAL_RECIPIENT => $v1addr }; +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 --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 + PublicInbox::IO::write_file '>>', $cfg_path, <<EOF; +; for ->ALL +[extindex "all"] + topdir = $home/extindex +EOF + my $pi_cfg = PublicInbox::Config->new; + $pi_cfg->fill_all; + ok($pi_cfg->ALL, '->ALL'); + my $ibx = $pi_cfg->{-by_newsgroup}->{'v2.example'}; + my $ret = $pi_cfg->ALL->nntp_xref_for($ibx, $ibx->over->get_art(1)); + is_deeply($ret, { 'v1.example' => 1, 'v2.example' => 1 }, + '->nntp_xref_for'); +} + +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 }); + my $n = Net::NNTP->new($host_port); + my @xp = $n->xpath('<testmessage@example.com>'); + is_deeply(\@xp, [ qw(v1.example/1 v2.example/1) ]); + $n->group('v1.example'); + my $res = $n->head(1); + @$res = grep(/^Xref: /, @$res); + like($res->[0], qr/ v1\.example:1 v2\.example:1/, 'nntp_xref works'); +} + +my $es = PublicInbox::ExtSearch->new("$home/extindex"); +{ + my $smsg = $es->over->get_art(1); + ok($smsg, 'got first article'); + is($es->over->get_art(2), undef, 'only one added'); + my $xref3 = $es->over->get_xref3(1); + like($xref3->[0], qr/\A\Qv2.example\E:1:/, 'order preserved 1'); + like($xref3->[1], qr/\A\Qv1.example\E:1:/, 'order preserved 2'); + is(scalar(@$xref3), 2, 'only to entries'); +} + +if ('inbox edited') { + my ($in, $out, $err); + $in = $out = $err = ''; + my $opt = { 0 => \$in, 1 => \$out, 2 => \$err }; + 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), + 'extindex again'); + like($err, qr/discontiguous range/, 'warned about discontiguous range'); + my $msg1 = $es->over->get_art(1) or BAIL_OUT 'msg1 missing'; + my $msg2 = $es->over->get_art(2) or BAIL_OUT 'msg2 missing'; + is($msg1->{mid}, $msg2->{mid}, 'edited message indexed'); + isnt($msg1->{blob}, $msg2->{blob}, 'blobs differ'); + my $eml2 = $es->smsg_eml($msg2); + like($eml2->body, qr/BEST MSG/, 'edited body in #2'); + unlike($eml2->body, qr/test message/, 'old body discarded in #2'); + my $eml1 = $es->smsg_eml($msg1); + like($eml1->body, qr/test message/, 'original body in #1'); + my $x1 = $es->over->get_xref3(1); + my $x2 = $es->over->get_xref3(2); + is(scalar(@$x1), 1, 'original only has one xref3'); + is(scalar(@$x2), 1, 'new message has one xref3'); + isnt($x1->[0], $x2->[0], 'xref3 differs'); + + my $mset = $es->mset('b:"BEST MSG"'); + 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 qp)}; # fork preparation + + my $pi_cfg = PublicInbox::Config->new; + $pi_cfg->fill_all; + is(scalar($pi_cfg->ALL->mset('s:Testing')->items), 2, + '2 results in ->ALL'); + my $res = {}; + my $nr = 0; + $pi_cfg->each_inbox(sub { + $nr++; + my ($ibx) = @_; + local $SIG{__WARN__} = sub {}; # FIXME support --reindex + my $mset = $ibx->isrch->mset('s:Testing'); + $res->{$ibx->eidx_key} = $ibx->isrch->mset_to_smsg($ibx, $mset); + }); + is($nr, 2, 'two inboxes'); + my $exp = {}; + for my $v (qw(v1 v2)) { + my $ibx = $pi_cfg->lookup_newsgroup("$v.example"); + my $smsg = $ibx->over->get_art(1); + $smsg->psgi_cull; + $exp->{"$v.example"} = [ $smsg ]; + } + is_deeply($res, $exp, 'isearch limited results'); + $pi_cfg = $res = $exp = undef; + + $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), + 'extindex after rm'); + is($es->over->get_art(2), undef, 'doc #2 gone'); + $mset = $es->mset('b:"BEST MSG"'); + is($mset->size, 0, 'new message gone'); +} + +my $misc = $es->misc; +my @it = $misc->mset('')->items; +is(scalar(@it), 2, 'two inboxes'); +like($it[0]->get_document->get_data, qr/v2test/, 'docdata matched v2'); +like($it[1]->get_document->get_data, qr/v1test/, 'docdata matched v1'); + +my $cfg = PublicInbox::Config->new; +my $schema_version = PublicInbox::Search::SCHEMA_VERSION(); +my $f = "$home/extindex/ei$schema_version/over.sqlite3"; +my $oidx = PublicInbox::OverIdx->new($f); +if ('inject w/o indexing') { + use PublicInbox::Import; + my $v1ibx = $cfg->lookup_name('v1test'); + my $last_v1_commit = $v1ibx->mm->last_commit; + my $v2ibx = $cfg->lookup_name('v2test'); + my $last_v2_commit = $v2ibx->mm->last_commit_xap($schema_version, 0); + my $git0 = PublicInbox::Git->new("$v2ibx->{inboxdir}/git/0.git"); + chomp(my $cmt = $git0->qx(qw(rev-parse HEAD^0))); + is($last_v2_commit, $cmt, 'v2 index up-to-date'); + + my $v2im = PublicInbox::Import->new($git0, undef, undef, $v2ibx); + $v2im->{lock_path} = undef; + $v2im->{path_type} = 'v2'; + $v2im->add(eml_load('t/mda-mime.eml')); + $v2im->done; + chomp(my $tip = $git0->qx(qw(rev-parse HEAD^0))); + isnt($tip, $cmt, '0.git v2 updated'); + + # inject a message w/o updating index + 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"); + + my ($in, $out, $err); + $in = $out = $err = ''; + my $opt = { 0 => \$in, 1 => \$out, 2 => \$err }; + ok(run_script([qw(-extindex -v -v --all), "$home/extindex"], + undef, undef), 'extindex noop'); + $es->{xdb}->reopen; + my $mset = $es->mset('mid:199707281508.AAA24167@hoyogw.example'); + is($mset->size, 0, 'did not attempt to index unindexed v1 message'); + $mset = $es->mset('mid:multipart-html-sucks@11'); + is($mset->size, 0, 'did not attempt to index unindexed v2 message'); + ok(run_script([qw(-index --all)]), 'indexed v1 and v2 inboxes'); + + isnt($v1ibx->mm->last_commit, $last_v1_commit, '-index v1 worked'); + isnt($v2ibx->mm->last_commit_xap($schema_version, 0), + $last_v2_commit, '-index v2 worked'); + ok(run_script([qw(-extindex --all), "$home/extindex"]), + 'extindex updates'); + + $es->{xdb}->reopen; + $mset = $es->mset('mid:199707281508.AAA24167@hoyogw.example'); + is($mset->size, 1, 'got v1 message'); + $mset = $es->mset('mid:multipart-html-sucks@11'); + is($mset->size, 1, 'got v2 message'); +} + +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'); + $im->add($eml); + $im->done; + my $cmt_b = $v2ibx->mm->last_commit_xap($schema_version, 0); + isnt($cmt_a, $cmt_b, 'v2 0.git HEAD updated'); + $oidx->dbh; + my $uv = $v2ibx->uidvalidity; + my $lc_key = "lc-v2:v2.example//$uv;0"; + is($oidx->eidx_meta($lc_key, $cmt_b), $cmt_a, + 'update lc-v2 meta, old is as expected'); + my $max = $oidx->max; + $oidx->dbh_close; + ok(run_script([qw(-extindex), "$home/extindex", $v2ibx->{inboxdir}]), + '-extindex noop'); + is($oidx->max, $max, '->max unchanged'); + is($oidx->eidx_meta($lc_key), $cmt_b, 'lc-v2 unchanged'); + $oidx->dbh_close; + my $opt = { 2 => \(my $err = '') }; + ok(run_script([qw(-extindex --reindex), "$home/extindex", + $v2ibx->{inboxdir}], undef, $opt), + '--reindex for unseen'); + is($oidx->max, $max + 1, '->max bumped'); + 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/# 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; + # 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'); + $im->done; + my $cmt_c = $v2ibx->mm->last_commit_xap($schema_version, 0); + is($oidx->eidx_meta($lc_key, $cmt_c), $cmt_b, + 'bump lc-v2 meta again to skip v2 remove'); + $err = ''; + $oidx->dbh_close; + ok(run_script([qw(-extindex --reindex), "$home/extindex", + $v2ibx->{inboxdir}], undef, $opt), + '--reindex for stale'); + @err = split(/^/, $err); + is(scalar(@err), 1, 'only one warning') or diag "err=$err"; + like($err[0], qr/\(#$new->{num}\): stale/, 'got stale message warning'); + is($oidx->get_art($new->{num}), undef, + 'stale message gone from over'); + is_deeply($oidx->get_xref3($new->{num}), [], + 'stale message has no xref3'); + $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); + $im->add($eml); + $im->done; + my $cmt_b = $v2ibx->mm->last_commit_xap($schema_version, 0); + my $uv = $v2ibx->uidvalidity; + my $lc_key = "lc-v2:v2.example//$uv;0"; + $oidx->dbh; + is($oidx->eidx_meta($lc_key, $cmt_b), $cmt_a, + 'update lc-v2 meta, old is as expected'); + my $mid = mids($eml)->[0]; + my $smsg = $v2ibx->over->next_by_mid($mid, \(my $id), \(my $prev)); + my $oldmax = $oidx->max; + my $x3_orig = $oidx->get_xref3(3); + is(scalar(@$x3_orig), 1, '#3 has one xref'); + $oidx->add_xref3(3, $smsg->{num}, $smsg->{blob}, 'v2.example'); + my $x3 = $oidx->get_xref3(3); + is(scalar(@$x3), 2, 'injected xref3'); + $oidx->commit_lazy; + my $opt = { 2 => \(my $err = '') }; + ok(run_script([qw(-extindex --all), "$home/extindex"], undef, $opt), + 'extindex --all is noop'); + is($err, '', 'no warnings in index'); + $oidx->dbh; + is($oidx->max, $oldmax, 'oidx->max unchanged'); + $oidx->dbh_close; + ok(run_script([qw(-extindex --reindex --all), "$home/extindex"], + 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/, + 'bifurcation noted'); + my $added = $oidx->get_art($oidx->max); + is($added->{blob}, $smsg->{blob}, 'new blob indexed'); + is_deeply(["v2.example:$smsg->{num}:$smsg->{blob}"], + $oidx->get_xref3($added->{num}), + 'xref3 corrected for bifurcated message'); + is_deeply($oidx->get_xref3(3), $x3_orig, 'xref3 restored for #3'); +} + +if ('--reindex --rethread') { + my $before = $oidx->dbh->selectrow_array(<<''); +SELECT MAX(tid) FROM over WHERE num > 0 + + my $opt = {}; + ok(run_script([qw(-extindex --reindex --rethread --all), + "$home/extindex"], undef, $opt), + '--rethread'); + my $after = $oidx->dbh->selectrow_array(<<''); +SELECT MIN(tid) FROM over WHERE num > 0 + + # actual rethread logic is identical to v1/v2 and tested elsewhere + ok($after > $before, '--rethread updates MIN(tid)'); +} + +if ('remove v1test and test gc') { + xsys([qw(git config --unset publicinbox.v1test.inboxdir)], + { GIT_CONFIG => $cfg_path }); + my $opt = { 2 => \(my $err = '') }; + ok(run_script([qw(-extindex --gc), "$home/extindex"], undef, $opt), + 'extindex --gc'); + 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 11dac117..8221e092 100644 --- a/t/fake_inotify.t +++ b/t/fake_inotify.t @@ -1,16 +1,15 @@ #!perl -w -# Copyright (C) 2020 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 @@ -# Copyright (C) 2014-2020 all contributors <meta@public-inbox.org> +#!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,16 +41,18 @@ 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 { # check initial feed { - my $feed = string_feed({ -inbox => $ibx }); + my $feed = string_feed({ ibx => $ibx }); SKIP: { skip 'XML::TreePP missing', 3 unless $have_xml_treepp; my $t = XML::TreePP->new->parse($feed); @@ -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'); } @@ -109,7 +86,7 @@ EOF # check spam shows up { - my $spammy_feed = string_feed({ -inbox => $ibx }); + my $spammy_feed = string_feed({ ibx => $ibx }); SKIP: { skip 'XML::TreePP missing', 2 unless $have_xml_treepp; my $t = XML::TreePP->new->parse($spammy_feed); @@ -127,7 +104,7 @@ EOF # spam no longer shows up { - my $feed = string_feed({ -inbox => $ibx }); + my $feed = string_feed({ ibx => $ibx }); SKIP: { skip 'XML::TreePP missing', 2 unless $have_xml_treepp; my $t = XML::TreePP->new->parse($feed); @@ -140,4 +117,4 @@ EOF } } -done_testing(); +done_testing; diff --git a/t/filter_base.t b/t/filter_base.t index 47d0220f..2646321a 100644 --- a/t/filter_base.t +++ b/t/filter_base.t @@ -1,4 +1,4 @@ -# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org> +# 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; diff --git a/t/filter_mirror.t b/t/filter_mirror.t index 5bc7f3f4..678d9fb0 100644 --- a/t/filter_mirror.t +++ b/t/filter_mirror.t @@ -1,4 +1,4 @@ -# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org> +# 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; diff --git a/t/filter_rubylang.t b/t/filter_rubylang.t index e6c53f98..490a2154 100644 --- a/t/filter_rubylang.t +++ b/t/filter_rubylang.t @@ -1,8 +1,7 @@ -# Copyright (C) 2017-2020 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'; @@ -35,7 +34,7 @@ SKIP: { ]; my $ibx = PublicInbox::Inbox->new({ inboxdir => $git_dir, altid => $altid }); - $f = PublicInbox::Filter::RubyLang->new(-inbox => $ibx); + $f = PublicInbox::Filter::RubyLang->new(ibx => $ibx); $msg = <<'EOF'; X-Mail-Count: 12 Message-ID: <a@b> @@ -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(); diff --git a/t/filter_subjecttag.t b/t/filter_subjecttag.t index e2d91e74..f88fcad5 100644 --- a/t/filter_subjecttag.t +++ b/t/filter_subjecttag.t @@ -1,4 +1,4 @@ -# Copyright (C) 2017-2020 all contributors <meta@public-inbox.org> +# 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; diff --git a/t/filter_vger.t b/t/filter_vger.t index ca5a6ca7..92d6a9f3 100644 --- a/t/filter_vger.t +++ b/t/filter_vger.t @@ -1,4 +1,4 @@ -# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org> +# 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; @@ -1,5 +1,5 @@ #!perl -w -# Copyright (C) 2020 all contributors <meta@public-inbox.org> +# 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 PublicInbox::TestCommon; @@ -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,12 +110,12 @@ 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: $!"; truncate($fh, 0) or BAIL_OUT "truncate: $!"; - defined(my $pid = fork) or BAIL_OUT "fork: $!"; + my $pid = fork // BAIL_OUT "fork: $!"; if ($pid == 0) { close $w; tick; # wait for parent to block on writev @@ -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 f1302a54..33ee2c91 100644 --- a/t/gcf2_client.t +++ b/t/gcf2_client.t @@ -1,10 +1,10 @@ #!perl -w -# Copyright (C) 2020 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->cat_async("$tree $git_a", 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->cat_async("$trunc $git_a", 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->cat_async("$tree $git_b", 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->cat_async("$tree $git_a", 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'); @@ -86,5 +86,5 @@ my $err_f = "$tmpdir/err"; }); $gcf2c->cat_async_step($gcf2c->{inflight}); } -is($called, 4, 'cat_async callbacks hit'); +is($called, 4, 'gcf2_async callbacks hit'); done_testing; diff --git a/t/git-http-backend.psgi b/t/git-http-backend.psgi index e34ebe40..a91e5de8 100644 --- a/t/git-http-backend.psgi +++ b/t/git-http-backend.psgi @@ -1,5 +1,5 @@ #!/usr/bin/perl -w -# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org> +# 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; @@ -1,17 +1,17 @@ -# Copyright (C) 2015-2020 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; my ($dir, $for_destroy) = tmpdir(); -use PublicInbox::Spawn qw(popen_rd); use PublicInbox::Import; - -use_ok 'PublicInbox::Git'; +use POSIX qw(strftime); +use PublicInbox::Git; +is(PublicInbox::Git::MAX_INFLIGHT, + int(PublicInbox::Git::MAX_INFLIGHT), 'MAX_INFLIGHT is an integer'); { - PublicInbox::Import::init_bare($dir); + 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,6 +19,26 @@ use_ok 'PublicInbox::Git'; xsys([qw(git fast-import --quiet)], { GIT_DIR => $dir }, $rdr); is($?, 0, 'fast-import succeeded'); } +{ + 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'; + @s = $git->date_parse('1993-10-02 01:02:09', '2010-10-02 01:03:04'); + is(strftime('%Y-%m-%dT%H:%M:%SZ', gmtime($s[0])), + '1993-10-02T01:02:09Z', 'round trips'); + is(strftime('%Y-%m-%dT%H:%M:%SZ', gmtime($s[1])), + '2010-10-02T01:03:04Z', '2nd arg round trips'); + @s = $git->date_parse('1993-10-02'); + is(strftime('%Y-%m-%d', gmtime($s[0])), '1993-10-02', + 'round trips date-only'); +} { my $gcf = PublicInbox::Git->new($dir); @@ -26,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'); @@ -48,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) { @@ -70,22 +114,29 @@ if (1) { chomp $buf; my $gcf = PublicInbox::Git->new($dir); - my $rsize; - my $x = $gcf->cat_file($buf, \$rsize); - is($rsize, $size, 'got correct size ref on big file'); - is(length($$x), $size, 'read correct number of bytes'); + my @x = $gcf->cat_file($buf); + is($x[2], 'blob', 'got blob on wantarray'); + is($x[3], $size, 'got correct size ref on big file'); + is(length(${$x[0]}), $size, 'read correct number of bytes'); my $ref = $gcf->qx(qw(cat-file blob), $buf); + is($?, 0, 'no error on scalar success'); my @ref = $gcf->qx(qw(cat-file blob), $buf); + is($?, 0, 'no error on wantarray success'); my $nl = scalar @ref; ok($nl > 1, "qx returned array length of $nl"); + is(join('', @ref), $ref, 'qx array and scalar context both work'); $gcf->qx(qw(repack -adq)); ok($gcf->packed_bytes > 0, 'packed size is positive'); + 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); @@ -127,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'); @@ -150,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 400214e6..97eac2d0 100644 --- a/t/gzip_filter.t +++ b/t/gzip_filter.t @@ -1,7 +1,7 @@ -# Copyright (C) 2020 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-2020 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/home2/.gitignore b/t/home2/.gitignore new file mode 100644 index 00000000..b97d81e6 --- /dev/null +++ b/t/home2/.gitignore @@ -0,0 +1,5 @@ +/.public-inbox +/t1 +/t2 +/setup.lock +/setup-stamp diff --git a/t/home2/Makefile b/t/home2/Makefile new file mode 100644 index 00000000..9d4895dc --- /dev/null +++ b/t/home2/Makefile @@ -0,0 +1,7 @@ +all :: + +help :: + @cat README + +clean :: + $(RM) -rf t1 t2 .public-inbox setup-stamp setup-lock diff --git a/t/home2/README b/t/home2/README new file mode 100644 index 00000000..179584a2 --- /dev/null +++ b/t/home2/README @@ -0,0 +1,8 @@ +This directory is for read-only test inboxes and will be shared +between various tests. + +See setup_publicinboxes() in lib/PublicInbox/TestCommon.pm. + +It is versioned (currently "2" in "home2") and will be renamed +"home3" and so forth if the data created by setup_publicinboxes() +changes. diff --git a/t/html_index.t b/t/html_index.t deleted file mode 100644 index 80f81577..00000000 --- a/t/html_index.t +++ /dev/null @@ -1,56 +0,0 @@ -# Copyright (C) 2014-2020 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 cb41cfa0..e29fd87b 100644 --- a/t/httpd-corner.psgi +++ b/t/httpd-corner.psgi @@ -1,11 +1,25 @@ -# Copyright (C) 2016-2020 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); @@ -48,7 +62,7 @@ my $app = sub { } } elsif ($path eq '/host-port') { $code = 200; - push @$body, "$env->{REMOTE_ADDR}:$env->{REMOTE_PORT}"; + push @$body, "$env->{REMOTE_ADDR} $env->{REMOTE_PORT}"; } elsif ($path eq '/callback') { return sub { my ($res) = @_; @@ -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 514672a1..7539573c 100644 --- a/t/httpd-corner.t +++ b/t/httpd-corner.t @@ -1,17 +1,15 @@ -# Copyright (C) 2016-2020 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; use IO::Socket::UNIX; use Fcntl qw(:seek); use Socket qw(IPPROTO_TCP TCP_NODELAY SOL_SOCKET); @@ -23,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 ($) { @@ -50,22 +49,47 @@ sub unix_server ($) { Listen => 1024, Type => Socket::SOCK_STREAM(), Local => $_[0], - ); + ) or BAIL_OUT "bind + listen $_[0]: $!"; $s->blocking(0); $s; } my $upath = "$tmpdir/s"; my $unix = unix_server($upath); -ok($unix, 'UNIX socket created'); +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"); @@ -87,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"); @@ -219,7 +252,7 @@ sub check_400 { ok($u, 'unix socket connected'); $u->write("GET /host-port HTTP/1.0\r\n\r\n"); $u->read(my $buf, 4096); - like($buf, qr!\r\n\r\n127\.0\.0\.1:0\z!, + like($buf, qr!\r\n\r\n127\.0\.0\.1 0\z!, 'set REMOTE_ADDR and REMOTE_PORT for Unix socket'); } @@ -236,8 +269,8 @@ sub conn_for { $conn->write("GET /host-port HTTP/1.0\r\n\r\n"); $conn->read(my $buf, 4096); my ($head, $body) = split(/\r\n\r\n/, $buf); - my ($addr, $port) = split(/:/, $body); - is($addr, $conn->sockhost, 'host matches addr'); + my ($addr, $port) = split(/ /, $body); + is($addr, (tcp_host_port($conn))[0], 'host matches addr'); is($port, $conn->sockport, 'port matches'); } @@ -289,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; @@ -305,12 +338,12 @@ my $check_self = sub { }; SKIP: { - my $curl = which('curl') or skip('curl(1) missing', 4); - my $base = 'http://' . $sock->sockhost . ':' . $sock->sockport; + 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 }; @@ -327,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) { @@ -335,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/, @@ -355,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'); @@ -594,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 @@ -645,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 fcfa12af..bf086123 100644 --- a/t/httpd-https.t +++ b/t/httpd-https.t @@ -1,15 +1,15 @@ -# Copyright (C) 2019-2020 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/"; } @@ -21,7 +21,21 @@ my $err = "$tmpdir/stderr.log"; my $out = "$tmpdir/stdout.log"; my $https = tcp_server(); my $td; -my $https_addr = $https->sockhost . ':' . $https->sockport; +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 363f3648..0b620bd6 100644 --- a/t/httpd-unix.t +++ b/t/httpd-unix.t @@ -1,15 +1,17 @@ -# Copyright (C) 2016-2020 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,23 +43,28 @@ 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); - warn "E: $! connecting to $unix\n" unless defined $sock; - ok($sock, 'client UNIX socket connected'); + 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'); - like($buf, qr!\r\n\r\n127\.0\.0\.1:0\z!, + like($buf, qr!\r\n\r\n127\.0\.0\.1 0\z!, 'set REMOTE_ADDR and REMOTE_PORT for Unix socket'); } @@ -83,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: { @@ -108,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 @@ -# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org> +#!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,24 +32,23 @@ 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); - } - ok($sock, 'sock created'); + }; + 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 $host = $sock->sockhost; - my $port = $sock->sockport; + my $http_pfx = 'http://'.tcp_host_port($sock); { my $bad = tcp_connect($sock); print $bad "GETT / HTTP/1.0\r\n\r\n" or die; 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; @@ -65,17 +58,38 @@ EOF } is(xsys(qw(git clone -q --mirror), - "http://$host:$port/$group", "$tmpdir/clone.git"), + "$http_pfx/$group", "$tmpdir/clone.git"), 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://$host:$port/$group", "$tmpdir/dumb.git"), + "$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; @@ -91,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; @@ -1,4 +1,4 @@ -# Copyright (C) 2017-2020 all contributors <meta@public-inbox.org> +# 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; @@ -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 -'); diff --git a/t/idx_stack.t b/t/idx_stack.t index 35aff37b..7af096a8 100644 --- a/t/idx_stack.t +++ b/t/idx_stack.t @@ -1,11 +1,13 @@ #!perl -w -# Copyright (C) 2020 all contributors <meta@public-inbox.org> +# 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_ok 'PublicInbox::IdxStack'; my $oid_a = '03c21563cf15c241687966b5b2a3f37cdc193316'; my $oid_b = '963caad026055ab9bcbe3ee9550247f9d8840feb'; +my $cmt_a = 'df8e4a0612545d53672036641e9f076efc94c2f6'; +my $cmt_b = '3ba7c9fa4a083c439e768882c571c2026a981ca5'; my $stk = PublicInbox::IdxStack->new; is($stk->read_prepare, $stk, 'nothing'); @@ -13,19 +15,19 @@ is($stk->num_records, 0, 'no records'); is($stk->pop_rec, undef, 'undef on empty'); $stk = PublicInbox::IdxStack->new; -$stk->push_rec('m', 1234, 5678, $oid_a); +$stk->push_rec('m', 1234, 5678, $oid_a, $cmt_a); is($stk->read_prepare, $stk, 'read_prepare'); is($stk->num_records, 1, 'num_records'); -is_deeply([$stk->pop_rec], ['m', 1234, 5678, $oid_a], 'pop once'); +is_deeply([$stk->pop_rec], ['m', 1234, 5678, $oid_a, $cmt_a], 'pop once'); is($stk->pop_rec, undef, 'undef on empty'); $stk = PublicInbox::IdxStack->new; -$stk->push_rec('m', 1234, 5678, $oid_a); -$stk->push_rec('d', 1234, 5678, $oid_b); +$stk->push_rec('m', 1234, 5678, $oid_a, $cmt_a); +$stk->push_rec('d', 1234, 5678, $oid_b, $cmt_b); is($stk->read_prepare, $stk, 'read_prepare'); is($stk->num_records, 2, 'num_records'); -is_deeply([$stk->pop_rec], ['d', 1234, 5678, $oid_b], 'pop'); -is_deeply([$stk->pop_rec], ['m', 1234, 5678, $oid_a], 'pop-pop'); +is_deeply([$stk->pop_rec], ['d', 1234, 5678, $oid_b, $cmt_b], 'pop'); +is_deeply([$stk->pop_rec], ['m', 1234, 5678, $oid_a, $cmt_a], 'pop-pop'); is($stk->pop_rec, undef, 'empty'); SKIP: { @@ -37,11 +39,11 @@ SKIP: { while (<$fh>) { chomp; my ($at, $ct, $H) = split(/\./); - $stk //= PublicInbox::IdxStack->new($H); + $stk //= PublicInbox::IdxStack->new; # not bothering to parse blobs here, just using commit OID # as a blob OID since they're the same size + format - $stk->push_rec('m', $at + 0, $ct + 0, $H); - push(@expect, [ 'm', $at, $ct, $H ]); + $stk->push_rec('m', $at + 0, $ct + 0, $H, $H); + push(@expect, [ 'm', $at, $ct, $H, $H ]); } $stk or skip('nothing from git log', 3); is($stk->read_prepare, $stk, 'read_prepare'); @@ -1,21 +1,20 @@ #!perl -w -# Copyright (C) 2020 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 adf7b205..d7840dd0 100644 --- a/t/imap_searchqp.t +++ b/t/imap_searchqp.t @@ -1,12 +1,13 @@ #!perl -w -# Copyright (C) 2020 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)}); @@ -76,17 +83,17 @@ is($q->{xap}, 'c:"b" d:..19931002', 'compound query w/ parens'); $q = $parse->($s = qq{BEFORE 2-Oct-1993}); is_deeply($q->{sql}, \" AND ts <= $t0", 'BEFORE SQL'); $q = $parse->("FROM z $s"); - is($q->{xap}, qq{f:"z" ts:..$t0}, 'BEFORE Xapian'); + is($q->{xap}, qq{f:"z" rt:..$t0}, 'BEFORE Xapian'); $q = $parse->($s = qq{SINCE 2-Oct-1993}); is_deeply($q->{sql}, \" AND ts >= $t0", 'SINCE SQL'); $q = $parse->("FROM z $s"); - is($q->{xap}, qq{f:"z" ts:$t0..}, 'SINCE Xapian'); + is($q->{xap}, qq{f:"z" rt:$t0..}, 'SINCE Xapian'); $q = $parse->($s = qq{ON 2-Oct-1993}); is_deeply($q->{sql}, \" AND ts >= $t0 AND ts <= $t1", 'ON SQL'); $q = $parse->("FROM z $s"); - is($q->{xap}, qq{f:"z" ts:$t0..$t1}, 'ON Xapian'); + is($q->{xap}, qq{f:"z" rt:$t0..$t1}, 'ON Xapian'); } { diff --git a/t/imap_tracker.t b/t/imap_tracker.t index 01e1d0b1..90dea99f 100644 --- a/t/imap_tracker.t +++ b/t/imap_tracker.t @@ -1,4 +1,4 @@ -# Copyright (C) 2020 all contributors <meta@public-inbox.org> +# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use Test::More; use strict; @@ -29,7 +29,7 @@ SKIP: { diag "TEST_STRESS_NPROC=$nproc TEST_STRESS_NR=$nr"; require POSIX; for my $n (1..$nproc) { - defined(my $pid = fork) or BAIL_OUT "fork: $!"; + my $pid = fork // BAIL_OUT "fork: $!"; if ($pid == 0) { my $url = "imap://example.com/INBOX.$$"; my $uidval = time; diff --git a/t/imapd-tls.t b/t/imapd-tls.t index df4ef85c..b95085a2 100644 --- a/t/imapd-tls.t +++ b/t/imapd-tls.t @@ -1,13 +1,11 @@ -# Copyright (C) 2020 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,53 +23,35 @@ 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"; -} +}; +$pi_config //= "$ibx->{inboxdir}/pi_config"; -{ - 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; - } -} - -my $imaps_addr = $imaps->sockhost . ':' . $imaps->sockport; -my $starttls_addr = $starttls->sockhost . ':' . $starttls->sockport; +my $imaps_addr = tcp_host_port($imaps); +my $starttls_addr = tcp_host_port($starttls); my $env = { PI_CONFIG => $pi_config }; my $td; @@ -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 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,40 +30,41 @@ 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"; my $cmd = [ '-imapd', '-W0', "--stdout=$out", "--stderr=$err" ]; my $td = start_script($cmd, undef, { 3 => $sock }) or BAIL_OUT("-imapd: $?"); -my %mic_opt = ( - Server => $sock->sockhost, - Port => $sock->sockport, - Uid => 1, -); +my ($ihost, $iport) = tcp_host_port($sock); +my %mic_opt = ( Server => $ihost, Port => $iport, Uid => 1 ); my $mic = $imap_client->new(%mic_opt); my $pre_login_capa = $mic->capability; is(grep(/\AAUTH=ANONYMOUS\z/, @$pre_login_capa), 1, @@ -100,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; @@ -249,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_config = PublicInbox::Config->new; -$pi_config->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); @@ -266,10 +264,9 @@ $pi_config->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'); @@ -296,31 +293,14 @@ $pi_config->each_inbox(sub { # ensure IDLE persists across HUP, w/o extra watches or FDs $td->kill('HUP') or BAIL_OUT "failed to kill -imapd: $!"; - SKIP: { - skip 'no inotify fdinfo (or support)', 2 if !@ino_info; - my (@tmp, %prev); - local $/ = "\n"; - my $end = time + 5; - until (time > $end) { - select undef, undef, undef, 0.01; - open my $fh, '<', $ino_fdinfo or - BAIL_OUT "$ino_fdinfo: $!"; - %prev = map { $_ => 1 } @ino_info; - @tmp = grep(/^inotify wd:/, <$fh>); - if (scalar(@tmp) == scalar(@ino_info)) { - delete @prev{@tmp}; - last if scalar(keys(%prev)) == @ino_info; - } - } - is(scalar @tmp, scalar @ino_info, - 'old inotify watches replaced'); - is(scalar keys %prev, scalar @ino_info, - 'no previous watches overlap'); - }; + for my $n (1..2) { # kick the event loop so we know HUP is done + my $m = $imap_client->new(%mic_opt); + ok($m->login && $m->IsAuthenticated && $m->logout, + "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'); @@ -375,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)); @@ -387,11 +367,13 @@ is(scalar keys %$ret, 3, 'got all 3 messages'); SKIP: { # do any clients use non-UID IMAP SEARCH? - skip 'Xapian missing', 2 if $level eq 'basic'; + skip 'Xapian missing', 3 if $level eq 'basic'; my $x = $mic->search('all'); is_deeply($x, [1, 2, 3], 'MSN SEARCH works before rm'); $x = $mic->search(qw(header subject embedded)); is_deeply($x, [2], 'MSN SEARCH on Subject works before rm'); + $x = $mic->search('FROM scraper@example.com'); + is_deeply($x, [], "MSN SEARCH miss won't trigger warnings"); } { @@ -455,22 +437,62 @@ 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]; - my ($ihost, $iport) = ($sock->sockhost, $sock->sockport); my $imapurl = "imap://$ihost:$iport/inbox.i1.0"; run_script($cmd) or BAIL_OUT("init $name"); xsys(qw(git config), "--file=$home/.public-inbox/config", @@ -479,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 @@ -507,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; @@ -524,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); @@ -549,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,13 +1,12 @@ -# Copyright (C) 2016-2020 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; use PublicInbox::Import; -use PublicInbox::Spawn qw(spawn); use Fcntl qw(:DEFAULT SEEK_SET); use PublicInbox::TestCommon; use MIME::Base64 3.05; # Perl 5.10.0 / 5.9.2 @@ -27,25 +26,19 @@ 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'); - my $raw_email = $smsg->{-raw_email}; - is($mime->as_string, $$raw_email, 'string matches'); - is($smsg->{raw_bytes}, length($$raw_email), 'length matches'); +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: $!"; $in->flush or die "flush failed: $!"; - seek($in, 0, SEEK_SET); - open my $out, '+<', undef or BAIL_OUT "open(+<): $!"; - my $pid = spawn(\@cmd, {}, { 0 => $in, 1 => $out }); - is(waitpid($pid, 0), $pid, 'waitpid succeeds on hash-object'); + seek($in, 0, SEEK_SET) or die "seek: $!"; + chomp(my $hashed_obj = xqx(\@cmd, undef, { 0 => $in })); is($?, 0, 'hash-object'); - seek($out, 0, SEEK_SET); - chomp(my $hashed_obj = <$out>); is($hashed_obj, $smsg->{blob}, "blob object_id matches exp"); } @@ -105,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'; }; @@ -1,4 +1,4 @@ -# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org> +# 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; @@ -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 e16ee11b..0ccffab7 100644 --- a/t/inbox_idle.t +++ b/t/inbox_idle.t @@ -1,59 +1,51 @@ #!perl -w -# Copyright (C) 2020 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_config = 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_config->each_inbox(sub { shift->subscribe_unlock($ident, $obj) }); - my $ii = PublicInbox::InboxIdle->new($pi_config); + $pi_cfg->each_inbox(sub { shift->subscribe_unlock($ident, $obj) }); + my $ii = PublicInbox::InboxIdle->new($pi_cfg); ok($ii, 'InboxIdle created'); SKIP: { 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_config->each_inbox(sub { shift->unsubscribe_unlock($ident) }); + $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 f9869cfa..eac2d650 100644 --- a/t/index-git-times.t +++ b/t/index-git-times.t @@ -1,43 +1,44 @@ #!perl -w -# Copyright (C) 2020 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::Import; 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 @@ -48,7 +49,7 @@ EOF print $w $data or die; close $w or die; my $cmd = ['git', "--git-dir=$v1dir", 'fast-import', '--quiet']; - PublicInbox::Import::run_die($cmd, undef, { 0 => $r }); + xsys_e($cmd, undef, { 0 => $r }); } run_script(['-index', '--skip-docdata', $v1dir]) or die 'v1 index failed'; @@ -57,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); @@ -73,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-v1.t b/t/indexlevels-mirror-v1.t index adcc93fd..a0cee72c 100644 --- a/t/indexlevels-mirror-v1.t +++ b/t/indexlevels-mirror-v1.t @@ -1,4 +1,4 @@ -# Copyright (C) 2019-2020 all contributors <meta@public-inbox.org> +# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> local $ENV{PI_TEST_VERSION} = 1; require './t/indexlevels-mirror.t'; diff --git a/t/indexlevels-mirror.t b/t/indexlevels-mirror.t index 656a9a34..c852f72c 100644 --- a/t/indexlevels-mirror.t +++ b/t/indexlevels-mirror.t @@ -1,13 +1,12 @@ -# Copyright (C) 2019-2020 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,9 +168,7 @@ my $import_index_incremental = sub { $import_index_incremental->($PI_TEST_VERSION, 'basic', $mime); SKIP: { - require PublicInbox::Search; - PublicInbox::Search::load_xapian() or - skip('Xapian perl binding missing', 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-2020 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; diff --git a/t/ipc.t b/t/ipc.t new file mode 100644 index 00000000..23ae2e7b --- /dev/null +++ b/t/ipc.t @@ -0,0 +1,195 @@ +#!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 Fcntl qw(SEEK_SET); +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 PublicInbox::SHA qw(sha1_hex); +sub test_array { qw(test array) } +sub test_scalar { 'scalar' } +sub test_scalarref { \'scalarref' } +sub test_undef { undef } +sub test_die { shift; die @_; 'unreachable' } +sub test_pid { $$ } +sub test_write_each_fd { + my ($self, @args) = @_; + for my $fd (0..2) { + print { $self->{$fd} } "i=$fd $$ ", @args, "\n"; + $self->{$fd}->flush; + } +} +sub test_sha { + my ($self, $buf) = @_; + print { $self->{1} } sha1_hex($buf), "\n"; + $self->{1}->flush; +} +sub test_append_pid { + my ($self, $file) = @_; + open my $fh, '>>', $file or die "open: $!"; + $fh->autoflush(1); + print $fh "$$\n" or die "print: $!"; +} +1; + +my $ipc = bless {}, 'PublicInbox::IPC'; +my @t = qw(array scalar scalarref undef); +my $test = sub { + my $x = shift; + for my $type (@t) { + my $m = "test_$type"; + my @ret = $ipc->ipc_do($m); + my @exp = $ipc->$m; + is_deeply(\@ret, \@exp, "wantarray $m $x"); + + $ipc->ipc_do($m); + + my $ret = $ipc->ipc_do($m); + my $exp = $ipc->$m; + is_deeply($ret, $exp, "!wantarray $m $x"); + } + my $ret = eval { $ipc->test_die('phail') }; + my $exp = $@; + $ret = eval { $ipc->ipc_do('test_die', 'phail') }; + my $err = $@; + my %lines; + for ($err, $exp) { + s/ line (\d+).*//s and $lines{$1}++; + } + is(scalar keys %lines, 1, 'line numbers match'); + is((values %lines)[0], 2, '2 hits on same line number'); + is($err, $exp, "$x die matches"); + is($ret, undef, "$x die did not return"); + + eval { $ipc->test_die(['arrayref']) }; + $exp = $@; + $ret = eval { $ipc->ipc_do('test_die', ['arrayref']) }; + $err = $@; + is_deeply($err, $exp, 'die with unblessed ref'); + is(ref($err), 'ARRAY', 'got an array ref'); + + $exp = bless ['blessed'], 'PublicInbox::WTF'; + $ret = eval { $ipc->ipc_do('test_die', $exp) }; + $err = $@; + is_deeply($err, $exp, 'die with blessed ref'); + is(ref($err), 'PublicInbox::WTF', 'got blessed ref'); +}; +$test->('local'); + +{ + my $pid = $ipc->ipc_worker_spawn('test worker'); + ok($pid > 0 && kill(0, $pid), 'worker spawned and running'); + defined($pid) or BAIL_OUT 'no spawn, no test'; + is($ipc->ipc_do('test_pid'), $pid, 'worker pid returned'); + $test->('worker'); + is($ipc->ipc_do('test_pid'), $pid, 'worker pid returned'); + $ipc->ipc_worker_stop; + ok(!kill(0, $pid) && $!{ESRCH}, 'worker stopped'); +} +$ipc->ipc_worker_stop; # idempotent + +# work queues +pipe(my ($ra, $wa)) or BAIL_OUT $!; +pipe(my ($rb, $wb)) or BAIL_OUT $!; +pipe(my ($rc, $wc)) or BAIL_OUT $!; +open my $warn, '+>', undef or BAIL_OUT; +$warn->autoflush(0); +local $SIG{__WARN__} = sub { print $warn "PID:$$ ", @_ }; +my @ppids; +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 ('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) { + my $buf = readline($fh); + is(chop($buf), "\n", "trailing CR ($t)"); + like($buf, qr/\Ai=$i \d+ hello world\z/, "got expected ($t)"); + $i++; + } + $ipc->wq_io_do('test_die', [ $wa, $wb, $wc ]); + $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; # to hit EMSGSIZE + $ipc->wq_io_do('test_sha', [ $wa, $wb ], $bigger); + my $exp = sha1_hex($bigger)."\n"; + 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)"); + } +} + +# wq_io_do works across fork (siblings can feed) +SKIP: { + skip 'Socket::MsgHdr or Inline::C missing', 3 if !$ppids[0]; + is_xdeeply(\@ppids, [$$, undef], + 'parent pid returned in wq_workers_start'); + my $pid = fork // BAIL_OUT $!; + if ($pid == 0) { + use POSIX qw(_exit); + $ipc->wq_io_do('test_write_each_fd', [ $wa, $wb, $wc ], $$); + _exit(0); + } else { + my $i = 0; + my ($wpid, @rest) = keys %{$ipc->{-wq_workers}}; + is(scalar(@rest), 0, 'only one worker'); + for my $fh ($ra, $rb, $rc) { + my $buf = readline($fh); + is(chop($buf), "\n", "trailing CR #$i"); + like($buf, qr/^i=$i $wpid $pid\z/, + 'got expected from sibling'); + $i++; + } + 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; +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), 2, 'warned 3 times'); + like($warn[0], qr/ wq_worker: /, '2nd warned from wq_worker'); + is($warn[0], $warn[1], 'worker did not die'); + + $SIG{__WARN__} = 'DEFAULT'; + is($ipc->wq_workers_start('wq', 2), $$, 'workers started again'); + $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'); +} + +done_testing; diff --git a/t/kqnotify.t b/t/kqnotify.t index c3557d3e..add477a4 100644 --- a/t/kqnotify.t +++ b/t/kqnotify.t @@ -1,37 +1,67 @@ #!perl -w -# Copyright (C) 2020 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 new file mode 100644 index 00000000..4670e47f --- /dev/null +++ b/t/lei-convert.t @@ -0,0 +1,221 @@ +#!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::MboxReader; +use PublicInbox::MdirReader; +use PublicInbox::NetReader; +use PublicInbox::Eml; +use IO::Uncompress::Gunzip; +use File::Path qw(remove_tree); +use PublicInbox::Spawn qw(which run_qx); +use File::Compare; +use autodie qw(open); +require_mods(qw(lei -imapd -nntpd Mail::IMAPClient Net::NNTP)); +my ($tmpdir, $for_destroy) = tmpdir; +my $sock = tcp_server; +my $cmd = [ '-imapd', '-W0', "--stdout=$tmpdir/i1", "--stderr=$tmpdir/i2" ]; +my ($ro_home, $cfg_path) = setup_public_inboxes; +my $env = { PI_CONFIG => $cfg_path }; +my $tdi = start_script($cmd, $env, { 3 => $sock }) or BAIL_OUT("-imapd: $?"); +my $imap_host_port = tcp_host_port($sock); +$sock = tcp_server; +$cmd = [ '-nntpd', '-W0', "--stdout=$tmpdir/n1", "--stderr=$tmpdir/n2" ]; +my $tdn = start_script($cmd, $env, { 3 => $sock }) or BAIL_OUT("-nntpd: $?"); +my $nntp_host_port = tcp_host_port($sock); +undef $sock; + +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://'); + + my (@mboxrd, @mboxcl2); + open my $fh, '<', "$d/foo.mboxrd" or BAIL_OUT $!; + PublicInbox::MboxReader->mboxrd($fh, sub { push @mboxrd, shift }); + ok(scalar(@mboxrd) > 1, 'got multiple messages'); + + open $fh, '<', "$d/nntp.mboxrd" or BAIL_OUT $!; + my $i = 0; + PublicInbox::MboxReader->mboxrd($fh, sub { + my ($eml) = @_; + is($eml->body, $mboxrd[$i]->body, "body matches #$i"); + $i++; + }); + + lei_ok('convert', '-o', "mboxcl2:$d/cl2", "mboxrd:$d/foo.mboxrd"); + ok(-s "$d/cl2", 'mboxcl2 non-empty') or diag $lei_err; + open $fh, '<', "$d/cl2" or BAIL_OUT $!; + PublicInbox::MboxReader->mboxcl2($fh, sub { + my $eml = shift; + $eml->header_set($_) for (qw(Content-Length Lines)); + push @mboxcl2, $eml; + }); + is_deeply(\@mboxcl2, \@mboxrd, 'mboxrd and mboxcl2 have same mail'); + + lei_ok('convert', '-o', "$d/md", "mboxrd:$d/foo.mboxrd"); + ok(-d "$d/md", 'Maildir created'); + my @md; + PublicInbox::MdirReader->new->maildir_each_eml("$d/md", sub { + push @md, $_[2]; + }); + 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 { + my $eml = PublicInbox::Eml->new(\($_->as_string)); + $eml->header_set('Status'); + $eml; + } @mboxrd; + is_deeply(\@md, \@rd_nostatus, 'Maildir output matches mboxrd'); + + my @bar; + lei_ok('convert', '-o', "mboxrd:$d/bar.mboxrd", "$d/md"); + open $fh, '<', "$d/bar.mboxrd" or BAIL_OUT $!; + PublicInbox::MboxReader->mboxrd($fh, sub { push @bar, shift }); + @bar = sort { ${$a->{bdy}} cmp ${$b->{bdy}} } @bar; + is_deeply(\@mboxrd, \@bar, + 'mboxrd round-tripped through Maildir w/ flags'); + + open my $in, '<', "$d/foo.mboxrd" or BAIL_OUT; + my $rdr = { 0 => $in, 1 => \(my $out), 2 => \$lei_err }; + lei_ok([qw(convert --stdin -F mboxrd -o mboxrd:/dev/stdout)], + undef, $rdr); + open $fh, '<', "$d/foo.mboxrd" or BAIL_OUT; + my $exp = do { local $/; <$fh> }; + is($out, $exp, 'stdin => stdout'); + + 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(Content-Length Lines)) { + ok(defined($eml->header_raw($h)), + "$h defined for mboxcl2"); + $eml->header_set($h); + } + push @bar, $eml; + }); + 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 new file mode 100644 index 00000000..d97e494a --- /dev/null +++ b/t/lei-daemon.t @@ -0,0 +1,83 @@ +#!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 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'); + lei_ok('daemon-pid'); + chomp(my $pid_again = $lei_out); + is($pid, $pid_again, 'daemon-pid idempotent'); + + 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'); + for (0..100) { + kill(0, $pid) or last; + tick(); + } + ok(-S $sock, 'sock still exists'); + ok(!kill(0, $pid), 'pid gone after stop'); + + lei_ok(qw(daemon-pid)); + chomp(my $new_pid = $lei_out); + ok(kill(0, $new_pid), 'new pid is running'); + ok(-S $sock, 'sock still exists'); + + for my $sig (qw(-0 -CHLD)) { + lei_ok('daemon-kill', $sig, \"handles $sig"); + } + is($lei_out.$lei_err, '', 'no output on innocuous signals'); + lei_ok('daemon-pid'); + chomp $lei_out; + is($lei_out, $new_pid, 'PID unchanged after -0/-CHLD'); + unlink $sock or BAIL_OUT "unlink($sock) $!"; + for (0..100) { + kill('CHLD', $new_pid) or last; + tick(); + } + ok(!kill(0, $new_pid), 'daemon exits after unlink'); +}); + +done_testing; 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 new file mode 100644 index 00000000..4f2dd6ba --- /dev/null +++ b/t/lei-externals.t @@ -0,0 +1,301 @@ +#!perl -w +# 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 PublicInbox::TestCommon; +use Fcntl qw(SEEK_SET); +require_git 2.6; +require_mods(qw(json DBD::SQLite Xapian)); +use POSIX qw(WTERMSIG WIFSIGNALED SIGPIPE); + +my @onions = map { "http://$_.onion/meta/" } qw( + 4uok3hntl7oi7b4uf4rtfwefqeexfzil2w6kgk2jn5z2f764irre7byd + ie5yzdi7fg72h7s4sdcztq5evakq23rdt33mfyfcddc5u3ndnw24ogqd + 7fh6tueqddpjyxjmgtdiueylzoqt6pt7hec3pukyptlmohoowvhde4yd); + +my $test_external_remote = sub { + my ($url, $k) = @_; +SKIP: { + 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") 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 + +my ($ro_home, $cfg_path) = setup_public_inboxes; +test_lei(sub { + my $home = $ENV{HOME}; + 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"); + 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); + $cfg->each_inbox(sub { + my ($ibx) = @_; + lei_ok(qw(add-external -q), $ibx->{inboxdir}, + \'added external'); + is($lei_out.$lei_err, '', 'no output'); + }); + ok(-s $config_file, 'add-external created config'); + my $lcfg = PublicInbox::Config->new($config_file); + $cfg->each_inbox(sub { + my ($ibx) = @_; + is($lcfg->{"external.$ibx->{inboxdir}.boost"}, 0, + "configured boost on $ibx->{name}"); + }); + lei_ok 'ls-external'; + like($lei_out, qr/boost=0\n/s, 'ls-external has output'); + lei_ok qw(add-external -q https://EXAMPLE.com/ibx), \'add remote'; + is($lei_err, '', 'no warnings after add-external'); + + { + lei_ok qw(ls-external --remote); + my $r_only = +{ map { $_ => 1 } split(/^/m, $lei_out) }; + lei_ok qw(ls-external --local); + my $l_only = +{ map { $_ => 1 } split(/^/m, $lei_out) }; + lei_ok 'ls-external'; + is_deeply([grep { $l_only->{$_} } keys %$r_only], [], + 'no locals in --remote'); + is_deeply([grep { $r_only->{$_} } keys %$l_only], [], + 'no remotes in --local'); + my $all = +{ map { $_ => 1 } split(/^/m, $lei_out) }; + is_deeply($all, { %$r_only, %$l_only }, + 'default output combines remote + local'); + lei_ok qw(ls-external --remote --local); + my $both = +{ map { $_ => 1 } split(/^/m, $lei_out) }; + is_deeply($all, $both, '--remote --local == no args'); + } + + 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 + https://example https://example. https://example.co + https://example.com https://example.com/ + https://example.com/i https://example.com/ibx)) { + lei_ok(qw(_complete lei forget-external), $u, + \"partial completion for URL $u"); + is($lei_out, "https://example.com/ibx/\n", + "completed partial URL $u"); + for my $qo (qw(-I --include --exclude --only)) { + lei_ok(qw(_complete lei q), $qo, $u, + \"partial completion for URL q $qo $u"); + is($lei_out, "https://example.com/ibx/\n", + "completed partial URL $u on q $qo"); + } + } + lei_ok(qw(_complete lei add-external), 'https://', + \'add-external hostname completion'); + is($lei_out, "https://example.com/\n", 'completed up to hostname'); + + lei_ok('ls-external'); + like($lei_out, qr!https://example\.com/ibx/!s, 'added canonical URL'); + is($lei_err, '', 'no warnings on ls-external'); + lei_ok(qw(forget-external -q https://EXAMPLE.com/ibx)); + lei_ok('ls-external'); + unlike($lei_out, qr!https://example\.com/ibx/!s, + 'removed canonical URL'); + + # 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'); + is($? >> 8, 1, 'errored out with exit 1'); + + ok(!lei(qw(q s:prefix -o), "mboxcl2:$home"), 'bad mbox'); + like($lei_err, qr!\Q$home\E exists and is not a writable file!, + 'error shown'); + is($? >> 8, 1, 'errored out with exit 1'); + + ok(!lei(qw(q s:prefix -o Mbox2:/dev/stdout)), 'bad format'); + like($lei_err, qr/bad mbox format: mbox2/, 'error shown'); + is($? >> 8, 1, 'errored out with exit 1'); + + # note, on a Bourne shell users should be able to use either: + # s:"use boolean prefix" + # "s:use boolean prefix" + # or use single quotes, it should not matter. Users only need + # to know shell quoting rules, not Xapian quoting rules. + # No double-quoting should be imposed on users on the CLI + lei_ok('q', 's:use boolean prefix'); + like($lei_out, qr/search: use boolean prefix/, + 'phrase search got result'); + my $res = json_utf8->decode($lei_out); + is(scalar(@$res), 2, 'only 2 element array (1 result)'); + is($res->[1], undef, 'final element is undef'); # XXX should this be? + is(ref($res->[0]), 'HASH', 'first element is hashref'); + lei_ok('q', '--pretty', 's:use boolean prefix'); + my $pretty = json_utf8->decode($lei_out); + is_deeply($res, $pretty, '--pretty is identical after decode'); + + { + open my $fh, '+>', undef or BAIL_OUT $!; + $fh->autoflush(1); + print $fh 's:use d:..5.days.from.now' or BAIL_OUT $!; + seek($fh, 0, SEEK_SET) or BAIL_OUT $!; + lei_ok([qw(q -q --stdin)], undef, { %$lei_opt, 0 => $fh }, + \'--stdin on regular file works'); + like($lei_out, qr/use boolean/, '--stdin on regular file'); + } + { + pipe(my ($r, $w)) or BAIL_OUT $!; + print $w 's:use' or BAIL_OUT $!; + close $w or BAIL_OUT $!; + lei_ok([qw(q -q --stdin)], undef, { %$lei_opt, 0 => $r }, + \'--stdin on pipe file works'); + 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'); + is($lei_out, json_utf8->encode($pretty->[0])."\n", "-f $fmt"); + } + + require IO::Uncompress::Gunzip; + for my $sfx ('', '.gz') { + my $f = "$home/mbox$sfx"; + lei_ok('q', '-o', "mboxcl2:$f", 's:use boolean prefix'); + my $cat = $sfx eq '' ? sub { + open my $mb, '<', $f or fail "no mbox: $!"; + <$mb> + } : sub { + my $z = IO::Uncompress::Gunzip->new($f, MultiStream=>1); + <$z>; + }; + my @s = grep(/^Subject:/, $cat->()); + is(scalar(@s), 1, "1 result in mbox$sfx"); + lei_ok('q', '-a', '-o', "mboxcl2:$f", 's:see attachment'); + is(grep(!/^#/, $lei_err), 0, 'no errors from augment') or + diag $lei_err; + @s = grep(/^Subject:/, my @wtf = $cat->()); + 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)") + or diag $lei_err; + + my @s2 = grep(/^Subject:/, $cat->()); + is_deeply(\@s2, \@s, + "same 2 old results w/ --augment and bad search $sfx"); + + lei_ok('q', '-o', "mboxcl2:$f", 's:nonexistent'); + my @res = $cat->(); + is_deeply(\@res, [], "clobber w/o --augment $sfx"); + } + 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"); + } + + { + 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'); + + # we are more flexible than git, here: + lei_ok(@q, '-C', $home); + is(unlink("$home/rel.mboxcl2"), 1, '-C works after q'); + mkdir "$home/deep" or BAIL_OUT $!; + lei_ok('-C', $home, @q, '-C', 'deep'); + is(unlink("$home/deep/rel.mboxcl2"), 1, 'multiple -C works'); + + lei_ok('-C', '', '-C', $home, @q, '-C', 'deep', '-C', ''); + is(unlink("$home/deep/rel.mboxcl2"), 1, "-C '' accepted"); + ok(!-f "$home/rel.mboxcl2", 'wrong path not created'); + } + my %e = ( + TEST_LEI_EXTERNAL_HTTPS => 'https://public-inbox.org/meta/', + TEST_LEI_EXTERNAL_ONION => $onions[int(rand(scalar(@onions)))], + ); + for my $k (keys %e) { + my $url = $ENV{$k} // ''; + $url = $e{$k} if $url eq '1'; + $test_external_remote->($url, $k); + } +}); # 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 new file mode 100644 index 00000000..3b6cb299 --- /dev/null +++ b/t/lei-import-imap.t @@ -0,0 +1,118 @@ +#!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 -imapd Mail::IMAPClient)); +my ($ro_home, $cfg_path) = setup_public_inboxes; +my ($tmpdir, $for_destroy) = tmpdir; +my $sock = tcp_server; +my $cmd = [ '-imapd', '-W0', "--stdout=$tmpdir/1", "--stderr=$tmpdir/2" ]; +my $env = { PI_CONFIG => $cfg_path }; +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 { + 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('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 new file mode 100644 index 00000000..1e7eddd5 --- /dev/null +++ b/t/lei-import-maildir.t @@ -0,0 +1,79 @@ +#!perl -w +# 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 PublicInbox::TestCommon; +use Cwd qw(abs_path); +test_lei(sub { + my $md = "$ENV{HOME}/md"; + for ($md, "$md/new", "$md/cur", "$md/tmp") { + mkdir($_) or BAIL_OUT("mkdir $_: $!"); + } + symlink(abs_path('t/data/0001.patch'), "$md/cur/x:2,S") or + BAIL_OUT "symlink $md $!"; + 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') + 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') + 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 new file mode 100644 index 00000000..14c644e0 --- /dev/null +++ b/t/lei-import-nntp.t @@ -0,0 +1,116 @@ +#!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_git 2.6; +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; +my $cmd = [ '-nntpd', '-W0', "--stdout=$tmpdir/1", "--stderr=$tmpdir/2" ]; +my $env = { PI_CONFIG => $cfg_path }; +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 z:1..)); + my $out = json_utf8->decode($lei_out); + is_deeply($out, [ undef ], 'nothing imported, yet'); + 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 new file mode 100644 index 00000000..89eb1492 --- /dev/null +++ b/t/lei-import.t @@ -0,0 +1,232 @@ +#!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::DS qw(now); +use PublicInbox::IO qw(write_file); +use autodie qw(open close truncate); +test_lei(sub { +ok(!lei(qw(import -F bogus), 't/plack-qp.eml'), 'fails with bogus format'); +like($lei_err, qr/\bis `eml', not --in-format/, 'gave error message'); + +lei_ok(qw(q s:boolean), \'search miss before import'); +unlike($lei_out, qr/boolean/i, 'no results, yet'); +open my $fh, '<', 't/data/0001.patch'; +lei_ok([qw(import -F eml -)], undef, { %$lei_opt, 0 => $fh }, + \'import single file from stdin') or diag $lei_err; +close $fh; +lei_ok(qw(q s:boolean), \'search hit after import'); +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; + PublicInbox::MboxReader->mboxrd($fh, sub { + my ($eml) = @_; + $eml->header_set('Status'); + push @cmp, $eml; + }); + is_deeply(\@cmp, $expect, 'got expected message in mboxrd'); +} +lei_ok(qw(import -F eml), 't/data/message_embed.eml', + \'import single file by path'); + +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 => \$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($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'); + + +$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($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*" +}); +done_testing; 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 new file mode 100644 index 00000000..76041b73 --- /dev/null +++ b/t/lei-mirror.t @@ -0,0 +1,222 @@ +#!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::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 ./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'); + 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'); + $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 new file mode 100644 index 00000000..885fa3e1 --- /dev/null +++ b/t/lei-q-remote-import.t @@ -0,0 +1,114 @@ +#!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(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; +my ($tmpdir, $for_destroy) = tmpdir; +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); +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]; + my @eml; + PublicInbox::MboxReader->mboxrd($fh, sub { + my $eml = shift; + $eml->header_set('Status'); + push @eml, $eml; + }); + \@eml; +}; + +test_lei({ tmpdir => $tmpdir }, sub { + my $o = "$ENV{HOME}/o.mboxrd"; + my @cmd = ('q', '-o', "mboxrd:$o", 'm:qp@example.com'); + lei_ok(@cmd); + ok(-f $o && !-s _, 'output exists but is empty'); + unlink $o; + lei_ok(@cmd, '-I', $url); + is_deeply($slurp_emls->($o), $exp1, 'got results after remote search'); + unlink $o; + lei_ok(@cmd); + ok(-f $o && -s _, 'output exists after import but is not empty') or + diag $lei_err; + is_deeply($slurp_emls->($o), $exp1, 'got results w/o remote search'); + unlink $o; + + $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; + 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; diff --git a/t/lei.t b/t/lei.t new file mode 100644 index 00000000..1dbc9d4c --- /dev/null +++ b/t/lei.t @@ -0,0 +1,215 @@ +#!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 'lei'; +use File::Path qw(rmtree); + +# this only tests the basic help/config/init/completion bits of lei; +# actual functionality is tested in other t/lei-*.t tests +my $home; +my $home_trash = []; +my $cleanup = sub { rmtree([@$home_trash, @_]) }; + +my $test_help = sub { + ok(!lei([]), 'no args fails'); + is($? >> 8, 1, '$? is 1'); + is($lei_out, '', 'nothing in stdout'); + like($lei_err, qr/^usage:/sm, 'usage in stderr'); + + for my $arg (['-h'], ['--help'], ['help'], [qw(daemon-pid --help)]) { + lei_ok($arg); + like($lei_out, qr/^usage:/sm, "usage in stdout (@$arg)"); + is($lei_err, '', "nothing in stderr (@$arg)"); + } + + for my $arg ([''], ['--halp'], ['halp'], [qw(daemon-pid --halp)]) { + ok(!lei($arg), "lei @$arg"); + is($? >> 8, 1, '$? set correctly'); + isnt($lei_err, '', 'something in stderr'); + is($lei_out, '', 'nothing in stdout'); + } + lei_ok(qw(init -h)); + like($lei_out, qr! \Q$home\E/\.local/share/lei/store\b!, + 'actual path shown in init -h'); + lei_ok(qw(init -h), { XDG_DATA_HOME => '/XDH' }, + \'init with XDG_DATA_HOME'); + like($lei_out, qr! /XDH/lei/store\b!, 'XDG_DATA_HOME in init -h'); + is($lei_err, '', 'no errors from init -h'); + + 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 { + my ($msg) = @_; + is(grep(!/^#/, split(/^/, $lei_err)), 0, $msg) or + diag "$msg: err=$lei_err"; +}; + +my $test_init = sub { + $cleanup->(); + lei_ok('init', \'init w/o args'); + $ok_err_info->('after init w/o args'); + lei_ok('init', \'idempotent init w/o args'); + $ok_err_info->('after idempotent init w/o args'); + + ok(!lei('init', "$home/x"), 'init conflict'); + is(grep(/^E:/, split(/^/, $lei_err)), 1, 'got error on conflict'); + ok(!-e "$home/x", 'nothing created on conflict'); + $cleanup->(); + + lei_ok('init', "$home/x", \'init conflict resolved'); + $ok_err_info->('init w/ arg'); + lei_ok('init', "$home/x", \'init idempotent w/ path'); + $ok_err_info->('init idempotent w/ arg'); + ok(-d "$home/x", 'created dir'); + $cleanup->("$home/x"); + + ok(!lei('init', "$home/x", "$home/2"), 'too many args fails'); + like($lei_err, qr/too many/, 'noted excessive'); + ok(!-e "$home/x", 'x not created on excessive'); + for my $d (@$home_trash) { + my $base = (split(m!/!, $d))[-1]; + ok(!-d $d, "$base not created"); + } + is($lei_out, '', 'nothing in stdout on init failure'); +}; + +my $test_config = sub { + $cleanup->(); + lei_ok(qw(config a.b c), \'config set var'); + is($lei_out.$lei_err, '', 'no output on var set'); + lei_ok(qw(config -l), \'config -l'); + is($lei_err, '', 'no errors on listing'); + is($lei_out, "a.b=c\n", 'got expected output'); + ok(!lei(qw(config -f), "$home/.config/f", qw(x.y z)), + '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 { + lei_ok(qw(_complete lei), \'no errors on complete'); + my %out = map { $_ => 1 } split(/\s+/s, $lei_out); + ok($out{'q'}, "`lei q' offered as completion"); + ok($out{'add-external'}, "`lei add-external' offered as completion"); + + lei_ok(qw(_complete lei q), \'complete q (no args)'); + %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 --no-save --no-remote --remote --torsocks + --reverse -r )) { + ok($out{$sw}, "$sw offered as `lei q' completion"); + } + + lei_ok(qw(_complete lei q --form), \'complete q --format'); + is($lei_out, "--format\n", 'complete lei q --format'); + for my $sw (qw(-f --format)) { + lei_ok(qw(_complete lei q), $sw); + %out = map { $_ => 1 } split(/\s+/s, $lei_out); + for my $f (qw(mboxrd mboxcl2 mboxcl mboxo json jsonl + concatjson maildir)) { + ok($out{$f}, "got $sw $f as output format"); + } + } + lei_ok(qw(_complete lei import)); + %out = map { $_ => 1 } split(/\s+/s, $lei_out); + for my $sw (qw(--no-kw --kw)) { + ok($out{$sw}, "$sw offered as `lei import' completion"); + } +}; + +my $test_fail = sub { + lei('q', 'whatever', '-C', '/dev/null'); + 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 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') or + diag $lei_err; + is($lei_out, '', 'no output'); +}; # /SKIP +}; + +test_lei(sub { + $home = $ENV{HOME}; + $home_trash = [ "$home/.local", "$home/.config", "$home/junk" ]; + $test_help->(); + $test_config->(); + $test_init->(); + $test_completion->(); + $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 new file mode 100644 index 00000000..13fc1f3b --- /dev/null +++ b/t/lei_dedupe.t @@ -0,0 +1,93 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use v5.10.1; +use Test::More; +use PublicInbox::TestCommon; +use PublicInbox::Eml; +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); +my $smsg = bless { ds => time }, 'PublicInbox::Smsg'; +$smsg->populate($eml); +$smsg->{$_} //= '' for (qw(to cc references)) ; + +my $check_storable = sub { + my ($x) = @_; + SKIP: { + require_mods('Storable', 1); + my $dup = Storable::thaw(Storable::freeze($x)); + is_deeply($dup, $x, "$x->[3] round-trips through storable"); + } +}; + +my $lei = { opt => { dedupe => 'none' } }; +my $dd = PublicInbox::LeiDedupe->new($lei); +$check_storable->($dd); +$dd->prepare_dedupe; +ok(!$dd->is_dup($eml), '1st is_dup w/o dedupe'); +ok(!$dd->is_dup($eml), '2nd is_dup w/o dedupe'); +ok(!$dd->is_dup($different), 'different is_dup w/o dedupe'); +ok(!$dd->is_smsg_dup($smsg), 'smsg dedupe none 1'); +ok(!$dd->is_smsg_dup($smsg), 'smsg dedupe none 2'); + +for my $strat (undef, 'content') { + $lei->{opt}->{dedupe} = $strat; + $dd = PublicInbox::LeiDedupe->new($lei); + $check_storable->($dd); + $dd->prepare_dedupe; + my $desc = $strat // 'default'; + ok(!$dd->is_dup($eml), "1st is_dup with $desc dedupe"); + ok($dd->is_dup($eml), "2nd seen with $desc dedupe"); + 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) }; +like($@, qr/unsupported.*bogus/, 'died on bogus strategy'); + +$lei->{opt}->{dedupe} = 'mid'; +$dd = PublicInbox::LeiDedupe->new($lei); +$check_storable->($dd); +$dd->prepare_dedupe; +ok(!$dd->is_dup($eml), '1st is_dup with mid dedupe'); +ok($dd->is_dup($eml), '2nd seen with mid dedupe'); +ok($dd->is_dup($different), 'different seen with mid dedupe'); +ok(!$dd->is_smsg_dup($smsg), 'smsg mid dedupe pass'); +ok($dd->is_smsg_dup($smsg), 'smsg mid dedupe reject'); + +$lei->{opt}->{dedupe} = 'oid'; +$dd = PublicInbox::LeiDedupe->new($lei); +$check_storable->($dd); +$dd->prepare_dedupe; + +# --augment won't have OIDs: +ok(!$dd->is_dup($eml), '1st is_dup with oid dedupe (augment)'); +ok($dd->is_dup($eml), '2nd seen with oid dedupe (augment)'); +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'); + +$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'); +ok($dd->is_smsg_dup($smsg), 'smsg dedupe reject'); + +done_testing; diff --git a/t/lei_external.t b/t/lei_external.t new file mode 100644 index 00000000..573cbc60 --- /dev/null +++ b/t/lei_external.t @@ -0,0 +1,19 @@ +#!perl -w +# 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 v5.12; use Test::More; +my $cls = 'PublicInbox::LeiExternal'; +require_ok $cls; +my $canon = $cls->can('ext_canonicalize'); +my $exp = 'https://example.com/my-inbox/'; +is($canon->('https://example.com/my-inbox'), $exp, 'trailing slash added'); +is($canon->('https://example.com/my-inbox//'), $exp, 'trailing slash removed'); +is($canon->('https://example.com//my-inbox/'), $exp, 'leading slash removed'); +is($canon->('https://EXAMPLE.com/my-inbox/'), $exp, 'lowercased'); +is($canon->('/this/path/is/nonexistent/'), '/this/path/is/nonexistent', + 'non-existent pathname canonicalized'); +is($canon->('/this//path/'), '/this/path', 'extra slashes gone'); +is($canon->('/ALL/CAPS'), '/ALL/CAPS', 'caps preserved'); + +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 new file mode 100644 index 00000000..b4181ffd --- /dev/null +++ b/t/lei_overview.t @@ -0,0 +1,34 @@ +#!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 Test::More; +use PublicInbox::TestCommon; +use POSIX qw(_exit); +require_mods(qw(Xapian DBD::SQLite)); +require_ok 'PublicInbox::LeiOverview'; + +my $ovv = bless {}, 'PublicInbox::LeiOverview'; +$ovv->ovv_out_lk_init; +my $lock_path = $ovv->{lock_path}; +ok(-f $lock_path, 'lock init'); +undef $ovv; +ok(!-f $lock_path, 'lock DESTROY'); + +$ovv = bless {}, 'PublicInbox::LeiOverview'; +$ovv->ovv_out_lk_init; +$lock_path = $ovv->{lock_path}; +ok(-f $lock_path, 'lock init #2'); +my $pid = fork // BAIL_OUT "fork $!"; +if ($pid == 0) { + undef $ovv; + _exit(0); +} +is(waitpid($pid, 0), $pid, 'child exited'); +is($?, 0, 'no error in child process'); +ok(-f $lock_path, 'lock was not destroyed by child'); +undef $ovv; +ok(!-f $lock_path, 'lock DESTROY #2'); + +done_testing; 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 new file mode 100644 index 00000000..17ee0729 --- /dev/null +++ b/t/lei_store.t @@ -0,0 +1,155 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use v5.10.1; +use Test::More; +use PublicInbox::TestCommon; +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/sto"; +local $ENV{GIT_COMMITTER_EMAIL} = 'lei@example.com'; +local $ENV{GIT_COMMITTER_NAME} = 'lei user'; +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($sto->add_eml($eml), undef, 'idempotent'); +$sto->done; +{ + 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'); + my $mset = $es->mset("mid:$msgs->[0]->{mid}"); + is($mset->size, 1, 'search works'); + is_deeply($es->mset_to_artnums($mset), [ $msgs->[0]->{num} ], + 'mset_to_artnums'); + 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) { + $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'); + $sto->done; + my @kw = $sto->search->msg_keywords($docids->[0]); + is_deeply(\@kw, [qw(draft seen)], 'kw matches'); + + $docids = $sto->add_eml_vmd($eml, {kw => [qw(seen draft)]}); + $sto->done; + is(scalar @$docids, 1, 'idempotently added keywords to doc'); + @kw = $sto->search->msg_keywords($docids->[0]); + is_deeply(\@kw, [qw(draft seen)], 'kw matches after noop'); + + $docids = $sto->remove_eml_vmd($eml, {kw => [qw(seen draft)]}); + is(scalar @$docids, 1, 'removed from one doc'); + $sto->done; + @kw = $sto->search->msg_keywords($docids->[0]); + is_deeply(\@kw, [], 'kw matches after remove'); + + $docids = $sto->remove_eml_vmd($eml, {kw=> [qw(answered)]}); + is(scalar @$docids, 1, 'removed from one doc (idempotently)'); + $sto->done; + @kw = $sto->search->msg_keywords($docids->[0]); + is_deeply(\@kw, [], 'kw matches after remove (idempotent)'); + + $docids = $sto->add_eml_vmd($eml, {kw => [qw(answered)]}); + is(scalar @$docids, 1, 'added to empty doc'); + $sto->done; + @kw = $sto->search->msg_keywords($docids->[0]); + is_deeply(\@kw, ['answered'], 'kw matches after add'); + + $docids = $sto->set_eml_vmd($eml, { kw => [] }); + is(scalar @$docids, 1, 'set to clobber'); + $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 = $sto->set_eml($set, { kw => [ 'seen' ] }); + is(ref $ret, 'PublicInbox::Smsg', 'initial returns smsg'); + my $ids = $sto->set_eml($set, { kw => [ 'seen' ] }); + is_deeply($ids, [ $ret->{num} ], 'set_eml idempotent'); + $ids = $sto->set_eml($set, { kw => [ qw(seen answered) ] }); + is_deeply($ids, [ $ret->{num} ], 'set_eml to change kw'); + $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($sto->can('ipc_do'), 'ipc_do works if we have Storable'); + $eml->header_set('Message-ID', '<ipc-test@example>'); + my $pid = $sto->ipc_worker_spawn('lei-store'); + ok($pid > 0, 'got a worker'); + my $smsg = $sto->ipc_do('set_eml', $eml, { kw => [ qw(seen) ] }); + is(ref($smsg), 'PublicInbox::Smsg', 'set_eml works over ipc'); + 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 = $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 = $sto->ipc_do('set_eml', $eml, { kw => [ qw(seen) ] }); + is_deeply($ids, [ $no_mid->{num} ], 'docid returned w/o mid w/ ipc'); + $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 = $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 new file mode 100644 index 00000000..dbd33909 --- /dev/null +++ b/t/lei_to_mail.t @@ -0,0 +1,293 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +# tests PublicInbox::LeiToMail internals (unstable API) +# Not as needed now that lei functionality has been ironed out +use v5.12; +use autodie qw(open sysopen unlink); +use PublicInbox::TestCommon; +use PublicInbox::Eml; +use Fcntl qw(SEEK_SET O_RDONLY O_NONBLOCK); +use PublicInbox::Spawn qw(popen_rd); +use List::Util qw(shuffle); +require_mods(qw(DBD::SQLite)); +require PublicInbox::MdirReader; +require PublicInbox::MboxReader; +require PublicInbox::LeiOverview; +require PublicInbox::LEI; +use_ok 'PublicInbox::LeiToMail'; +my $from = "Content-Length: 10\nSubject: x\n\nFrom hell\n"; +my $noeol = "Subject: x\n\nFrom hell"; +my $crlf = $noeol; +$crlf =~ s/\n/\r\n/g; +my $kw = [qw(seen answered flagged)]; +my $smsg = { kw => $kw, blob => '0'x40 }; +my @MBOX = qw(mboxcl2 mboxrd mboxcl mboxo); +for my $mbox (@MBOX) { + my $m = "eml2$mbox"; + my $cb = PublicInbox::LeiToMail->can($m); + 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'), '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"); + } else { + like($eml->body_raw, qr/^>From /, "From escaped once by $m"); + } + my @cl = $eml->header('Content-Length'); + if ($mbox =~ /mboxcl/) { + is(scalar(@cl), 1, "$m only has one Content-Length header"); + is($cl[0] + length("\n"), + length($eml->body_raw), "$m Content-Length matches"); + } else { + is(scalar(@cl), 0, "$m clobbered Content-Length"); + } + $s = $cb->(PublicInbox::Eml->new($noeol), $smsg); + is(substr($$s, -1, 1), "\n", + "trailing LF added by $m when original lacks EOL"); + $eml = PublicInbox::Eml->new($s); + if ($mbox eq 'mboxcl2') { + is($eml->body_raw, "From hell\n", "From not escaped by $m"); + } else { + is($eml->body_raw, ">From hell\n", "From escaped once by $m"); + } + $s = $cb->(PublicInbox::Eml->new($crlf), $smsg); + is(substr($$s, -2, 2), "\r\n", + "trailing CRLF added $m by original lacks EOL"); + $eml = PublicInbox::Eml->new($s); + if ($mbox eq 'mboxcl2') { + is($eml->body_raw, "From hell\r\n", "From not escaped by $m"); + } else { + is($eml->body_raw, ">From hell\r\n", "From escaped once by $m"); + } + if ($mbox =~ /mboxcl/) { + is($eml->header('Content-Length') + length("\r\n"), + length($eml->body_raw), "$m Content-Length matches"); + } elsif ($mbox eq 'mboxrd') { + $s = $cb->($eml, $smsg); + $eml = PublicInbox::Eml->new($s); + is($eml->body_raw, + ">>From hell\r\n\r\n", "From escaped again by $m"); + } +} + +my ($tmpdir, $for_destroy) = tmpdir(); +local $ENV{TMPDIR} = $tmpdir; +open my $err, '>>', "$tmpdir/lei.err"; +my $lei = bless { 2 => $err, cmd => 'test' }, 'PublicInbox::LEI'; +my $commit = sub { + $_[0] = undef; # wcb + delete $lei->{1}; +}; +my $buf = <<'EOM'; +From: x@example.com +Subject: x + +blah +EOM +my $fn = "$tmpdir/x.mbox"; +my ($mbox) = shuffle(@MBOX); # pick one, shouldn't matter +my $wcb_get = sub { + my ($fmt, $dst) = @_; + delete $lei->{dedupe}; # to be recreated + $lei->{ovv} = bless { + fmt => $fmt, + dst => $dst + }, 'PublicInbox::LeiOverview'; + my $l2m = PublicInbox::LeiToMail->new($lei); + SKIP: { + require_mods('Storable', 1); + my $dup = Storable::thaw(Storable::freeze($l2m)); + is_deeply($dup, $l2m, "$fmt round-trips through storable"); + } + $l2m->pre_augment($lei); + $l2m->do_augment($lei); + $l2m->post_augment($lei); + $l2m->write_cb($lei); +}; + +my $deadbeef = { blob => 'deadbeef', kw => [ qw(seen) ] }; +my $orig = do { + my $wcb = $wcb_get->($mbox, $fn); + is(ref $wcb, 'CODE', 'write_cb returned callback'); + ok(-f $fn && !-s _, 'empty file created'); + $wcb->(\(my $dup = $buf), $deadbeef); + $commit->($wcb); + open my $fh, '<', $fn; + my $raw = do { local $/; <$fh> }; + like($raw, qr/^blah\n/sm, 'wrote content'); + unlink $fn; + + $wcb = $wcb_get->($mbox, $fn); + ok(-f $fn && !-s _, 'truncated mbox destination'); + $wcb->(\($dup = $buf), $deadbeef); + $commit->($wcb); + open $fh, '<', $fn; + is(do { local $/; <$fh> }, $raw, 'wrote identical content'); + $raw; +}; + +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; + is_deeply($x->{'kw'}, ['seen'], 'kw imported') or diag $lei_out; + is($res->[1], undef, 'only one result'); +}); + +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); + my $x = $res->[0]; + is($x->{'s'}, 'x', 'subject imported') or diag $lei_out; + is_deeply($x->{'kw'}, ['seen'], 'kw imported') or diag $lei_out; + is($res->[1], undef, 'only one result'); +}); + +my $zsfx2cmd = PublicInbox::MboxReader->can('zsfx2cmd'); +for my $zsfx (qw(gz bz2 xz)) { + SKIP: { + my $cmd = eval { $zsfx2cmd->($zsfx, 0, $lei) }; + skip $@, 3 if $@; + my $dc_cmd = eval { $zsfx2cmd->($zsfx, 1, $lei) }; + ok($dc_cmd, "decompressor for .$zsfx"); + my $f = "$fn.$zsfx"; + my $wcb = $wcb_get->($mbox, $f); + $wcb->(\(my $dup = $buf), { %$deadbeef }); + $commit->($wcb); + my $uncompressed = xqx([@$dc_cmd, $f]); + is($uncompressed, $orig, "$zsfx works unlocked"); + + unlink $f; + $wcb = $wcb_get->($mbox, $f); + $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 }); + $commit->($wcb); + + my $cat = popen_rd([@$dc_cmd, $f]); + my @raw; + PublicInbox::MboxReader->$mbox($cat, + sub { push @raw, shift->as_string }); + 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 }; + $wcb = $wcb_get->($mbox, $f); + $wcb->(\($dup = $buf . "\ny\n"), { %$deadbeef }); + $commit->($wcb); + + my @raw3; + $cat = popen_rd([@$dc_cmd, $f]); + PublicInbox::MboxReader->$mbox($cat, + sub { push @raw3, shift->as_string }); + my $y = pop @raw3; + is_deeply(\@raw3, \@raw, 'previous messages preserved'); + like($y, qr/\nblah\n\ny\n\z/s, "augmented $zsfx (atomic)"); + } +} + +my $as_orig = sub { + my ($eml) = @_; + $eml->header_set('Status'); + $eml->as_string; +}; + +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; + PublicInbox::MboxReader->mboxo($fh, sub { $cmp .= $as_orig->(@_) }); + is($cmp, $buf, 'only one message written'); + + local $lei->{opt} = { augment => 1 }; + $wcb = $wcb_get->('mboxo', $fn); + $wcb->(\($x = $buf . "\nx\n"), $deadbeef) for (1..2); + $commit->($wcb); + open $fh, '<', $fn; + my @x; + PublicInbox::MboxReader->mboxo($fh, sub { push @x, $as_orig->(@_) }); + is(scalar(@x), 2, 'augmented mboxo'); + is($x[0], $cmp, 'original message preserved'); + is($x[1], $buf . "\nx\n", 'new message appended'); +} + +{ # stdout support + 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); + my $cmp = ''; + PublicInbox::MboxReader->mboxrd($tmp, sub { $cmp .= $as_orig->(@_) }); + is($cmp, $buf, 'message written to stdout'); +} + +SKIP: { # FIFO support + use POSIX qw(mkfifo); + my $fn = "$tmpdir/fifo"; + mkfifo($fn, 0600) or skip("mkfifo not supported: $!", 1); + sysopen(my $cat, $fn, O_RDONLY|O_NONBLOCK); + 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 $mdr = PublicInbox::MdirReader->new; + my $md = "$tmpdir/maildir/"; + my $wcb = $wcb_get->('maildir', $md); + is(ref($wcb), 'CODE', 'got Maildir callback'); + my $b4dc0ffee = { blob => 'badc0ffee', kw => [] }; + $wcb->(\(my $x = $buf), $b4dc0ffee); + + my @f; + $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); + my $deadcafe = { blob => 'deadcafe', kw => [] }; + $wcb->(\($x = $buf."\nx\n"), $deadcafe); + + my @x = (); + $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]; + is(do { local $/; <$fh> }, $buf."\nx\n", 'wrote new file to Maildir'); + + local $lei->{opt}->{augment} = 1; + $wcb = $wcb_get->('maildir', $md); + $wcb->(\($x = $buf."\ny\n"), $deadcafe); + $wcb->(\($x = $buf."\ny\n"), $b4dc0ffee); # skipped by dedupe + @f = (); + $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]; + is(do { local $/; <$fh> }, $buf."\nx\n", 'old file untouched'); + open $fh, '<', $new[0]; + is(do { local $/; <$fh> }, $buf."\ny\n", 'new file written'); +} + +done_testing; diff --git a/t/lei_xsearch.t b/t/lei_xsearch.t new file mode 100644 index 00000000..977fb1e9 --- /dev/null +++ b/t/lei_xsearch.t @@ -0,0 +1,109 @@ +#!perl -w +# 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 List::Util qw(shuffle); +use PublicInbox::TestCommon; +use PublicInbox::Eml; +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) { + 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 +Subject: v${V}i${i}j$j +Message-ID: <v${V}i${i}j$j\@example> + +${V}er ${i}on j$j +EOM + $im->add($eml) or BAIL_OUT '->add'; + } + }); # create_inbox + } +} +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); +$eidx->eidx_sync({fsync => 0}); +my $es = PublicInbox::ExtSearch->new("$home/eidx"); +my $lxs = PublicInbox::LeiXSearch->new; +for my $ibxish (shuffle($es, @ibx)) { + $lxs->prepare_external($ibxish); +} +for my $loc ($lxs->locals) { + $lxs->attach_external($loc); +} +my $nr = $lxs->xdb->get_doccount; +my $mset = $lxs->mset('d:19931002..19931003', { limit => $nr }); +is($mset->size, $nr, 'got all messages'); +my @msgs; +for my $mi ($mset->items) { + if (my $smsg = $lxs->smsg_for($mi)) { + push @msgs, $smsg; + } else { + diag "E: ${\$mi->get_docid} missing"; + } +} +is(scalar(@msgs), $nr, 'smsgs retrieved for all'); + +$mset = $lxs->mset('z:1..', { relevance => -2, limit => 1 }); +is($mset->size, 1, 'one result'); + +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 34840410..9280fd91 100644 --- a/t/linkify.t +++ b/t/linkify.t @@ -1,4 +1,4 @@ -# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org> +# 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; @@ -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 new file mode 100644 index 00000000..14248a2d --- /dev/null +++ b/t/mbox_reader.t @@ -0,0 +1,151 @@ +#!perl -w +# 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 List::Util qw(shuffle); +use PublicInbox::Eml; +use Fcntl qw(SEEK_SET); +require_ok 'PublicInbox::MboxReader'; +require_ok 'PublicInbox::LeiToMail'; +my %raw = ( + hdr_only => "From: header-only\@example.com\n\n", + small_from => "From: small-from\@example.com\n\nFrom hell\n", + small => "From: small\@example.com\n\nfrom hell\n", + big_hdr_only => "From: big-header\@example.com\n" . + (('A: '.('a' x 72)."\n") x 1000)."\n", + big_body => "From: big-body\@example.com\n\n". + (('b: '.('b' x 72)."\n") x 1000) . + "From hell\n", + big_all => "From: big-all\@example.com\n". + (("A: ".('a' x 72)."\n") x 1000). "\n" . + (("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}')) { + $raw{$fn} = eml_load($fn)->as_string; + } +} + +my $reader = PublicInbox::MboxReader->new; +my $check_fmt = sub { + my $fmt = shift; + my @order = shuffle(keys %raw); + my $eml2mbox = PublicInbox::LeiToMail->can("eml2$fmt"); + open my $fh, '+>', undef or BAIL_OUT "open: $!"; + for my $k (@order) { + my $eml = PublicInbox::Eml->new($raw{$k}); + my $buf = $eml2mbox->($eml); + print $fh $$buf or BAIL_OUT "print $!"; + } + seek($fh, 0, SEEK_SET) or BAIL_OUT "seek: $!"; + $reader->$fmt($fh, sub { + my ($eml) = @_; + $eml->header_set('Status'); + $eml->header_set('Lines'); + my $cur = shift @order; + my @cl = $eml->header_raw('Content-Length'); + if ($fmt =~ /\Amboxcl/) { + is(scalar(@cl), 1, "Content-Length set $fmt $cur"); + my $raw = $eml->body_raw; + my $adj = 0; + if ($fmt eq 'mboxcl') { + my @from = ($raw =~ /^(From )/smg); + $adj = scalar(@from); + } + is(length($raw), $cl[0] - $adj, + "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"); + } + my $orig = PublicInbox::Eml->new($raw{$cur}); + is($eml->as_string, $orig->as_string, + "read back original $fmt $cur"); + }); +}; +my @mbox = qw(mboxrd mboxo mboxcl mboxcl2); +for my $fmt (@mbox) { $check_fmt->($fmt) } +s/\n/\r\n/sg for (values %raw); +for my $fmt (@mbox) { $check_fmt->($fmt) } + +{ + my $no_blank_eom = <<'EOM'; +From x@y Fri Oct 2 00:00:00 1993 +a: b + +body1 +From x@y Fri Oct 2 00:00:00 1993 +c: d + +body2 +EOM + # chop($no_blank_eom) eq "\n" or BAIL_OUT 'broken LF'; + for my $variant (qw(mboxrd mboxo)) { + my @x; + open my $fh, '<', \$no_blank_eom or BAIL_OUT 'PerlIO::scalar'; + $reader->$variant($fh, sub { push @x, shift }); + is_deeply($x[0]->{bdy}, \"body1\n", 'LF preserved in 1st'); + is_deeply($x[1]->{bdy}, \"body2\n", 'no LF added in 2nd'); + } +} + +SKIP: { + use PublicInbox::Spawn qw(popen_rd); + 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'; +print "Final: bit\n\n", "Incomplete\n\n"; +exit 1 + + my @x; + eval { $reader->mboxrd($fh, sub { push @x, shift->as_string }) }; + like($@, qr/error closing mbox/, 'detects error reading from pipe'); + is(scalar(@x), 1, 'only saw one message'); + 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-2020 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 754d52f7..42fa6101 100644 --- a/t/mda_filter_rubylang.t +++ b/t/mda_filter_rubylang.t @@ -1,4 +1,4 @@ -# Copyright (C) 2019-2020 all contributors <meta@public-inbox.org> +# 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; @@ -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"; @@ -44,8 +44,8 @@ something EOF ok(run_script(['-mda'], $env, $opt), 'message delivered'); } - my $config = PublicInbox::Config->new; - my $ibx = $config->lookup_name($v); + my $cfg = PublicInbox::Config->new; + my $ibx = $cfg->lookup_name($v); # make sure all serials are searchable: for my $i (1..2) { diff --git a/t/mdir_reader.t b/t/mdir_reader.t new file mode 100644 index 00000000..c927e1a7 --- /dev/null +++ b/t/mdir_reader.t @@ -0,0 +1,27 @@ +#!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 PublicInbox::TestCommon; +require_ok 'PublicInbox::MdirReader'; +*maildir_basename_flags = \&PublicInbox::MdirReader::maildir_basename_flags; +*maildir_path_flags = \&PublicInbox::MdirReader::maildir_path_flags; + +is(maildir_basename_flags('foo'), '', 'new valid name accepted'); +is(maildir_basename_flags('foo:2,'), '', 'cur valid name accepted'); +is(maildir_basename_flags('foo:2,bar'), 'bar', 'flags name accepted'); +is(maildir_basename_flags('.foo:2,bar'), undef, 'no hidden files'); +is(maildir_basename_flags('fo:o:2,bar'), undef, 'no extra colon'); +is(maildir_path_flags('/path/to/foo:2,S'), 'S', 'flag returned for path'); +is(maildir_path_flags('/path/to/.foo:2,S'), undef, 'no hidden paths'); +is(maildir_path_flags('/path/to/foo:2,'), '', 'no flags in path'); + +# not sure if there's a better place for eml_from_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,4 +1,4 @@ -# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org> +# 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 Test::More; @@ -1,10 +1,10 @@ #!perl -w -# Copyright (C) 2017-2020 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 new file mode 100644 index 00000000..ec837153 --- /dev/null +++ b/t/miscsearch.t @@ -0,0 +1,48 @@ +#!perl -w +# 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; +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 +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 $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"'); +is(scalar($mset->items), 0, 'no match on description phrase'); + +$mset = $ms->mset('"everything sucks this year"'); +is(scalar($mset->items), 1, 'match phrase on description'); + +$mset = $ms->mset('everything sucks'); +is(scalar($mset->items), 1, 'match words in description'); + +$mset = $ms->mset('nope@example.com'); +is(scalar($mset->items), 1, 'match full address'); + +$mset = $ms->mset('nope'); +is(scalar($mset->items), 1, 'match partial address'); + +$mset = $ms->mset('hope'); +is(scalar($mset->items), 1, 'match name'); +my $mi = ($mset->items)[0]; +my $doc = $mi->get_document; +is($doc->get_data, '{}', 'stored empty data'); + +done_testing; diff --git a/t/msg_iter.t b/t/msg_iter.t index 4ee3a201..ae3594da 100644 --- a/t/msg_iter.t +++ b/t/msg_iter.t @@ -1,10 +1,8 @@ -# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org> +# 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; @@ -1,4 +1,4 @@ -# Copyright (C) 2015-2020 all contributors <meta@public-inbox.org> +# Copyright (C) 2015-2021 all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use warnings; @@ -7,12 +7,13 @@ 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; my @mids = qw(a@b c@d e@f g@h aa@bb aa@cc); -is_deeply([$d->minmax], [undef,undef], "empty min max on new DB"); +is_deeply([$d->minmax], [0,0], "zero min max on new DB"); foreach my $mid (@mids) { my $n = $d->mid_insert($mid); @@ -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/msgtime.t b/t/msgtime.t index 89fd9e37..00d57999 100644 --- a/t/msgtime.t +++ b/t/msgtime.t @@ -1,4 +1,4 @@ -# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org> +# 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; diff --git a/t/multi-mid.t b/t/multi-mid.t index 41d556b9..4a5b8c32 100644 --- a/t/multi-mid.t +++ b/t/multi-mid.t @@ -1,14 +1,13 @@ -# Copyright (C) 2020 all contributors <meta@public-inbox.org> +# 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 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 new file mode 100644 index 00000000..7b7f5cbe --- /dev/null +++ b/t/net_reader-imap.t @@ -0,0 +1,43 @@ +#!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(-imapd Xapian Mail::IMAPClient)); +use PublicInbox::Config; +my ($tmpdir, $for_destroy) = tmpdir; +my ($ro_home, $cfg_path) = setup_public_inboxes; +my $cmd = [ '-imapd', '-W0', "--stdout=$tmpdir/1", "--stderr=$tmpdir/2" ]; +my $sock = tcp_server; +my $env = { PI_CONFIG => $cfg_path }; +my $td = start_script($cmd, $env, { 3 => $sock }) or BAIL_OUT "-imapd: $?"; +my ($host, $port) = tcp_host_port $sock; +require_ok 'PublicInbox::NetReader'; +my $nrd = PublicInbox::NetReader->new; +$nrd->add_url(my $url = "imap://$host:$port/t.v2.0"); +is($nrd->errors, undef, 'no errors'); +$nrd->{pi_cfg} = PublicInbox::Config->new($cfg_path); +$nrd->imap_common_init; +$nrd->{quiet} = 1; +my (%eml, %urls, %args, $nr, @w); +local $SIG{__WARN__} = sub { push(@w, @_) }; +$nrd->imap_each($url, sub { + my ($u, $uid, $kw, $eml, $arg) = @_; + ++$urls{$u}; + ++$args{$arg}; + like($uid, qr/\A[0-9]+\z/, 'got digit UID '.$uid); + ++$eml{ref($eml)}; + ++$nr; +}, 'blah'); +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(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'); + +done_testing; 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,71 +1,72 @@ -# Copyright (C) 2015-2020 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(@_); @@ -76,12 +77,12 @@ use_ok 'PublicInbox::Inbox'; } 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 @@ -89,7 +90,7 @@ use_ok 'PublicInbox::Inbox'; 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'); @@ -98,44 +99,37 @@ use_ok 'PublicInbox::Inbox'; { # test setting NNTP headers in HEAD and ARTICLE requests my $u = 'https://example.com/a/'; - my $ng = PublicInbox::Inbox->new({ name => 'test', + my $ibx = PublicInbox::Inbox->new({ name => 'test', inboxdir => 'test.git', address => 'a@example.com', -primary_address => 'a@example.com', newsgroup => 'test', domain => 'example.com', url => [ '//example.com/a' ]}); - is($ng->base_url, $u, 'URL expanded'); + is($ibx->base_url, $u, 'URL expanded'); my $mid = 'a@b'; my $mime = PublicInbox::Eml->new("Message-ID: <$mid>\r\n\r\n"); my $hdr = $mime->header_obj; my $mock_self = { - nntpd => { grouplist => [], servername => 'example.com' }, - ng => $ng, + nntpd => { + servername => 'example.com', + pi_cfg => bless {}, 'PublicInbox::Config', + }, + ibx => $ibx, }; - my $smsg = { num => 1, mid => $mid, nntp => $mock_self, -ibx => $ng }; + my $smsg = { num => 1, mid => $mid, nntp => $mock_self, -ibx => $ibx }; PublicInbox::NNTP::set_nntp_headers($hdr, $smsg); is_deeply([ $mime->header('Message-ID') ], [ "<$mid>" ], 'Message-ID unchanged'); - is_deeply([ $mime->header('Archived-At') ], [ "<${u}a\@b/>" ], - 'Archived-At: set'); - is_deeply([ $mime->header('List-Archive') ], [ "<$u>" ], - 'List-Archive: set'); - is_deeply([ $mime->header('List-Post') ], [ '<mailto:a@example.com>' ], - 'List-Post: set'); is_deeply([ $mime->header('Newsgroups') ], [ 'test' ], 'Newsgroups: set'); is_deeply([ $mime->header('Xref') ], [ 'example.com test:1' ], 'Xref: set'); - $ng->{-base_url} = 'http://mirror.example.com/m/'; $smsg->{num} = 2; PublicInbox::NNTP::set_nntp_headers($hdr, $smsg); is_deeply([ $mime->header('Message-ID') ], [ "<$mid>" ], 'Message-ID unchanged'); - is_deeply([ $mime->header('Archived-At') ], - [ "<${u}a\@b/>", '<http://mirror.example.com/m/a@b/>' ], - 'Archived-At: appended'); is_deeply([ $mime->header('Xref') ], [ 'example.com test:2' ], 'Old Xref: clobbered'); } diff --git a/t/nntpd-tls.t b/t/nntpd-tls.t index 23baf4e4..a16cc015 100644 --- a/t/nntpd-tls.t +++ b/t/nntpd-tls.t @@ -1,10 +1,9 @@ -# Copyright (C) 2019-2020 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,47 +27,30 @@ 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; - } -} - -my $nntps_addr = $nntps->sockhost . ':' . $nntps->sockport; -my $starttls_addr = $starttls->sockhost . ':' . $starttls->sockport; + 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 }; my $td; @@ -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(); diff --git a/t/nntpd-v2.t b/t/nntpd-v2.t index 1dd992a0..0433a57a 100644 --- a/t/nntpd-v2.t +++ b/t/nntpd-v2.t @@ -1,4 +1,4 @@ -# Copyright (C) 2019-2020 all contributors <meta@public-inbox.org> +# Copyright (C) 2019-2021 all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> local $ENV{PI_TEST_VERSION} = 2; require './t/nntpd.t'; @@ -1,74 +1,34 @@ -# Copyright (C) 2015-2020 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 IO::Socket; use Socket qw(IPPROTO_TCP TCP_NODELAY); -use Net::NNTP; use Sys::Hostname; use POSIX qw(_exit); -use Digest::SHA; -use_ok 'PublicInbox::Msgmap'; +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; -my $lsof = which('lsof'); -my $fast_idle = eval { require Linux::Inotify2; 1 } // +use_ok 'PublicInbox::Msgmap'; +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,25 +41,51 @@ 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; - ok($sock, 'sock created'); +{ my $cmd = [ '-nntpd', '-W0', "--stdout=$out", "--stderr=$err" ]; $td = start_script($cmd, undef, { 3 => $sock }); - my $host_port = $sock->sockhost . ':' . $sock->sockport; my $n = Net::NNTP->new($host_port); my $list = $n->list; ok(delete $list->{'x.y.z'}, 'deleted x.y.z group'); @@ -107,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: @@ -134,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'); @@ -260,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'); @@ -314,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); @@ -337,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; { @@ -367,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, $sock, $group) }; + 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 { @@ -417,11 +410,11 @@ sub read_til_dot { } sub test_watch { - my ($tmpdir, $sock, $group) = @_; + my ($tmpdir, $host_port, $group) = @_; 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 $!; @@ -432,8 +425,7 @@ sub test_watch { my $url = "http://example.com/i1"; my $inboxdir = "$tmpdir/watchnntp"; my $cmd = ['-init', '-V1', '-Lbasic', $name, $inboxdir, $url, $addr]; - my ($ihost, $iport) = ($sock->sockhost, $sock->sockport); - my $nntpurl = "nntp://$ihost:$iport/$group"; + my $nntpurl = "nntp://$host_port/$group"; run_script($cmd) or BAIL_OUT("init $name"); xsys(qw(git config), "--file=$home/.public-inbox/config", "publicinbox.$name.watch", @@ -445,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"; @@ -454,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; @@ -462,7 +454,7 @@ sub test_watch { $cfg->each_inbox(sub { shift->unsubscribe_unlock('ident') }); $ii->close; PublicInbox::DS->Reset; - my @err = grep(!/^I:/, <$err>); + my @err = grep(!/^(?:I:|#)/, <$err>); is(@err, 0, 'no warnings/errors from -watch'.join(' ', @err)); my @ls = xqx(['git', "--git-dir=$inboxdir", qw(ls-tree -r HEAD)]); isnt(scalar(@ls), 0, 'imported something'); diff --git a/t/nodatacow.t b/t/nodatacow.t index e5b742a2..0940d908 100644 --- a/t/nodatacow.t +++ b/t/nodatacow.t @@ -1,50 +1,42 @@ #!perl -w -# Copyright (C) 2020 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/nulsubject.t b/t/nulsubject.t index ccb60d52..7f5dd378 100644 --- a/t/nulsubject.t +++ b/t/nulsubject.t @@ -1,4 +1,4 @@ -# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org> +# 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; diff --git a/t/on_destroy.t b/t/on_destroy.t new file mode 100644 index 00000000..e8fdf35e --- /dev/null +++ b/t/on_destroy.t @@ -0,0 +1,45 @@ +#!perl -w +use v5.12; +use Test::More; +use PublicInbox::OnDestroy; +use POSIX qw(_exit); +my @x; +my $od = on_destroy sub { push @x, 'hi' }; +is_deeply(\@x, [], 'not called, yet'); +undef $od; +is_deeply(\@x, [ 'hi' ], 'no args works'); +$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 = 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 = 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->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 = on_destroy sub { @x = @_ }, qw(x y); + } +} + +done_testing; @@ -1,4 +1,4 @@ -# Copyright (C) 2018-2020 all contributors <meta@public-inbox.org> +# Copyright (C) 2018-2021 all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use warnings; @@ -74,4 +74,29 @@ SKIP: { 'WAL journal_mode not clobbered if manually set'); } +# ext index additions +$over->eidx_prep; +{ + my @arg = qw(1349 2019 adeadba7cafe example.key); + ok($over->add_xref3(@arg), 'first add'); + ok($over->add_xref3(@arg), 'add idempotent'); + my $xref3 = $over->get_xref3(1349); + is_deeply($xref3, [ 'example.key:2019:adeadba7cafe' ], 'xref3 works'); + + @arg = qw(1349 2018 deadbeefcafe example.kee); + ok($over->add_xref3(@arg), 'add another xref3'); + $xref3 = $over->get_xref3(1349); + is_deeply($xref3, [ 'example.key:2019:adeadba7cafe', + 'example.kee:2018:deadbeefcafe' ], + 'xref3 works forw two'); + + 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'); + $over->rollback_lazy; +} + done_testing(); @@ -1,67 +1,48 @@ -# Copyright (C) 2014-2020 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'); -PublicInbox::Import::run_die([qw(git config -f), $pi_config, - '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/precheck.t b/t/precheck.t index 11193e38..360dc74f 100644 --- a/t/precheck.t +++ b/t/precheck.t @@ -1,4 +1,4 @@ -# Copyright (C) 2014-2020 all contributors <meta@public-inbox.org> +# 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; diff --git a/t/psgi_attach.t b/t/psgi_attach.t index 14d20adb..db551696 100644 --- a/t/psgi_attach.t +++ b/t/psgi_attach.t @@ -1,44 +1,37 @@ -# Copyright (C) 2016-2020 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) = ($sock->sockhost, $sock->sockport); - 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 70393573..ac0eb3c3 100644 --- a/t/psgi_bad_mids.t +++ b/t/psgi_bad_mids.t @@ -1,31 +1,15 @@ -# Copyright (C) 2018-2020 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 b4de8274..e43b9f2d 100644 --- a/t/psgi_mount.t +++ b/t/psgi_mount.t @@ -1,45 +1,35 @@ -# Copyright (C) 2016-2020 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 $config = 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 $www = PublicInbox::WWW->new($config); +}; +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'); mount('/a' => builder(sub { sub { $www->call(@_) } })); @@ -56,22 +46,15 @@ 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'); - like($res->content, qr!^List-Archive: <http://[^/]+/a/test/>!m, - 'List-Archive set in /raw mboxrd'); like($res->content, - qr!^Archived-At: <http://[^/]+/a/test/blah\@example\.com/>!m, - 'Archived-At set in /raw mboxrd'); + qr/^Message-Id: <blah\@example\.com>\n/sm, + 'headers appear in /raw'); # redirects $res = $cb->(GET('/a/test/m/blah%40example.com.html')); @@ -84,8 +67,7 @@ test_psgi($app, sub { }); SKIP: { - require_mods(qw(DBD::SQLite Search::Xapian IO::Uncompress::Gunzip), 3); - my $ibx = $config->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 { @@ -94,12 +76,8 @@ SKIP: { my $gz = $res->content; my $raw; IO::Uncompress::Gunzip::gunzip(\$gz => \$raw); - like($raw, qr!^List-Archive: <http://[^/]+/a/test/>!m, - 'List-Archive set in /t.mbox.gz mboxrd'); - like($raw, - qr!^Archived-At:\x20 - <http://[^/]+/a/test/blah\@example\.com/>!mx, - 'Archived-At set in /t.mbox.gz mboxrd'); + like($raw, qr!^Message-Id:\x20<blah\@example\.com>\n!sm, + 'headers appear in /t.mbox.gz mboxrd'); }); } diff --git a/t/psgi_multipart_not.t b/t/psgi_multipart_not.t index 9b7fb4d0..e7c43abf 100644 --- a/t/psgi_multipart_not.t +++ b/t/psgi_multipart_not.t @@ -1,29 +1,18 @@ -# Copyright (C) 2018-2020 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 c8cb2409..4c28b553 100644 --- a/t/psgi_scan_all.t +++ b/t/psgi_scan_all.t @@ -1,53 +1,38 @@ -# Copyright (C) 2019-2020 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 c1677eb3..8c981c6c 100644 --- a/t/psgi_search.t +++ b/t/psgi_search.t @@ -1,93 +1,95 @@ -# Copyright (C) 2017-2020 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)); use_ok 'PublicInbox::WWW'; 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 $config = 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($config); +my $www = PublicInbox::WWW->new($cfg); test_psgi(sub { $www->call(@_) }, sub { my ($cb) = @_; - my $res; - $res = $cb->(GET('/test/?q=%C3%86var')); - my $html = $res->content; - like($html, qr/<title>Ævar - /, 'HTML escaped in title'); - my @res = ($html =~ m/\?q=(.+var)\b/g); - ok(scalar(@res), 'saw query strings'); - my %uniq = map { $_ => 1 } @res; - is(1, scalar keys %uniq, 'all query values identical in HTML'); - is('%C3%86var', (keys %uniq)[0], 'matches original query'); - ok(index($html, 'by Ævar Arnfjörð Bjarmason') >= 0, - "displayed Ævar's name properly in HTML"); - - like($html, qr/download mbox\.gz: .*?"full threads"/s, - '"full threads" download option shown'); + my ($html, $res); + my $approxidate = 'now'; + for my $req ('/test/?q=%C3%86var', '/test/?q=%25C3%2586var') { + $res = $cb->(GET($req."+d:..$approxidate")); + $html = $res->content; + like($html, qr/<title>Ævar d:\.\.\Q$approxidate\E/, + 'HTML escaped in title, "d:..$APPROXIDATE" preserved'); + my @res = ($html =~ m/\?q=(.+var)\+d:\.\.\Q$approxidate\E/g); + ok(scalar(@res), 'saw query strings'); + my %uniq = map { $_ => 1 } @res; + is(1, scalar keys %uniq, 'all query values identical in HTML'); + is('%C3%86var', (keys %uniq)[0], 'matches original query'); + ok(index($html, 'by Ævar Arnfjörð Bjarmason') + >= 0, "displayed Ævar's name properly in HTML"); + like($html, qr/download mbox\.gz: .*?"full threads"/s, + '"full threads" download option shown'); + } + like($html, qr/Initial query\b.*?returned no.results, used:.*instead/s, + 'noted retry on double-escaped query {-uxs_retried}'); my $warn = []; local $SIG{__WARN__} = sub { push @$warn, @_ }; @@ -95,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; @@ -107,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; @@ -130,7 +142,7 @@ test_psgi(sub { $www->call(@_) }, sub { qr/filename=no-subject\.mbox\.gz/); # "full threads" mbox.gz download - $res = $cb->(POST('/test/?q=s:test&x=m&t')); + $res = $cb->(POST("/test/?q=s:test+d:..$approxidate&x=m&t")); is($res->code, 200, 'successful mbox download with threads'); gunzip(\($res->content) => \(my $before)); is_deeply([ "Message-ID: <$mid>\n", "Message-ID: <reply\@asdf>\n" ], @@ -144,17 +156,30 @@ test_psgi(sub { $www->call(@_) }, sub { $xdb->set_metadata('has_threadid', '0'); $sidx->idx_release; } - $config->each_inbox(sub { delete $_[0]->{search} }); + $cfg->each_inbox(sub { delete $_[0]->{search} }); $res = $cb->(GET('/test/?q=s:test')); is($res->code, 200, 'successful search w/o has_threadid'); unlike($html, qr/download mbox\.gz: .*?"full threads"/s, '"full threads" download option not shown w/o has_threadid'); # in case somebody uses curl to bypass <form> - $res = $cb->(POST('/test/?q=s:test&x=m&t')); + $res = $cb->(POST("/test/?q=s:test+d:..$approxidate&x=m&t")); 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 9867feaa..25599dd9 100644 --- a/t/psgi_text.t +++ b/t/psgi_text.t @@ -1,8 +1,6 @@ -# Copyright (C) 2016-2020 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 11aef5b3..2b678fd8 100644 --- a/t/psgi_v2.t +++ b/t/psgi_v2.t @@ -1,94 +1,142 @@ -# Copyright (C) 2018-2020 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) = ($sock->sockhost, $sock->sockport); - 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 $!; - is(do { local $/; <$fh> }, '', '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 = <<EOF; -$cfgpfx.address=$ibx->{-primary_address} -$cfgpfx.inboxdir=$inboxdir -EOF -my $config = PublicInbox::Config->new(\$cfg); -my $www = PublicInbox::WWW->new($config); +my $cfg = PublicInbox::Config->new($cfgpath); +my $www = PublicInbox::WWW->new($cfg); my ($res, $raw, @from_); my $client0 = sub { my ($cb) = @_; @@ -96,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'); @@ -120,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'); @@ -150,23 +217,21 @@ my $client1 = sub { like($raw, qr/^hello ghosts$/m, 'got third message'); @from_ = ($raw =~ m/^From /mg); is(scalar(@from_), 3, 'three From_ lines'); - $config->each_inbox(sub { $_[0]->search->reopen }); + $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'); @@ -177,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'); @@ -188,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'); @@ -217,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'); @@ -226,21 +293,30 @@ 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'); - $config->each_inbox(sub { $_[0]->search->reopen }); + $cfg->each_inbox(sub { $_[0]->search->reopen }); } my $client2 = sub { @@ -271,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; - $config->each_inbox(sub { $_[0]->search->reopen }); } +$cfg->each_inbox(sub { $_[0]->search->reopen }); my $client3 = sub { my ($cb) = @_; @@ -296,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; @@ -1,4 +1,4 @@ -# Copyright (C) 2019-2020 all contributors <meta@public-inbox.org> +# 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; @@ -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-2020 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 fd8ce2c6..a61c3ca0 100644 --- a/t/replace.t +++ b/t/replace.t @@ -1,4 +1,4 @@ -# Copyright (C) 2019-2020 all contributors <meta@public-inbox.org> +# 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; @@ -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,8 +187,7 @@ test_replace(2, 'basic', $opt = { %$opt, post => \&pad_msgs }); test_replace(2, 'basic', $opt = { %$opt, rotate_bytes => 1 }); SKIP: { - require PublicInbox::Search; - PublicInbox::Search::load_xapian() or skip 'Search::Xapian missing', 8; + require_mods(qw(Xapian), 8); for my $l (qw(medium)) { test_replace(2, $l, {}); $opt = { pre => \&pad_msgs }; @@ -1,8 +1,9 @@ -# Copyright (C) 2017-2020 all contributors <meta@public-inbox.org> +#!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 1c7bcfc3..00000000 --- a/t/run.perl +++ /dev/null @@ -1,210 +0,0 @@ -#!/usr/bin/perl -w -# Copyright (C) 2019-2020 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 Cwd qw(getcwd); -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'); -my $cwd = getcwd(); -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) or DIE "chdir($cwd): $!"; - 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>); - pop @not_ok if $not_ok[-1] =~ /^[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 ($i, $j, $rd, $todo) = @_; - defined(my $pid = fork) or DIE "fork: $!"; - if ($pid == 0) { - $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 semantics - 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; - close $wr or die; - $wr = undef; - } 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->($i, $j, $rd, \@todo); - } - } - }; - - # start the workers to consume the queue - for (my $j = 0; $j < $jobs; $j++) { - $start_worker->($i, $j, $rd, \@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; - close $wr or die; - } - - $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 bd663519..aecd064f 100644 --- a/t/search-thr-index.t +++ b/t/search-thr-index.t @@ -1,13 +1,13 @@ -# Copyright (C) 2017-2020 all contributors <meta@public-inbox.org> +#!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,14 +1,15 @@ -# Copyright (C) 2015-2020 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; use PublicInbox::Eml; +use POSIX qw(strftime); my ($tmpdir, $for_destroy) = tmpdir(); my $git_dir = "$tmpdir/a.git"; my $ibx = PublicInbox::Inbox->new({ inboxdir => $git_dir }); @@ -33,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)' ], @@ -53,14 +50,14 @@ 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); } } { - my $crlf_adjust = \&PublicInbox::SearchIdx::crlf_adjust; + my $crlf_adjust = \&PublicInbox::Smsg::crlf_adjust; is($crlf_adjust->("hi\r\nworld\r\n"), 0, 'no adjustment needed'); is($crlf_adjust->("hi\nworld\n"), 2, 'LF-only counts two CR'); is($crlf_adjust->("hi\r\nworld\n"), 1, 'CRLF/LF-mix 1 counts 1 CR'); @@ -332,13 +329,13 @@ $ibx->with_umask(sub { like($smsg->{to}, qr/\blist\@example\.com\b/, 'to appears'); my $doc = $m->get_document; my $col = PublicInbox::Search::BYTES(); - my $bytes = PublicInbox::SearchIdx::get_val($doc, $col); + my $bytes = PublicInbox::Search::int_val($doc, $col); like($bytes, qr/\A[0-9]+\z/, '$bytes stored as digit'); ok($bytes > 0, '$bytes is > 0'); is($bytes, $smsg->{bytes}, 'bytes Xapian value matches Over'); $col = PublicInbox::Search::UID(); - my $uid = PublicInbox::SearchIdx::get_val($doc, $col); + my $uid = PublicInbox::Search::int_val($doc, $col); is($uid, $smsg->{num}, 'UID column matches {num}'); is($uid, $m->get_docid, 'UID column matches docid'); } @@ -435,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; } @@ -532,8 +530,142 @@ $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'); }); -done_testing(); +SKIP: { + my ($s, $g) = ($ibx->search, $ibx->git); + my $q = $s->query_argv_to_string($g, ["quoted phrase"]); + is($q, q["quoted phrase"], 'quoted phrase'); + $q = $s->query_argv_to_string($g, ['s:pa ce']); + is($q, q[s:"pa ce"], 'space with prefix'); + $q = $s->query_argv_to_string($g, ["\(s:pa ce", "AND", "foo\)"]); + is($q, q[(s:"pa ce" AND foo)], 'space AND foo'); + + local $ENV{TZ} = 'UTC'; + my $now = strftime('%H:%M:%S', gmtime(time)); + if ($now =~ /\A23:(?:59|60)/ || $now =~ /\A00:00:0[01]\z/) { + skip 'too close to midnight, time is tricky', 6; + } + $q = $s->query_argv_to_string($g, [qw(d:20101002 blah)]); + is($q, 'dt:20101002000000..20101003000000 blah', + 'YYYYMMDD expanded to range'); + $q = $s->query_argv_to_string($g, [qw(d:2010-10-02)]); + 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)]); + $q =~ /\Art:\.\.(\d+) zz/ or fail("rt: expansion failed: $q"); + 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 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)]); + is($q, 'x dt:20101002054123..20101003054123', 'ISO8601 dt: expanded'); + $q = $s->query_argv_to_string($g, [qw(rt:1970..1971)]); + $q =~ /\Art:(\d+)\.\.(\d+)\z/ or fail "YYYY rt: expansion: $q"; + my ($beg, $end) = ($1, $2); + is(strftime('%Y', gmtime($beg)), 1970, 'rt: starts at 1970'); + is(strftime('%Y', gmtime($end)), 1971, 'rt: ends at 1971'); + $q = $s->query_argv_to_string($g, [qw(rt:1970-01-01)]); + $q =~ /\Art:(\d+)\.\.(\d+)\z/ or fail "YYYY-MM-DD rt: expansion: $q"; + ($beg, $end) = ($1, $2); + is(strftime('%Y-%m-%d', gmtime($beg)), '1970-01-01', + 'rt: date-only w/o range'); + is(strftime('%Y-%m-%d', gmtime($end)), '1970-01-02', + 'rt: date-only auto-end'); + $q = $s->query_argv_to_string($g, [qw{OR (rt:1993-10-02)}]); + like($q, qr/\AOR \(rt:749\d{6}\.\.749\d{6}\)\z/, + 'trailing parentheses preserved'); + + my $qs = qq[f:bob rt:1993-10-02..2010-10-02]; + $s->query_approxidate($g, $qs); + like($qs, qr/\Af:bob rt:749\d{6}\.\.128\d{7}\z/, + 'no phrases, no problem'); + + my $orig = $qs = qq[f:bob "d:1993-10-02..2010-10-02"]; + $s->query_approxidate($g, $qs); + is($qs, $orig, 'phrase preserved'); + + $orig = $qs = qq[f:bob "d:1993-10-02..2010-10-02 "] . + qq["dt:1993-10-02..2010-10-02 " \x{201c}]; + $s->query_approxidate($g, $qs); + is($qs, $orig, 'phrase preserved even with escaped ""'); + + $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" dt:19931002000000..20101002000000], + 'post-phrase date corrected'); + + # Xapian uses "" to escape " inside phrases, we don't explictly + # handle that, but are able to pass the result through unchanged + for my $pair (["\x{201c}", "\x{201d}"], ['"', '"']) { + my ($x, $y) = @$pair; + $orig = $qs = qq[${x}hello d:1993-10-02.."" world$y]; + $s->query_approxidate($g, $qs); + 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 dt:..20101002000000", + 'two phrases did not throw off date parsing'); + + $orig = $qs = qq[${x}hello d:1993-10-02..$y$x world$y]; + $s->query_approxidate($g, $qs); + is($qs, $orig, 'phrases unchanged \x'.ord($x).'-\x'.ord($y)); + + $s->query_approxidate($g, $tmp = "$qs d:..2010-10-02"); + is($tmp, "$orig dt:..20101002000000", + 'two phrases did not throw off date parsing'); + } -1; + 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); + 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 { 'dt:1993-10-02..2010-10-02' } (1..(4096 * 32)); + eval { $s->query_argv_to_string($g, \@fail) }; + ok($@, 'exception raised'); +} + +done_testing(); 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 new file mode 100644 index 00000000..8dfd3b25 --- /dev/null +++ b/t/shared_kv.t @@ -0,0 +1,49 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use v5.10.1; +use Test::More; +use PublicInbox::TestCommon; +require_mods(qw(DBD::SQLite)); +use_ok 'PublicInbox::SharedKV'; +my ($tmpdir, $for_destroy) = tmpdir(); +local $ENV{TMPDIR} = $tmpdir; +my $skv = PublicInbox::SharedKV->new; +my $skv_tmpdir = $skv->{"tmp$$.$skv"}; +ok(-d $skv_tmpdir, 'created a temporary dir'); +$skv->dbh; +my $dead = "\xde\xad"; +my $beef = "\xbe\xef"; +my $cafe = "\xca\xfe"; +ok($skv->set($dead, $beef), 'set'); +is($skv->get($dead), $beef, 'get'); +ok($skv->set($dead, $beef), 'set idempotent'); +ok(!$skv->set_maybe($dead, $cafe), 'set_maybe ignores'); +ok($skv->set_maybe($cafe, $dead), 'set_maybe sets'); +is($skv->xchg($dead, $cafe), $beef, 'xchg'); +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'); +is($skv->xchg($dead, $cafe), undef, 'xchg from undef'); +is($skv->count, 2, 'count works'); + +my %seen; +my $sth = $skv->each_kv_iter; +while (my ($k, $v) = $sth->fetchrow_array) { + $seen{$k} = $v; +} +is($seen{$dead}, $cafe, '$dead has expected value'); +is($seen{$cafe}, $dead, '$cafe has expected value'); +is(scalar keys %seen, 2, 'iterated through all'); + +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-2020 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); - ok($nbsig, 'Sigfd->new $SFD_NONBLOCK works'); + 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 6b0ed8d2..db672904 100644 --- a/t/solver_git.t +++ b/t/solver_git.t @@ -1,54 +1,165 @@ -# Copyright (C) 2019-2020 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) = ($sock->sockhost, $sock->sockport); - 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(); diff --git a/t/spamcheck_spamc.t b/t/spamcheck_spamc.t index 2d9da631..ab46d62b 100644 --- a/t/spamcheck_spamc.t +++ b/t/spamcheck_spamc.t @@ -1,4 +1,4 @@ -# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org> +# 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; @@ -1,11 +1,13 @@ -# Copyright (C) 2015-2020 all contributors <meta@public-inbox.org> +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> -use strict; -use warnings; +use v5.12; use Test::More; -use PublicInbox::Spawn qw(which spawn popen_rd); -use PublicInbox::Sigfd; - +use PublicInbox::Spawn qw(which spawn popen_rd run_qx); +require PublicInbox::Sigfd; +require PublicInbox::DS; +use PublicInbox::OnDestroy; +my $rlimit_map = PublicInbox::Spawn->can('rlimit_map'); { my $true = which('true'); ok($true, "'true' command found with which()"); @@ -18,6 +20,45 @@ 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; + + # 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> }; + if (defined $pid) { + waitpid($pid, 0); + isnt($?, 0, 'child error (pure-Perl)'); + } else { + ok($@, 'exception raised'); + } +} + { # ensure waitpid(-1, 0) and SIGCHLD works in spawned process my $script = <<'EOF'; $| = 1; # unbuffer stdout @@ -32,16 +73,16 @@ elsif ($pid > 0) { select(undef, undef, undef, 0.01) while 1; } EOF - my $oldset = PublicInbox::Sigfd::block_signals(); - my $rd = popen_rd([$^X, '-e', $script]); + my $oldset = PublicInbox::DS::block_signals(); + 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'); - PublicInbox::Sigfd::sig_setmask($oldset); + ok($rd->close, 'popen_rd close works'); + PublicInbox::DS::sig_setmask($oldset); } { @@ -67,56 +108,162 @@ 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'); + 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: '.$?); } +{ + local $ENV{GIT_CONFIG} = '/path/to/this/better/not/exist'; + my $fh = popen_rd([qw(env)], { GIT_CONFIG => undef }); + ok(!grep(/^GIT_CONFIG=/, <$fh>), 'GIT_CONFIG clobbered'); +} + +{ # ->CLOSE vs ->DESTROY waitpid caller distinction + my @c; + 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, undef, sub { @c = caller }); + undef $fh; # ->DESTROY + ok(scalar(@c), 'callback fired by ->DESTROY'); + 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 @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) }; + undef $fh; + _exit(0); + } + waitpid($pid, 0); + is($?, 0, 'forked process exited'); + my @w; + local $SIG{__WARN__} = sub { push @w, @_ }; + close $w; + $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 484ea443..1e5dfb51 100644 --- a/t/thread-cycle.t +++ b/t/thread-cycle.t @@ -1,19 +1,16 @@ -# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org> +# 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 new file mode 100644 index 00000000..15c362f0 --- /dev/null +++ b/t/thread-index-gap.t @@ -0,0 +1,56 @@ +#!perl -w +# 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 PublicInbox::TestCommon; +use PublicInbox::Eml; +use PublicInbox::Config; +use List::Util qw(shuffle); +require_mods(qw(DBD::SQLite)); +require_git(2.6); + +chomp(my @msgs = split(/\n\n/, <<'EOF')); # "git log" order +Subject: [bug#45000] [PATCH 1/9] +References: <20201202045335.31096-1-j@example.com> +Message-Id: <20201202045540.31248-1-j@example.com> + +Subject: [bug#45000] [PATCH 0/9] +Message-Id: <20201202045335.31096-1-j@example.com> + +Subject: [bug#45000] [PATCH 0/9] +References: <20201202045335.31096-1-j@example.com> +Message-ID: <86sg8o1mou.fsf@example.com> + +Subject: [bug#45000] [PATCH 8/9] +Message-Id: <20201202045540.31248-8-j@example.com> +References: <20201202045540.31248-1-j@example.com> + +EOF + +my ($home, $for_destroy) = tmpdir(); +for my $msgs (['orig', reverse @msgs], ['shuffle', shuffle(@msgs)]) { + my $desc = shift @$msgs; + 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}], $env) or BAIL_OUT 'rethread'; + $tid = $dbh->selectall_arrayref('SELECT DISTINCT(tid) FROM over'); + is(scalar(@$tid), 1, "only one thread after rethread ($desc)"); +} + +done_testing; @@ -1,4 +1,4 @@ -# Copyright (C) 2018-2020 all contributors <meta@public-inbox.org> +# Copyright (C) 2018-2021 all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use warnings; diff --git a/t/uri_imap.t b/t/uri_imap.t index a2e86a7e..7a97f875 100644 --- a/t/uri_imap.t +++ b/t/uri_imap.t @@ -1,8 +1,8 @@ #!perl -w -# Copyright (C) 2020 all contributors <meta@public-inbox.org> +# 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'; @@ -19,6 +19,7 @@ is($uri->auth, undef); is($uri->user, undef); $uri = PublicInbox::URIimap->new('imaps://foo@0/'); +is("$uri", $uri->as_string, '"" overload works'); is($uri->host, '0', 'numeric host'); is($uri->user, 'foo', 'user extracted'); @@ -53,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"); @@ -60,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 new file mode 100644 index 00000000..6b123a9b --- /dev/null +++ b/t/uri_nntps.t @@ -0,0 +1,43 @@ +#!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 'URI'; +use_ok 'PublicInbox::URInntps'; +my $uri = PublicInbox::URInntps->new('nntp://EXAMPLE.com/inbox.test'); +isnt(ref($uri), 'PublicInbox::URInntps', 'URI fallback'); +is($uri->scheme, 'nntp', 'NNTP fallback ->scheme'); + +$uri = PublicInbox::URInntps->new('nntps://EXAMPLE.com/inbox.test'); +is($uri->host, 'EXAMPLE.com', 'host matches'); +is($uri->canonical->host, 'example.com', 'host canonicalized'); +is($uri->canonical->as_string, 'nntps://example.com/inbox.test', + 'URI canonicalized'); +is($uri->port, 563, 'nntps port'); +is($uri->userinfo, undef, 'no userinfo'); +is($uri->scheme, 'nntps', '->scheme works'); +is($uri->group, 'inbox.test', '->group works'); + +$uri = PublicInbox::URInntps->new('nntps://foo@0/'); +is("$uri", $uri->as_string, '"" overload works'); +is($uri->host, '0', 'numeric host'); +is($uri->userinfo, 'foo', 'user extracted'); + +$uri = PublicInbox::URInntps->new('nntps://ipv6@[::1]'); +is($uri->host, '::1', 'IPv6 host'); +is($uri->group, '', '->group is empty'); + +$uri = PublicInbox::URInntps->new('nntps://0:666/INBOX.test'); +is($uri->port, 666, 'port read'); +is($uri->group, 'INBOX.test', 'group read after port'); + +is(PublicInbox::URInntps->new('nntps://0:563/')->canonical->as_string, + 'nntps://0/', 'default port stripped'); + +$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 2cd45f60..50ff8143 100644 --- a/t/v1-add-remove-add.t +++ b/t/v1-add-remove-add.t @@ -1,4 +1,4 @@ -# Copyright (C) 2018-2020 all contributors <meta@public-inbox.org> +# Copyright (C) 2018-2021 all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use warnings; @@ -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 e66d89e5..2d12e3f5 100644 --- a/t/v1reindex.t +++ b/t/v1reindex.t @@ -1,4 +1,4 @@ -# Copyright (C) 2018-2020 all contributors <meta@public-inbox.org> +# Copyright (C) 2018-2021 all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use warnings; @@ -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 cfdc8cf1..ddf8d248 100644 --- a/t/v2-add-remove-add.t +++ b/t/v2-add-remove-add.t @@ -1,4 +1,4 @@ -# Copyright (C) 2018-2020 all contributors <meta@public-inbox.org> +# Copyright (C) 2018-2021 all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use warnings; @@ -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 b1abccd9..3339cc10 100644 --- a/t/v2dupindex.t +++ b/t/v2dupindex.t @@ -1,52 +1,52 @@ #!perl -w -# Copyright (C) 2020 all contributors <meta@public-inbox.org> +# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> # 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-2020 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 81b9544d..b8824182 100644 --- a/t/v2mirror.t +++ b/t/v2mirror.t @@ -1,19 +1,20 @@ -# Copyright (C) 2018-2020 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,22 +66,17 @@ $v2w->done; } $ibx->cleanup; -my $sock = tcp_server(); -ok($sock, 'sock created'); -my $cmd = [ '-httpd', '-W0', "--stdout=$tmpdir/out", "--stderr=$tmpdir/err" ]; -my $td = start_script($cmd, undef, { 3 => $sock }); -my ($host, $port) = ($sock->sockhost, $sock->sockport); -$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', @@ -93,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"); @@ -102,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->(); @@ -233,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 ae1570ed..8c49e154 100644 --- a/t/v2reindex.t +++ b/t/v2reindex.t @@ -1,14 +1,11 @@ -# Copyright (C) 2018-2020 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 2f71fafa..1b7e9e7d 100644 --- a/t/v2writable.t +++ b/t/v2writable.t @@ -1,4 +1,4 @@ -# Copyright (C) 2018-2020 all contributors <meta@public-inbox.org> +# Copyright (C) 2018-2021 all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> use strict; use warnings; @@ -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'; @@ -164,12 +165,11 @@ EOF ; close $fh or die "close: $!\n"; my $sock = tcp_server(); - ok($sock, 'sock created'); my $len; my $cmd = [ '-nntpd', '-W0', "--stdout=$out", "--stderr=$err" ]; my $env = { PI_CONFIG => $pi_config }; my $td = start_script($cmd, $env, { 3 => $sock }); - my $host_port = $sock->sockhost . ':' . $sock->sockport; + my $host_port = tcp_host_port($sock); my $n = Net::NNTP->new($host_port); $n->group($group); my $x = $n->xover('1-'); @@ -274,14 +274,29 @@ EOF $mime->header_set('Message-ID', "<$y>"); $mime->header_set('References', "<$x>"); ok($im->add($mime), 'add excessively long References'); - $im->barrier; + $im->done; my $msgs = $ibx->over->get_thread('x'x244); is(2, scalar(@$msgs), 'got both messages'); is($msgs->[0]->{mid}, 'x'x244, 'stored truncated mid'); is($msgs->[1]->{references}, '<'.('x'x244).'>', 'stored truncated ref'); 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 = { @@ -309,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, @@ -1,4 +1,4 @@ -# Copyright (C) 2013-2020 all contributors <meta@public-inbox.org> +# Copyright (C) 2013-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; diff --git a/t/watch_filter_rubylang.t b/t/watch_filter_rubylang.t index 6513f30b..f72feb9f 100644 --- a/t/watch_filter_rubylang.t +++ b/t/watch_filter_rubylang.t @@ -1,12 +1,9 @@ -# Copyright (C) 2019-2020 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,20 +56,21 @@ 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 $config = PublicInbox::Config->new(\$orig); - my $ibx = $config->lookup_name($v); + 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($config); + my $w = PublicInbox::Watch->new($cfg); for my $i (1..2) { $w->scan('full'); } @@ -101,8 +95,12 @@ EOF } $w->scan('full'); - $config = PublicInbox::Config->new(\$orig); - $ibx = $config->lookup_name($v); + # 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 fb71d3df..26fd5330 100644 --- a/t/watch_imap.t +++ b/t/watch_imap.t @@ -1,16 +1,18 @@ -# Copyright (C) 2020 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 ae53caf9..a12ceefd 100644 --- a/t/watch_maildir.t +++ b/t/watch_maildir.t @@ -1,22 +1,21 @@ -# Copyright (C) 2016-2020 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 $config = 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($config); + 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 $config = PublicInbox::Config->new($cfg_path); -PublicInbox::Watch->new($config)->scan('full'); +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 { @@ -79,13 +81,17 @@ my $write_spam = sub { }; $write_spam->(); is(unlink(glob("$maildir/new/*")), 1, 'unlinked old spam'); -PublicInbox::Watch->new($config)->scan('full'); -@list = $git->qx(qw(rev-list refs/heads/master)); +PublicInbox::Watch->new($cfg)->scan('full'); +@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(-- @@ -93,18 +99,19 @@ To unsubscribe from this list: send the line "unsubscribe git" in 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($config)->scan('full'); - @list = $git->qx(qw(ls-tree -r --name-only refs/heads/master)); + PublicInbox::Watch->new($cfg)->scan('full'); + @list = $git->qx('ls-tree', '-r', '--name-only', $default_branch); is(scalar @list, 1, 'tree has one file'); + chomp(@list); my $mref = $git->cat_file('HEAD:'.$list[0]); like($$mref, qr/something\n\z/s, 'message scrubbed on import'); is(unlink(glob("$maildir/new/*")), 1, 'unlinked spam'); $write_spam->(); - PublicInbox::Watch->new($config)->scan('full'); - @list = $git->qx(qw(ls-tree -r --name-only refs/heads/master)); + PublicInbox::Watch->new($cfg)->scan('full'); + @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'); } @@ -115,12 +122,12 @@ More majordomo info at http://vger.kernel.org/majordomo-info.html\n); my $fail_path = "$fail_bin:$ENV{PATH}"; # for spamc ham mock local $ENV{PATH} = $fail_path; PublicInbox::Emergency->new($maildir)->prepare(\$msg); - $config->{'publicinboxwatch.spamcheck'} = 'spamc'; + $cfg->{'publicinboxwatch.spamcheck'} = 'spamc'; { local $SIG{__WARN__} = sub {}; # quiet spam check warning - PublicInbox::Watch->new($config)->scan('full'); + 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); } @@ -131,17 +138,14 @@ More majordomo info at http://vger.kernel.org/majordomo-info.html\n); my $main_path = "$main_bin:$ENV{PATH}"; # for spamc ham mock local $ENV{PATH} = $main_path; PublicInbox::Emergency->new($maildir)->prepare(\$msg); - $config->{'publicinboxwatch.spamcheck'} = 'spamc'; - @list = $git->qx(qw(ls-tree -r --name-only refs/heads/master)); - PublicInbox::Watch->new($config)->scan('full'); - @list = $git->qx(qw(ls-tree -r --name-only refs/heads/master)); + $cfg->{'publicinboxwatch.spamcheck'} = 'spamc'; + @list = $git->qx('ls-tree', '-r', '--name-only', $default_branch); + PublicInbox::Watch->new($cfg)->scan('full'); + @list = $git->qx('ls-tree', '-r', '--name-only', $default_branch); is(scalar @list, 1, 'tree has one file after spamc checked'); + 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); @@ -166,14 +175,14 @@ More majordomo info at http://vger.kernel.org/majordomo-info.html\n); $delivered++; }; PublicInbox::DS->Reset; - my $ii = PublicInbox::InboxIdle->new($config); + my $ii = PublicInbox::InboxIdle->new($cfg); my $obj = bless \$cb, 'PublicInbox::TestCommon::InboxWakeup'; - $config->each_inbox(sub { $_[0]->subscribe_unlock('ident', $obj) }); - PublicInbox::DS->SetPostLoopCallback(sub { $delivered == 0 }); + $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 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 12546418..fa86f7bf 100644 --- a/t/watch_maildir_v2.t +++ b/t/watch_maildir_v2.t @@ -1,14 +1,12 @@ -# Copyright (C) 2018-2020 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,17 +36,20 @@ 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 $config = PublicInbox::Config->new(\$orig); -my $ibx = $config->lookup_name('test'); +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($config)->scan('full'); +PublicInbox::Watch->new($cfg)->scan('full'); my $total = scalar @{$ibx->over->recent}; is($total, 1, 'got one revision'); @@ -68,7 +69,7 @@ my $write_spam = sub { }; $write_spam->(); is(unlink(glob("$maildir/new/*")), 1, 'unlinked old spam'); -PublicInbox::Watch->new($config)->scan('full'); +PublicInbox::Watch->new($cfg)->scan('full'); is_deeply($ibx->over->recent, [], 'deleted file'); is(unlink(glob("$spamdir/cur/*")), 1, 'unlinked trained spam'); @@ -79,7 +80,7 @@ To unsubscribe from this list: send the line "unsubscribe git" in 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($config)->scan('full'); + PublicInbox::Watch->new($cfg)->scan('full'); my $msgs = $ibx->over->recent; is(scalar(@$msgs), 1, 'got one file back'); my $mref = $ibx->msg_by_smsg($msgs->[0]); @@ -87,7 +88,7 @@ More majordomo info at http://vger.kernel.org/majordomo-info.html\n); is(unlink(glob("$maildir/new/*")), 1, 'unlinked spam'); $write_spam->(); - PublicInbox::Watch->new($config)->scan('full'); + PublicInbox::Watch->new($cfg)->scan('full'); $msgs = $ibx->over->recent; is(scalar(@$msgs), 0, 'inbox is empty again'); is(unlink(glob("$spamdir/cur/*")), 1, 'unlinked trained spam'); @@ -99,10 +100,10 @@ More majordomo info at http://vger.kernel.org/majordomo-info.html\n); my $fail_path = "$fail_bin:$ENV{PATH}"; # for spamc ham mock local $ENV{PATH} = $fail_path; PublicInbox::Emergency->new($maildir)->prepare(\$msg); - $config->{'publicinboxwatch.spamcheck'} = 'spamc'; + $cfg->{'publicinboxwatch.spamcheck'} = 'spamc'; { local $SIG{__WARN__} = sub {}; # quiet spam check warning - PublicInbox::Watch->new($config)->scan('full'); + PublicInbox::Watch->new($cfg)->scan('full'); } my $msgs = $ibx->over->recent; is(scalar(@$msgs), 0, 'inbox is still empty'); @@ -115,13 +116,13 @@ More majordomo info at http://vger.kernel.org/majordomo-info.html\n); my $main_path = "$main_bin:$ENV{PATH}"; # for spamc ham mock local $ENV{PATH} = $main_path; PublicInbox::Emergency->new($maildir)->prepare(\$msg); - $config->{'publicinboxwatch.spamcheck'} = 'spamc'; - PublicInbox::Watch->new($config)->scan('full'); + $cfg->{'publicinboxwatch.spamcheck'} = 'spamc'; + PublicInbox::Watch->new($cfg)->scan('full'); my $msgs = $ibx->over->recent; is(scalar(@$msgs), 1, 'inbox has one mail after spamc OK-ed a message'); my $mref = $ibx->msg_by_smsg($msgs->[0]); like($$mref, qr/something\n\z/s, 'message scrubbed on import'); - delete $config->{'publicinboxwatch.spamcheck'}; + delete $cfg->{'publicinboxwatch.spamcheck'}; } { @@ -129,7 +130,7 @@ More majordomo info at http://vger.kernel.org/majordomo-info.html\n); open my $fh, '<', $patch or die "failed to open $patch: $!\n"; $msg = do { local $/; <$fh> }; PublicInbox::Emergency->new($maildir)->prepare(\$msg); - PublicInbox::Watch->new($config)->scan('full'); + PublicInbox::Watch->new($cfg)->scan('full'); my $post = $ibx->search->reopen->mset('dfpost:6e006fd7'); is($post->size, 1, 'diff postimage found'); my $pre = $ibx->search->mset('dfpre:090d998b6c2c'); @@ -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 $cfg2 = <<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 $config = PublicInbox::Config->new(\$cfg2); my $both = <<EOF; From: user\@example.com To: $addr, $v1addr @@ -162,10 +164,10 @@ Date: Sat, 18 Jun 2016 00:00:00 +0000 both EOF PublicInbox::Emergency->new($maildir)->prepare(\$both); - PublicInbox::Watch->new($config)->scan('full'); + PublicInbox::Watch->new($cfg)->scan('full'); my $mset = $ibx->search->reopen->mset('m:both@b.com'); my $msgs = $ibx->search->mset_to_smsg($ibx, $mset); - my $v1 = $config->lookup_name('v1'); + my $v1 = $cfg->lookup_name('v1'); my $msg = $v1->git->cat_file($msgs->[0]->{blob}); is($both, $$msg, 'got original message back from v1'); $msg = $ibx->git->cat_file($msgs->[0]->{blob}); @@ -184,21 +186,24 @@ List-Id: <do.not.want> X-Mailing-List: no@example.com Message-ID: <do.not.want@example.com> EOF - my $cfg = $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 $config = PublicInbox::Config->new(\$cfg); - PublicInbox::Watch->new($config)->scan('full'); - $ibx = $config->lookup_name('test'); + 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'); - - $cfg = $orig."$cfgpfx.watchheader=X-Mailing-List:no\@example.com\n"; - $config = PublicInbox::Config->new(\$cfg); - PublicInbox::Watch->new($config)->scan('full'); - $ibx = $config->lookup_name('test'); + $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'); ok(defined $num, 'X-Mailing-List matched'); } 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 a0813532..9585da2b 100644 --- a/t/watch_multiple_headers.t +++ b/t/watch_multiple_headers.t @@ -1,11 +1,9 @@ -# Copyright (C) 2020 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,16 +52,17 @@ PublicInbox::Emergency->new($maildir)->prepare(\$msg_to); PublicInbox::Emergency->new($maildir)->prepare(\$msg_cc); PublicInbox::Emergency->new($maildir)->prepare(\$msg_none); -my $cfg = <<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 $config = PublicInbox::Config->new(\$cfg); -PublicInbox::Watch->new($config)->scan('full'); -my $ibx = $config->lookup_name('test'); + +PublicInbox::Watch->new($cfg)->scan('full'); +my $ibx = $cfg->lookup_name('test'); ok($ibx, 'found inbox by name'); my $num = $ibx->mm->num_for('to@a.com'); diff --git a/t/watch_nntp.t b/t/watch_nntp.t deleted file mode 100644 index ce1a3153..00000000 --- a/t/watch_nntp.t +++ /dev/null @@ -1,17 +0,0 @@ -# Copyright (C) 2020 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; -# see t/nntpd*.t for tests against a live NNTP server - -use_ok 'PublicInbox::Watch'; -my $nntp_url = \&PublicInbox::Watch::nntp_url; -is('news://example.com/inbox.foo', - $nntp_url->('NEWS://examplE.com/inbox.foo'), 'lowercased'); -is('nntps://example.com/inbox.foo', - $nntp_url->('nntps://example.com/inbox.foo'), 'nntps:// accepted'); -is('nntps://example.com/inbox.foo', - $nntp_url->('SNEWS://example.com/inbox.foo'), 'snews => nntps'); - -done_testing; diff --git a/t/www_altid.t b/t/www_altid.t index 337303d9..7ad4a1d2 100644 --- a/t/www_altid.t +++ b/t/www_altid.t @@ -1,56 +1,46 @@ -# Copyright (C) 2020 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) = ($sock->sockhost, $sock->sockport); - 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 4309a5e1..0a4c79e8 100644 --- a/t/www_listing.t +++ b/t/www_listing.t @@ -1,28 +1,23 @@ -# Copyright (C) 2019-2020 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(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; -my $json = do { - no warnings 'once'; - $PublicInbox::ManifestJsGz::json; -} or plan skip_all => "JSON module missing"; +use PublicInbox::Config; +my $json = PublicInbox::Config::json(); use_ok 'PublicInbox::Git'; my ($tmpdir, $for_destroy) = tmpdir(); my $bare = PublicInbox::Git->new("$tmpdir/bare.git"); PublicInbox::Import::init_bare($bare->{git_dir}); -is(PublicInbox::ManifestJsGz::fingerprint($bare), undef, - 'empty repo has no fingerprint'); +is($bare->manifest_entry, undef, 'empty repo has no manifest entry'); { my $fi_data = './t/git.fast-import-data'; open my $fh, '<', $fi_data or die "open $fi_data: $!"; @@ -31,31 +26,33 @@ is(PublicInbox::ManifestJsGz::fingerprint($bare), undef, 'fast-import'); } -like(PublicInbox::ManifestJsGz::fingerprint($bare), qr/\A[a-f0-9]{40}\z/, +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'); @@ -72,18 +69,22 @@ 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"; my $cfgfile = "$tmpdir/config"; my $v2 = "$tmpdir/v2"; my $sock = tcp_server(); - ok($sock, 'sock created'); - my ($host, $port) = ($sock->sockhost, $sock->sockport); + my ($host, $port) = tcp_host_port($sock); my @clone = qw(git clone -q -s --bare); is(xsys(@clone, $bare->{git_dir}, $alt), 0, 'clone shared repo'); @@ -92,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 @@ -116,55 +119,146 @@ 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 - skip('skipping grok-pull integration test', 2); + # 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; -# You can pull from multiple grok mirrors, just create -# a separate section for each mirror. The name can be anything. -[test] -site = http://$host:$port -manifest = http://$host:$port/manifest.js.gz + my $tail = tail_f("$tmpdir/grok.log"); + open $fh, '>', "$tmpdir/repos.conf" or xbail $!; + print $fh <<"" or xbail $!; +[core] toplevel = $tmpdir/mirror -mymanifest = $tmpdir/local-manifest.js.gz - - close $fh or die; +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 xbail $!; xsys($grok_pull, '-c', "$tmpdir/repos.conf"); - is($? >> 8, 127, 'grok-pull exit code as expected'); + 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)) { ok(-d "$tmpdir/mirror/$_", "grok-pull created $_"); } # support per-inbox manifests, handy for v2: # /$INBOX/v2/manifest.js.gz - open $fh, '>', "$tmpdir/per-inbox.conf" or die; - print $fh <<"" or die; -# You can pull from multiple grok mirrors, just create -# a separate section for each mirror. The name can be anything. -[v2] -site = http://$host:$port -manifest = http://$host:$port/v2/manifest.js.gz + open $fh, '>', "$tmpdir/per-inbox.conf" or xbail $!; + print $fh <<"" or xbail $!; +[core] toplevel = $tmpdir/per-inbox -mymanifest = $tmpdir/per-inbox-manifest.js.gz +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, 127, 'grok-pull exit code as expected'); + 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/www_static.t b/t/www_static.t index 364b9447..3281751c 100644 --- a/t/www_static.t +++ b/t/www_static.t @@ -1,4 +1,4 @@ -# Copyright (C) 2019-2020 all contributors <meta@public-inbox.org> +# 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; 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 ede736c1..7797aaaf 100644 --- a/t/xcpdb-reshard.t +++ b/t/xcpdb-reshard.t @@ -1,52 +1,50 @@ -# Copyright (C) 2019-2020 all contributors <meta@public-inbox.org> +#!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; |