t/lei.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;
   5 use v5.10.1;
   6 use Test::More;
   7 use PublicInbox::TestCommon;
   8 use PublicInbox::Config;
   9 use File::Path qw(rmtree);
  10 use PublicInbox::Spawn qw(which);
  11 my $req_sendcmd = 'Socket::MsgHdr or Inline::C missing or unconfigured';
  12 undef($req_sendcmd) if PublicInbox::Spawn->can('send_cmd4');
  13 eval { require Socket::MsgHdr; undef $req_sendcmd };
  14 require_git 2.6;
  15 require_mods(qw(json DBD::SQLite Search::Xapian));
  16 my $opt = { 1 => \(my $out = ''), 2 => \(my $err = '') };
  17 my ($home, $for_destroy) = tmpdir();
  18 my $err_filter;
  19 my $curl = which('curl');
  20 my $json = ref(PublicInbox::Config->json)->new->utf8->canonical;
  21 my $lei = sub {
  22         my ($cmd, $env, $xopt) = @_;
  23         $out = $err = '';
  24         if (!ref($cmd)) {
  25                 ($env, $xopt) = grep { (!defined) || ref } @_;
  26                 $cmd = [ grep { defined && !ref } @_ ];
  27         }
  28         my $res = run_script(['lei', @$cmd], $env, $xopt // $opt);
  29         $err_filter and
  30                 $err = join('', grep(!/$err_filter/, split(/^/m, $err)));
  31         $res;
  32 };
  33
  34 delete local $ENV{XDG_DATA_HOME};
  35 delete local $ENV{XDG_CONFIG_HOME};
  36 local $ENV{GIT_COMMITTER_EMAIL} = 'lei@example.com';
  37 local $ENV{GIT_COMMITTER_NAME} = 'lei user';
  38 local $ENV{XDG_RUNTIME_DIR} = "$home/xdg_run";
  39 local $ENV{HOME} = $home;
  40 mkdir "$home/xdg_run", 0700 or BAIL_OUT "mkdir: $!";
  41 my $home_trash = [ "$home/.local", "$home/.config", "$home/junk" ];
  42 my $cleanup = sub { rmtree([@$home_trash, @_]) };
  43 my $config_file = "$home/.config/lei/config";
  44 my $store_dir = "$home/.local/share/lei";
  45
  46 my $test_help = sub {
  47         ok(!$lei->(), 'no args fails');
  48         is($? >> 8, 1, '$? is 1');
  49         is($out, '', 'nothing in stdout');
  50         like($err, qr/^usage:/sm, 'usage in stderr');
  51
  52         for my $arg (['-h'], ['--help'], ['help'], [qw(daemon-pid --help)]) {
  53                 ok($lei->($arg), "lei @$arg");
  54                 like($out, qr/^usage:/sm, "usage in stdout (@$arg)");
  55                 is($err, '', "nothing in stderr (@$arg)");
  56         }
  57
  58         for my $arg ([''], ['--halp'], ['halp'], [qw(daemon-pid --halp)]) {
  59                 ok(!$lei->($arg), "lei @$arg");
  60                 is($? >> 8, 1, '$? set correctly');
  61                 isnt($err, '', 'something in stderr');
  62                 is($out, '', 'nothing in stdout');
  63         }
  64         ok($lei->(qw(init -h)), 'init -h');
  65         like($out, qr! \Q$home\E/\.local/share/lei/store\b!,
  66                 'actual path shown in init -h');
  67         ok($lei->(qw(init -h), { XDG_DATA_HOME => '/XDH' }),
  68                 'init with XDG_DATA_HOME');
  69         like($out, qr! /XDH/lei/store\b!, 'XDG_DATA_HOME in init -h');
  70         is($err, '', 'no errors from init -h');
  71
  72         ok($lei->(qw(config -h)), 'config-h');
  73         like($out, qr! \Q$home\E/\.config/lei/config\b!,
  74                 'actual path shown in config -h');
  75         ok($lei->(qw(config -h), { XDG_CONFIG_HOME => '/XDC' }),
  76                 'config with XDG_CONFIG_HOME');
  77         like($out, qr! /XDC/lei/config\b!, 'XDG_CONFIG_HOME in config -h');
  78         is($err, '', 'no errors from config -h');
  79 };
  80
  81 my $ok_err_info = sub {
  82         my ($msg) = @_;
  83         is(grep(!/^I:/, split(/^/, $err)), 0, $msg) or
  84                 diag "$msg: err=$err";
  85 };
  86
  87 my $test_init = sub {
  88         $cleanup->();
  89         ok($lei->('init'), 'init w/o args');
  90         $ok_err_info->('after init w/o args');
  91         ok($lei->('init'), 'idempotent init w/o args');
  92         $ok_err_info->('after idempotent init w/o args');
  93
  94         ok(!$lei->('init', "$home/x"), 'init conflict');
  95         is(grep(/^E:/, split(/^/, $err)), 1, 'got error on conflict');
  96         ok(!-e "$home/x", 'nothing created on conflict');
  97         $cleanup->();
  98
  99         ok($lei->('init', "$home/x"), 'init conflict resolved');
 100         $ok_err_info->('init w/ arg');
 101         ok($lei->('init', "$home/x"), 'init idempotent w/ path');
 102         $ok_err_info->('init idempotent w/ arg');
 103         ok(-d "$home/x", 'created dir');
 104         $cleanup->("$home/x");
 105
 106         ok(!$lei->('init', "$home/x", "$home/2"), 'too many args fails');
 107         like($err, qr/too many/, 'noted excessive');
 108         ok(!-e "$home/x", 'x not created on excessive');
 109         for my $d (@$home_trash) {
 110                 my $base = (split(m!/!, $d))[-1];
 111                 ok(!-d $d, "$base not created");
 112         }
 113         is($out, '', 'nothing in stdout on init failure');
 114 };
 115
 116 my $test_config = sub {
 117         $cleanup->();
 118         ok($lei->(qw(config a.b c)), 'config set var');
 119         is($out.$err, '', 'no output on var set');
 120         ok($lei->(qw(config -l)), 'config -l');
 121         is($err, '', 'no errors on listing');
 122         is($out, "a.b=c\n", 'got expected output');
 123         ok(!$lei->(qw(config -f), "$home/.config/f", qw(x.y z)),
 124                         'config set var with -f fails');
 125         like($err, qr/not supported/, 'not supported noted');
 126         ok(!-f "$home/config/f", 'no file created');
 127 };
 128
 129 my $test_completion = sub {
 130         ok($lei->(qw(_complete lei)), 'no errors on complete');
 131         my %out = map { $_ => 1 } split(/\s+/s, $out);
 132         ok($out{'q'}, "`lei q' offered as completion");
 133         ok($out{'add-external'}, "`lei add-external' offered as completion");
 134
 135         ok($lei->(qw(_complete lei q)), 'complete q (no args)');
 136         %out = map { $_ => 1 } split(/\s+/s, $out);
 137         for my $sw (qw(-f --format -o --output --mfolder --augment -a
 138                         --mua --mua-cmd --no-local --local --verbose -v
 139                         --save-as --no-remote --remote --torsocks
 140                         --reverse -r )) {
 141                 ok($out{$sw}, "$sw offered as `lei q' completion");
 142         }
 143
 144         ok($lei->(qw(_complete lei q --form)), 'complete q --format');
 145         is($out, "--format\n", 'complete lei q --format');
 146         for my $sw (qw(-f --format)) {
 147                 ok($lei->(qw(_complete lei q), $sw), "complete q $sw ARG");
 148                 %out = map { $_ => 1 } split(/\s+/s, $out);
 149                 for my $f (qw(mboxrd mboxcl2 mboxcl mboxo json jsonl
 150                                 concatjson maildir)) {
 151                         ok($out{$f}, "got $sw $f as output format");
 152                 }
 153         }
 154         ok($lei->(qw(_complete lei import)), 'complete import');
 155         %out = map { $_ => 1 } split(/\s+/s, $out);
 156         for my $sw (qw(--flags --no-flags --no-kw --kw --no-keywords
 157                         --keywords)) {
 158                 ok($out{$sw}, "$sw offered as `lei import' completion");
 159         }
 160 };
 161
 162 my $test_fail = sub {
 163 SKIP: {
 164         skip $req_sendcmd, 3 if $req_sendcmd;
 165         $lei->(qw(q --only http://127.0.0.1:99999/bogus/ t:m));
 166         is($? >> 8, 3, 'got curl exit for bogus URL');
 167         $lei->(qw(q --only http://127.0.0.1:99999/bogus/ t:m -o), "$home/junk");
 168         is($? >> 8, 3, 'got curl exit for bogus URL with Maildir');
 169         is($out, '', 'no output');
 170 }; # /SKIP
 171 };
 172
 173 my $test_lei_common = sub {
 174         $test_help->();
 175         $test_config->();
 176         $test_init->();
 177         $test_completion->();
 178         $test_fail->();
 179 };
 180
 181 if ($ENV{TEST_LEI_ONESHOT}) {
 182         require_ok 'PublicInbox::LEI';
 183         # force sun_path[108] overflow, ($lei->() filters out this path)
 184         my $xrd = "$home/1shot-test".('.sun_path' x 108);
 185         local $ENV{XDG_RUNTIME_DIR} = $xrd;
 186         $err_filter = qr!\Q$xrd!;
 187         $test_lei_common->();
 188 } else {
 189 SKIP: { # real socket
 190         skip $req_sendcmd, 115 if $req_sendcmd;
 191         local $ENV{XDG_RUNTIME_DIR} = "$home/xdg_run";
 192         my $sock = "$ENV{XDG_RUNTIME_DIR}/lei/5.seq.sock";
 193         my $err_log = "$ENV{XDG_RUNTIME_DIR}/lei/errors.log";
 194
 195         ok($lei->('daemon-pid'), 'daemon-pid');
 196         is($err, '', 'no error from daemon-pid');
 197         like($out, qr/\A[0-9]+\n\z/s, 'pid returned') or BAIL_OUT;
 198         chomp(my $pid = $out);
 199         ok(kill(0, $pid), 'pid is valid');
 200         ok(-S $sock, 'sock created');
 201
 202         $test_lei_common->();
 203         is(-s $err_log, 0, 'nothing in errors.log');
 204         open my $efh, '>>', $err_log or BAIL_OUT $!;
 205         print $efh "phail\n" or BAIL_OUT $!;
 206         close $efh or BAIL_OUT $!;
 207
 208         ok($lei->('daemon-pid'), 'daemon-pid');
 209         chomp(my $pid_again = $out);
 210         is($pid, $pid_again, 'daemon-pid idempotent');
 211         like($err, qr/phail/, 'got mock "phail" error previous run');
 212
 213         ok($lei->(qw(daemon-kill)), 'daemon-kill');
 214         is($out, '', 'no output from daemon-kill');
 215         is($err, '', 'no error from daemon-kill');
 216         for (0..100) {
 217                 kill(0, $pid) or last;
 218                 tick();
 219         }
 220         ok(-S $sock, 'sock still exists');
 221         ok(!kill(0, $pid), 'pid gone after stop');
 222
 223         ok($lei->(qw(daemon-pid)), 'daemon-pid');
 224         chomp(my $new_pid = $out);
 225         ok(kill(0, $new_pid), 'new pid is running');
 226         ok(-S $sock, 'sock still exists');
 227
 228         for my $sig (qw(-0 -CHLD)) {
 229                 ok($lei->('daemon-kill', $sig), "handles $sig");
 230         }
 231         is($out.$err, '', 'no output on innocuous signals');
 232         ok($lei->('daemon-pid'), 'daemon-pid');
 233         chomp $out;
 234         is($out, $new_pid, 'PID unchanged after -0/-CHLD');
 235
 236         if ('socket inaccessible') {
 237                 chmod 0000, $sock or BAIL_OUT "chmod 0000: $!";
 238                 ok($lei->('help'), 'connect fail, one-shot fallback works');
 239                 like($err, qr/\bconnect\(/, 'connect error noted');
 240                 like($out, qr/^usage: /, 'help output works');
 241                 chmod 0700, $sock or BAIL_OUT "chmod 0700: $!";
 242         }
 243         unlink $sock or BAIL_OUT "unlink($sock) $!";
 244         for (0..100) {
 245                 kill('CHLD', $new_pid) or last;
 246                 tick();
 247         }
 248         ok(!kill(0, $new_pid), 'daemon exits after unlink');
 249         # success over socket, can't test without
 250 }; # SKIP
 251 } # else
 252
 253 done_testing;