t/lei-externals.t

   1 #!perl -w
   2 # Copyright (C) 2020-2021 all contributors <meta@public-inbox.org>
   3 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   4 use strict; use v5.10.1; use PublicInbox::TestCommon;
   5 use Fcntl qw(SEEK_SET);
   6 use PublicInbox::Spawn qw(which);
   7
   8 my @onions = qw(http://hjrcffqmbrq6wope.onion/meta/
   9         http://czquwvybam4bgbro.onion/meta/
  10         http://ou63pmih66umazou.onion/meta/);
  11
  12 # TODO share this across tests, it takes ~300ms
  13 my $setup_publicinboxes = sub {
  14         my ($home) = @_;
  15         use PublicInbox::InboxWritable;
  16         for my $V (1, 2) {
  17                 run_script([qw(-init), "-V$V", "t$V",
  18                                 '--newsgroup', "t.$V",
  19                                 "$home/t$V", "http://example.com/t$V",
  20                                 "t$V\@example.com" ]) or BAIL_OUT "init v$V";
  21         }
  22         my $cfg = PublicInbox::Config->new;
  23         my $seen = 0;
  24         $cfg->each_inbox(sub {
  25                 my ($ibx) = @_;
  26                 my $im = PublicInbox::InboxWritable->new($ibx)->importer(0);
  27                 my $V = $ibx->version;
  28                 my @eml = (glob('t/*.eml'), 't/data/0001.patch');
  29                 for (@eml) {
  30                         next if $_ eq 't/psgi_v2-old.eml'; # dup mid
  31                         $im->add(eml_load($_)) or BAIL_OUT "v$V add $_";
  32                         $seen++;
  33                 }
  34                 $im->done;
  35                 if ($V == 1) {
  36                         run_script(['-index', $ibx->{inboxdir}]) or
  37                                 BAIL_OUT 'index v1';
  38                 }
  39         });
  40         $seen || BAIL_OUT 'no imports';
  41 };
  42
  43 my $test_external_remote = sub {
  44         my ($url, $k) = @_;
  45 SKIP: {
  46         my $nr = 5;
  47         skip "$k unset", $nr if !$url;
  48         which('curl') or skip 'no curl', $nr;
  49         which('torsocks') or skip 'no torsocks', $nr if $url =~ m!\.onion/!;
  50         my $mid = '20140421094015.GA8962@dcvr.yhbt.net';
  51         my @cmd = ('q', '--only', $url, '-q', "m:$mid");
  52         ok($lei->(@cmd), "query $url");
  53         is($lei_err, '', "no errors on $url");
  54         my $res = json_utf8->decode($lei_out);
  55         is($res->[0]->{'m'}, "<$mid>", "got expected mid from $url");
  56         ok($lei->(@cmd, 'd:..20101002'), 'no results, no error');
  57         is($lei_err, '', 'no output on 404, matching local FS behavior');
  58         is($lei_out, "[null]\n", 'got null results');
  59 } # /SKIP
  60 }; # /sub
  61
  62 test_lei(sub {
  63         my $home = $ENV{HOME};
  64         $setup_publicinboxes->($home);
  65         my $config_file = "$home/.config/lei/config";
  66         my $store_dir = "$home/.local/share/lei";
  67         ok($lei->('ls-external'), 'ls-external works');
  68         is($lei_out.$lei_err, '', 'ls-external no output, yet');
  69         ok(!-e $config_file && !-e $store_dir,
  70                 'nothing created by ls-external');
  71
  72         ok(!$lei->('add-external', "$home/nonexistent"),
  73                 "fails on non-existent dir");
  74         ok($lei->('ls-external'), 'ls-external works after add failure');
  75         is($lei_out.$lei_err, '', 'ls-external still has no output');
  76         my $cfg = PublicInbox::Config->new;
  77         $cfg->each_inbox(sub {
  78                 my ($ibx) = @_;
  79                 ok($lei->(qw(add-external -q), $ibx->{inboxdir}),
  80                         'added external');
  81                 is($lei_out.$lei_err, '', 'no output');
  82         });
  83         ok(-s $config_file && -e $store_dir,
  84                 'add-external created config + store');
  85         my $lcfg = PublicInbox::Config->new($config_file);
  86         $cfg->each_inbox(sub {
  87                 my ($ibx) = @_;
  88                 is($lcfg->{"external.$ibx->{inboxdir}.boost"}, 0,
  89                         "configured boost on $ibx->{name}");
  90         });
  91         $lei->('ls-external');
  92         like($lei_out, qr/boost=0\n/s, 'ls-external has output');
  93         ok($lei->(qw(add-external -q https://EXAMPLE.com/ibx)), 'add remote');
  94         is($lei_err, '', 'no warnings after add-external');
  95
  96         ok($lei->(qw(_complete lei forget-external)), 'complete for externals');
  97         my %comp = map { $_ => 1 } split(/\s+/, $lei_out);
  98         ok($comp{'https://example.com/ibx/'}, 'forget external completion');
  99         $cfg->each_inbox(sub {
 100                 my ($ibx) = @_;
 101                 ok($comp{$ibx->{inboxdir}}, "local $ibx->{name} completion");
 102         });
 103         for my $u (qw(h http https https: https:/ https:// https://e
 104                         https://example https://example. https://example.co
 105                         https://example.com https://example.com/
 106                         https://example.com/i https://example.com/ibx)) {
 107                 ok($lei->(qw(_complete lei forget-external), $u),
 108                         "partial completion for URL $u");
 109                 is($lei_out, "https://example.com/ibx/\n",
 110                         "completed partial URL $u");
 111                 for my $qo (qw(-I --include --exclude --only)) {
 112                         ok($lei->(qw(_complete lei q), $qo, $u),
 113                                 "partial completion for URL q $qo $u");
 114                         is($lei_out, "https://example.com/ibx/\n",
 115                                 "completed partial URL $u on q $qo");
 116                 }
 117         }
 118         ok($lei->(qw(_complete lei add-external), 'https://'),
 119                 'add-external hostname completion');
 120         is($lei_out, "https://example.com/\n", 'completed up to hostname');
 121
 122         $lei->('ls-external');
 123         like($lei_out, qr!https://example\.com/ibx/!s, 'added canonical URL');
 124         is($lei_err, '', 'no warnings on ls-external');
 125         ok($lei->(qw(forget-external -q https://EXAMPLE.com/ibx)),
 126                 'forget');
 127         $lei->('ls-external');
 128         unlike($lei_out, qr!https://example\.com/ibx/!s,
 129                 'removed canonical URL');
 130 SKIP: {
 131         ok(!$lei->(qw(q s:prefix -o /dev/null -f maildir)), 'bad maildir');
 132         like($lei_err, qr!/dev/null exists and is not a directory!,
 133                 'error shown');
 134         is($? >> 8, 1, 'errored out with exit 1');
 135
 136         ok(!$lei->(qw(q s:prefix -f mboxcl2 -o), $home), 'bad mbox');
 137         like($lei_err, qr!\Q$home\E exists and is not a writable file!,
 138                 'error shown');
 139         is($? >> 8, 1, 'errored out with exit 1');
 140
 141         ok(!$lei->(qw(q s:prefix -o /dev/stdout -f Mbox2)), 'bad format');
 142         like($lei_err, qr/bad mbox --format=mbox2/, 'error shown');
 143         is($? >> 8, 1, 'errored out with exit 1');
 144
 145         # note, on a Bourne shell users should be able to use either:
 146         #       s:"use boolean prefix"
 147         #       "s:use boolean prefix"
 148         # or use single quotes, it should not matter.  Users only need
 149         # to know shell quoting rules, not Xapian quoting rules.
 150         # No double-quoting should be imposed on users on the CLI
 151         $lei->('q', 's:use boolean prefix');
 152         like($lei_out, qr/search: use boolean prefix/,
 153                 'phrase search got result');
 154         my $res = json_utf8->decode($lei_out);
 155         is(scalar(@$res), 2, 'only 2 element array (1 result)');
 156         is($res->[1], undef, 'final element is undef'); # XXX should this be?
 157         is(ref($res->[0]), 'HASH', 'first element is hashref');
 158         $lei->('q', '--pretty', 's:use boolean prefix');
 159         my $pretty = json_utf8->decode($lei_out);
 160         is_deeply($res, $pretty, '--pretty is identical after decode');
 161
 162         {
 163                 open my $fh, '+>', undef or BAIL_OUT $!;
 164                 $fh->autoflush(1);
 165                 print $fh 's:use' or BAIL_OUT $!;
 166                 seek($fh, 0, SEEK_SET) or BAIL_OUT $!;
 167                 ok($lei->([qw(q -q --stdin)], undef, { %$lei_opt, 0 => $fh }),
 168                                 '--stdin on regular file works');
 169                 like($lei_out, qr/use boolean/, '--stdin on regular file');
 170         }
 171         {
 172                 pipe(my ($r, $w)) or BAIL_OUT $!;
 173                 print $w 's:use' or BAIL_OUT $!;
 174                 close $w or BAIL_OUT $!;
 175                 ok($lei->([qw(q -q --stdin)], undef, { %$lei_opt, 0 => $r }),
 176                                 '--stdin on pipe file works');
 177                 like($lei_out, qr/use boolean prefix/, '--stdin on pipe');
 178         }
 179         ok(!$lei->(qw(q -q --stdin s:use)), "--stdin and argv don't mix");
 180
 181         for my $fmt (qw(ldjson ndjson jsonl)) {
 182                 $lei->('q', '-f', $fmt, 's:use boolean prefix');
 183                 is($lei_out, json_utf8->encode($pretty->[0])."\n", "-f $fmt");
 184         }
 185
 186         require IO::Uncompress::Gunzip;
 187         for my $sfx ('', '.gz') {
 188                 my $f = "$home/mbox$sfx";
 189                 $lei->('q', '-o', "mboxcl2:$f", 's:use boolean prefix');
 190                 my $cat = $sfx eq '' ? sub {
 191                         open my $mb, '<', $f or fail "no mbox: $!";
 192                         <$mb>
 193                 } : sub {
 194                         my $z = IO::Uncompress::Gunzip->new($f, MultiStream=>1);
 195                         <$z>;
 196                 };
 197                 my @s = grep(/^Subject:/, $cat->());
 198                 is(scalar(@s), 1, "1 result in mbox$sfx");
 199                 $lei->('q', '-a', '-o', "mboxcl2:$f", 's:see attachment');
 200                 is(grep(!/^#/, $lei_err), 0, 'no errors from augment');
 201                 @s = grep(/^Subject:/, my @wtf = $cat->());
 202                 is(scalar(@s), 2, "2 results in mbox$sfx");
 203
 204                 $lei->('q', '-a', '-o', "mboxcl2:$f", 's:nonexistent');
 205                 is(grep(!/^#/, $lei_err), 0, "no errors on no results ($sfx)");
 206
 207                 my @s2 = grep(/^Subject:/, $cat->());
 208                 is_deeply(\@s2, \@s,
 209                         "same 2 old results w/ --augment and bad search $sfx");
 210
 211                 $lei->('q', '-o', "mboxcl2:$f", 's:nonexistent');
 212                 my @res = $cat->();
 213                 is_deeply(\@res, [], "clobber w/o --augment $sfx");
 214         }
 215         ok(!$lei->('q', '-o', "$home/mbox", 's:nope'),
 216                         'fails if mbox format unspecified');
 217         ok(!$lei->(qw(q --no-local s:see)), '--no-local');
 218         is($? >> 8, 1, 'proper exit code');
 219         like($lei_err, qr/no local or remote.+? to search/, 'no inbox');
 220         my %e = (
 221                 TEST_LEI_EXTERNAL_HTTPS => 'https://public-inbox.org/meta/',
 222                 TEST_LEI_EXTERNAL_ONION => $onions[int(rand(scalar(@onions)))],
 223         );
 224         for my $k (keys %e) {
 225                 my $url = $ENV{$k} // '';
 226                 $url = $e{$k} if $url eq '1';
 227                 $test_external_remote->($url, $k);
 228         }
 229         }; # /SKIP
 230 }); # test_lei
 231 done_testing;