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);
8 require_mods(qw(DBD::SQLite Search::Xapian));
10 my @onions = qw(http://hjrcffqmbrq6wope.onion/meta/
11 http://czquwvybam4bgbro.onion/meta/
12 http://ou63pmih66umazou.onion/meta/);
14 my $test_external_remote = sub {
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');
33 my ($ro_home, $cfg_path) = setup_public_inboxes;
35 my $home = $ENV{HOME};
36 my $config_file = "$home/.config/lei/config";
37 my $store_dir = "$home/.local/share/lei";
38 ok($lei->('ls-external'), 'ls-external works');
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');
43 ok(!$lei->('add-external', "$home/nonexistent"),
44 "fails on non-existent dir");
45 ok($lei->('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 {
50 ok($lei->(qw(add-external -q), $ibx->{inboxdir}),
52 is($lei_out.$lei_err, '', 'no output');
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 {
59 is($lcfg->{"external.$ibx->{inboxdir}.boost"}, 0,
60 "configured boost on $ibx->{name}");
62 $lei->('ls-external');
63 like($lei_out, qr/boost=0\n/s, 'ls-external has output');
64 ok($lei->(qw(add-external -q https://EXAMPLE.com/ibx)), 'add remote');
65 is($lei_err, '', 'no warnings after add-external');
67 ok($lei->(qw(_complete lei forget-external)), 'complete for externals');
68 my %comp = map { $_ => 1 } split(/\s+/, $lei_out);
69 ok($comp{'https://example.com/ibx/'}, 'forget external completion');
70 $cfg->each_inbox(sub {
72 ok($comp{$ibx->{inboxdir}}, "local $ibx->{name} completion");
74 for my $u (qw(h http https https: https:/ https:// https://e
75 https://example https://example. https://example.co
76 https://example.com https://example.com/
77 https://example.com/i https://example.com/ibx)) {
78 ok($lei->(qw(_complete lei forget-external), $u),
79 "partial completion for URL $u");
80 is($lei_out, "https://example.com/ibx/\n",
81 "completed partial URL $u");
82 for my $qo (qw(-I --include --exclude --only)) {
83 ok($lei->(qw(_complete lei q), $qo, $u),
84 "partial completion for URL q $qo $u");
85 is($lei_out, "https://example.com/ibx/\n",
86 "completed partial URL $u on q $qo");
89 ok($lei->(qw(_complete lei add-external), 'https://'),
90 'add-external hostname completion');
91 is($lei_out, "https://example.com/\n", 'completed up to hostname');
93 $lei->('ls-external');
94 like($lei_out, qr!https://example\.com/ibx/!s, 'added canonical URL');
95 is($lei_err, '', 'no warnings on ls-external');
96 ok($lei->(qw(forget-external -q https://EXAMPLE.com/ibx)),
98 $lei->('ls-external');
99 unlike($lei_out, qr!https://example\.com/ibx/!s,
100 'removed canonical URL');
102 ok(!$lei->(qw(q s:prefix -o /dev/null -f maildir)), 'bad maildir');
103 like($lei_err, qr!/dev/null exists and is not a directory!,
105 is($? >> 8, 1, 'errored out with exit 1');
107 ok(!$lei->(qw(q s:prefix -f mboxcl2 -o), $home), 'bad mbox');
108 like($lei_err, qr!\Q$home\E exists and is not a writable file!,
110 is($? >> 8, 1, 'errored out with exit 1');
112 ok(!$lei->(qw(q s:prefix -o /dev/stdout -f Mbox2)), 'bad format');
113 like($lei_err, qr/bad mbox --format=mbox2/, 'error shown');
114 is($? >> 8, 1, 'errored out with exit 1');
116 # note, on a Bourne shell users should be able to use either:
117 # s:"use boolean prefix"
118 # "s:use boolean prefix"
119 # or use single quotes, it should not matter. Users only need
120 # to know shell quoting rules, not Xapian quoting rules.
121 # No double-quoting should be imposed on users on the CLI
122 $lei->('q', 's:use boolean prefix');
123 like($lei_out, qr/search: use boolean prefix/,
124 'phrase search got result');
125 my $res = json_utf8->decode($lei_out);
126 is(scalar(@$res), 2, 'only 2 element array (1 result)');
127 is($res->[1], undef, 'final element is undef'); # XXX should this be?
128 is(ref($res->[0]), 'HASH', 'first element is hashref');
129 $lei->('q', '--pretty', 's:use boolean prefix');
130 my $pretty = json_utf8->decode($lei_out);
131 is_deeply($res, $pretty, '--pretty is identical after decode');
134 open my $fh, '+>', undef or BAIL_OUT $!;
136 print $fh 's:use' or BAIL_OUT $!;
137 seek($fh, 0, SEEK_SET) or BAIL_OUT $!;
138 ok($lei->([qw(q -q --stdin)], undef, { %$lei_opt, 0 => $fh }),
139 '--stdin on regular file works');
140 like($lei_out, qr/use boolean/, '--stdin on regular file');
143 pipe(my ($r, $w)) or BAIL_OUT $!;
144 print $w 's:use' or BAIL_OUT $!;
145 close $w or BAIL_OUT $!;
146 ok($lei->([qw(q -q --stdin)], undef, { %$lei_opt, 0 => $r }),
147 '--stdin on pipe file works');
148 like($lei_out, qr/use boolean prefix/, '--stdin on pipe');
150 ok(!$lei->(qw(q -q --stdin s:use)), "--stdin and argv don't mix");
152 for my $fmt (qw(ldjson ndjson jsonl)) {
153 $lei->('q', '-f', $fmt, 's:use boolean prefix');
154 is($lei_out, json_utf8->encode($pretty->[0])."\n", "-f $fmt");
157 require IO::Uncompress::Gunzip;
158 for my $sfx ('', '.gz') {
159 my $f = "$home/mbox$sfx";
160 $lei->('q', '-o', "mboxcl2:$f", 's:use boolean prefix');
161 my $cat = $sfx eq '' ? sub {
162 open my $mb, '<', $f or fail "no mbox: $!";
165 my $z = IO::Uncompress::Gunzip->new($f, MultiStream=>1);
168 my @s = grep(/^Subject:/, $cat->());
169 is(scalar(@s), 1, "1 result in mbox$sfx");
170 $lei->('q', '-a', '-o', "mboxcl2:$f", 's:see attachment');
171 is(grep(!/^#/, $lei_err), 0, 'no errors from augment');
172 @s = grep(/^Subject:/, my @wtf = $cat->());
173 is(scalar(@s), 2, "2 results in mbox$sfx");
175 $lei->('q', '-a', '-o', "mboxcl2:$f", 's:nonexistent');
176 is(grep(!/^#/, $lei_err), 0, "no errors on no results ($sfx)");
178 my @s2 = grep(/^Subject:/, $cat->());
180 "same 2 old results w/ --augment and bad search $sfx");
182 $lei->('q', '-o', "mboxcl2:$f", 's:nonexistent');
184 is_deeply(\@res, [], "clobber w/o --augment $sfx");
186 ok(!$lei->('q', '-o', "$home/mbox", 's:nope'),
187 'fails if mbox format unspecified');
188 ok(!$lei->(qw(q --no-local s:see)), '--no-local');
189 is($? >> 8, 1, 'proper exit code');
190 like($lei_err, qr/no local or remote.+? to search/, 'no inbox');
192 TEST_LEI_EXTERNAL_HTTPS => 'https://public-inbox.org/meta/',
193 TEST_LEI_EXTERNAL_ONION => $onions[int(rand(scalar(@onions)))],
195 for my $k (keys %e) {
196 my $url = $ENV{$k} // '';
197 $url = $e{$k} if $url eq '1';
198 $test_external_remote->($url, $k);