diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | t/lei-externals.t | 231 | ||||
| -rw-r--r-- | t/lei.t | 225 |
3 files changed, 232 insertions, 225 deletions
@@ -351,6 +351,7 @@ t/init.t t/ipc.t t/iso-2202-jp.eml t/kqnotify.t +t/lei-externals.t t/lei-import.t t/lei-oneshot.t t/lei.t diff --git a/t/lei-externals.t b/t/lei-externals.t new file mode 100644 index 00000000..739f779d --- /dev/null +++ b/t/lei-externals.t @@ -0,0 +1,231 @@ +#!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); +use PublicInbox::Spawn qw(which); + +my @onions = qw(http://hjrcffqmbrq6wope.onion/meta/ + http://czquwvybam4bgbro.onion/meta/ + http://ou63pmih66umazou.onion/meta/); + +# TODO share this across tests, it takes ~300ms +my $setup_publicinboxes = sub { + my ($home) = @_; + use PublicInbox::InboxWritable; + for my $V (1, 2) { + run_script([qw(-init), "-V$V", "t$V", + '--newsgroup', "t.$V", + "$home/t$V", "http://example.com/t$V", + "t$V\@example.com" ]) or BAIL_OUT "init v$V"; + } + my $cfg = PublicInbox::Config->new; + my $seen = 0; + $cfg->each_inbox(sub { + my ($ibx) = @_; + my $im = PublicInbox::InboxWritable->new($ibx)->importer(0); + my $V = $ibx->version; + my @eml = (glob('t/*.eml'), 't/data/0001.patch'); + for (@eml) { + next if $_ eq 't/psgi_v2-old.eml'; # dup mid + $im->add(eml_load($_)) or BAIL_OUT "v$V add $_"; + $seen++; + } + $im->done; + if ($V == 1) { + run_script(['-index', $ibx->{inboxdir}]) or + BAIL_OUT 'index v1'; + } + }); + $seen || BAIL_OUT 'no imports'; +}; + +my $test_external_remote = sub { + my ($url, $k) = @_; +SKIP: { + my $nr = 5; + skip "$k unset", $nr if !$url; + which('curl') or skip 'no curl', $nr; + which('torsocks') or skip 'no torsocks', $nr if $url =~ m!\.onion/!; + my $mid = '20140421094015.GA8962@dcvr.yhbt.net'; + my @cmd = ('q', '--only', $url, '-q', "m:$mid"); + ok($lei->(@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"); + ok($lei->(@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'); +} # /SKIP +}; # /sub + +test_lei(sub { + my $home = $ENV{HOME}; + $setup_publicinboxes->($home); + my $config_file = "$home/.config/lei/config"; + my $store_dir = "$home/.local/share/lei"; + ok($lei->('ls-external'), 'ls-external works'); + is($lei_out.$lei_err, '', 'ls-external no output, yet'); + ok(!-e $config_file && !-e $store_dir, + 'nothing created by ls-external'); + + ok(!$lei->('add-external', "$home/nonexistent"), + "fails on non-existent dir"); + ok($lei->('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->each_inbox(sub { + my ($ibx) = @_; + ok($lei->(qw(add-external -q), $ibx->{inboxdir}), + 'added external'); + is($lei_out.$lei_err, '', 'no output'); + }); + ok(-s $config_file && -e $store_dir, + 'add-external created config + store'); + 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->('ls-external'); + like($lei_out, qr/boost=0\n/s, 'ls-external has output'); + ok($lei->(qw(add-external -q https://EXAMPLE.com/ibx)), 'add remote'); + is($lei_err, '', 'no warnings after add-external'); + + ok($lei->(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'); + $cfg->each_inbox(sub { + my ($ibx) = @_; + 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)) { + ok($lei->(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)) { + ok($lei->(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"); + } + } + ok($lei->(qw(_complete lei add-external), 'https://'), + 'add-external hostname completion'); + is($lei_out, "https://example.com/\n", 'completed up to hostname'); + + $lei->('ls-external'); + like($lei_out, qr!https://example\.com/ibx/!s, 'added canonical URL'); + is($lei_err, '', 'no warnings on ls-external'); + ok($lei->(qw(forget-external -q https://EXAMPLE.com/ibx)), + 'forget'); + $lei->('ls-external'); + unlike($lei_out, qr!https://example\.com/ibx/!s, + 'removed canonical URL'); +SKIP: { + ok(!$lei->(qw(q s:prefix -o /dev/null -f maildir)), '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 -f mboxcl2 -o), $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 /dev/stdout -f Mbox2)), '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->('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->('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' or BAIL_OUT $!; + seek($fh, 0, SEEK_SET) or BAIL_OUT $!; + ok($lei->([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 $!; + ok($lei->([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"); + + for my $fmt (qw(ldjson ndjson jsonl)) { + $lei->('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->('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->('q', '-a', '-o', "mboxcl2:$f", 's:see attachment'); + is(grep(!/^#/, $lei_err), 0, 'no errors from augment'); + @s = grep(/^Subject:/, my @wtf = $cat->()); + is(scalar(@s), 2, "2 results in mbox$sfx"); + + $lei->('q', '-a', '-o', "mboxcl2:$f", 's:nonexistent'); + is(grep(!/^#/, $lei_err), 0, "no errors on no results ($sfx)"); + + my @s2 = grep(/^Subject:/, $cat->()); + is_deeply(\@s2, \@s, + "same 2 old results w/ --augment and bad search $sfx"); + + $lei->('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'); + 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'); + 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); + } + }; # /SKIP +}); # test_lei +done_testing; @@ -7,7 +7,6 @@ use Test::More; use PublicInbox::TestCommon; use PublicInbox::Config; use File::Path qw(rmtree); -use Fcntl qw(SEEK_SET); use PublicInbox::Spawn qw(which); my $req_sendcmd = 'Socket::MsgHdr or Inline::C missing or unconfigured'; undef($req_sendcmd) if PublicInbox::Spawn->can('send_cmd4'); @@ -18,9 +17,6 @@ my $opt = { 1 => \(my $out = ''), 2 => \(my $err = '') }; my ($home, $for_destroy) = tmpdir(); my $err_filter; my $curl = which('curl'); -my @onions = qw(http://hjrcffqmbrq6wope.onion/meta/ - http://czquwvybam4bgbro.onion/meta/ - http://ou63pmih66umazou.onion/meta/); my $json = ref(PublicInbox::Config->json)->new->utf8->canonical; my $lei = sub { my ($cmd, $env, $xopt) = @_; @@ -130,226 +126,6 @@ my $test_config = sub { ok(!-f "$home/config/f", 'no file created'); }; -my $setup_publicinboxes = sub { - state $done = ''; - return if $done eq $home; - use PublicInbox::InboxWritable; - for my $V (1, 2) { - run_script([qw(-init), "-V$V", "t$V", - '--newsgroup', "t.$V", - "$home/t$V", "http://example.com/t$V", - "t$V\@example.com" ]) or BAIL_OUT "init v$V"; - } - my $cfg = PublicInbox::Config->new; - my $seen = 0; - $cfg->each_inbox(sub { - my ($ibx) = @_; - my $im = PublicInbox::InboxWritable->new($ibx)->importer(0); - my $V = $ibx->version; - my @eml = (glob('t/*.eml'), 't/data/0001.patch'); - for (@eml) { - next if $_ eq 't/psgi_v2-old.eml'; # dup mid - $im->add(eml_load($_)) or BAIL_OUT "v$V add $_"; - $seen++; - } - $im->done; - if ($V == 1) { - run_script(['-index', $ibx->{inboxdir}]) or - BAIL_OUT 'index v1'; - } - }); - $done = $home; - $seen || BAIL_OUT 'no imports'; -}; - -my $test_external_remote = sub { - my ($url, $k) = @_; -SKIP: { - my $nr = 5; - skip "$k unset", $nr if !$url; - skip $req_sendcmd, $nr if $req_sendcmd; - $curl or skip 'no curl', $nr; - which('torsocks') or skip 'no torsocks', $nr if $url =~ m!\.onion/!; - my $mid = '20140421094015.GA8962@dcvr.yhbt.net'; - my @cmd = ('q', '--only', $url, '-q', "m:$mid"); - ok($lei->(@cmd), "query $url"); - is($err, '', "no errors on $url"); - my $res = $json->decode($out); - is($res->[0]->{'m'}, "<$mid>", "got expected mid from $url"); - ok($lei->(@cmd, 'd:..20101002'), 'no results, no error'); - is($err, '', 'no output on 404, matching local FS behavior'); - is($out, "[null]\n", 'got null results'); -} # /SKIP -}; # /sub - -my $test_external = sub { - $setup_publicinboxes->(); - $cleanup->(); - $lei->('ls-external'); - is($out.$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"); - $lei->('ls-external'); - is($out.$err, '', 'ls-external still has no output'); - my $cfg = PublicInbox::Config->new; - $cfg->each_inbox(sub { - my ($ibx) = @_; - ok($lei->(qw(add-external -q), $ibx->{inboxdir}), - 'added external'); - is($out.$err, '', 'no output'); - }); - ok(-s $config_file && -e $store_dir, - 'add-external created config + store'); - 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->('ls-external'); - like($out, qr/boost=0\n/s, 'ls-external has output'); - ok($lei->(qw(add-external -q https://EXAMPLE.com/ibx)), 'add remote'); - is($err, '', 'no warnings after add-external'); - - ok($lei->(qw(_complete lei forget-external)), 'complete for externals'); - my %comp = map { $_ => 1 } split(/\s+/, $out); - ok($comp{'https://example.com/ibx/'}, 'forget external completion'); - $cfg->each_inbox(sub { - my ($ibx) = @_; - 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)) { - ok($lei->(qw(_complete lei forget-external), $u), - "partial completion for URL $u"); - is($out, "https://example.com/ibx/\n", - "completed partial URL $u"); - for my $qo (qw(-I --include --exclude --only)) { - ok($lei->(qw(_complete lei q), $qo, $u), - "partial completion for URL q $qo $u"); - is($out, "https://example.com/ibx/\n", - "completed partial URL $u on q $qo"); - } - } - ok($lei->(qw(_complete lei add-external), 'https://'), - 'add-external hostname completion'); - is($out, "https://example.com/\n", 'completed up to hostname'); - - $lei->('ls-external'); - like($out, qr!https://example\.com/ibx/!s, 'added canonical URL'); - is($err, '', 'no warnings on ls-external'); - ok($lei->(qw(forget-external -q https://EXAMPLE.com/ibx)), - 'forget'); - $lei->('ls-external'); - unlike($out, qr!https://example\.com/ibx/!s, 'removed canonical URL'); - -SKIP: { - skip $req_sendcmd, 52 if $req_sendcmd; - ok(!$lei->(qw(q s:prefix -o /dev/null -f maildir)), 'bad maildir'); - like($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 -f mboxcl2 -o), $home), 'bad mbox'); - like($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 /dev/stdout -f Mbox2)), 'bad format'); - like($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->('q', 's:use boolean prefix'); - like($out, qr/search: use boolean prefix/, 'phrase search got result'); - my $res = $json->decode($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->('q', '--pretty', 's:use boolean prefix'); - my $pretty = $json->decode($out); - is_deeply($res, $pretty, '--pretty is identical after decode'); - - { - open my $fh, '+>', undef or BAIL_OUT $!; - $fh->autoflush(1); - print $fh 's:use' or BAIL_OUT $!; - seek($fh, 0, SEEK_SET) or BAIL_OUT $!; - ok($lei->([qw(q -q --stdin)], undef, { %$opt, 0 => $fh }), - '--stdin on regular file works'); - like($out, qr/use boolean prefix/, '--stdin on regular file'); - } - { - pipe(my ($r, $w)) or BAIL_OUT $!; - print $w 's:use' or BAIL_OUT $!; - close $w or BAIL_OUT $!; - ok($lei->([qw(q -q --stdin)], undef, { %$opt, 0 => $r }), - '--stdin on pipe file works'); - like($out, qr/use boolean prefix/, '--stdin on pipe'); - } - ok(!$lei->(qw(q -q --stdin s:use)), "--stdin and argv don't mix"); - - for my $fmt (qw(ldjson ndjson jsonl)) { - $lei->('q', '-f', $fmt, 's:use boolean prefix'); - is($out, $json->encode($pretty->[0])."\n", "-f $fmt"); - } - - require IO::Uncompress::Gunzip; - for my $sfx ('', '.gz') { - my $f = "$home/mbox$sfx"; - $lei->('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->('q', '-a', '-o', "mboxcl2:$f", 's:see attachment'); - is(grep(!/^#/, $err), 0, 'no errors from augment'); - @s = grep(/^Subject:/, my @wtf = $cat->()); - is(scalar(@s), 2, "2 results in mbox$sfx"); - - $lei->('q', '-a', '-o', "mboxcl2:$f", 's:nonexistent'); - is(grep(!/^#/, $err), 0, "no errors on no results ($sfx)"); - - my @s2 = grep(/^Subject:/, $cat->()); - is_deeply(\@s2, \@s, - "same 2 old results w/ --augment and bad search $sfx"); - - $lei->('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'); - ok(!$lei->(qw(q --no-local s:see)), '--no-local'); - is($? >> 8, 1, 'proper exit code'); - like($err, qr/no local or remote.+? to search/, 'no inbox'); - 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); - } - }; # /SKIP -}; - my $test_completion = sub { ok($lei->(qw(_complete lei)), 'no errors on complete'); my %out = map { $_ => 1 } split(/\s+/s, $out); @@ -398,7 +174,6 @@ my $test_lei_common = sub { $test_help->(); $test_config->(); $test_init->(); - $test_external->(); $test_completion->(); $test_fail->(); }; |