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