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