t/lei-q-kw.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 POSIX qw(mkfifo);
   6 use Fcntl qw(SEEK_SET O_RDONLY O_NONBLOCK);
   7 use IO::Uncompress::Gunzip qw(gunzip);
   8 use IO::Compress::Gzip qw(gzip);
   9 use PublicInbox::MboxReader;
  10 use PublicInbox::LeiToMail;
  11 use PublicInbox::Spawn qw(popen_rd);
  12 my $exp = {
  13         '<qp@example.com>' => eml_load('t/plack-qp.eml'),
  14         '<testmessage@example.com>' => eml_load('t/utf8.eml'),
  15 };
  16 $exp->{'<qp@example.com>'}->header_set('Status', 'RO');
  17
  18 test_lei(sub {
  19 lei_ok(qw(import -F eml t/plack-qp.eml));
  20 my $o = "$ENV{HOME}/dst";
  21 lei_ok(qw(q -o), "maildir:$o", qw(m:qp@example.com));
  22 my @fn = glob("$o/cur/*:2,");
  23 scalar(@fn) == 1 or xbail $lei_err, 'wrote multiple or zero files:', \@fn;
  24 rename($fn[0], "$fn[0]S") or BAIL_OUT "rename $!";
  25
  26 lei_ok(qw(q -o), "maildir:$o", qw(m:bogus-noresults@example.com));
  27 ok(!glob("$o/cur/*"), 'last result cleared after augment-import');
  28
  29 lei_ok(qw(q -o), "maildir:$o", qw(m:qp@example.com));
  30 @fn = glob("$o/cur/*:2,S");
  31 is(scalar(@fn), 1, "`seen' flag set on Maildir file");
  32
  33 # ensure --no-import-before works
  34 my $n = $fn[0];
  35 $n =~ s/,S\z/,RS/;
  36 rename($fn[0], $n) or BAIL_OUT "rename $!";
  37 lei_ok(qw(q --no-import-before -o), "maildir:$o",
  38         qw(m:bogus-noresults@example.com));
  39 ok(!glob("$o/cur/*"), '--no-import-before cleared destination');
  40 lei_ok(qw(q -o), "maildir:$o", qw(m:qp@example.com));
  41 @fn = glob("$o/cur/*:2,S");
  42 is(scalar(@fn), 1, "`seen' flag (but not `replied') set on Maildir file");
  43
  44 SKIP: {
  45         $o = "$ENV{HOME}/fifo";
  46         mkfifo($o, 0600) or skip("mkfifo not supported: $!", 1);
  47         # cat(1) since lei() may not execve for FD_CLOEXEC to work
  48         my $cat = popen_rd(['cat', $o]);
  49         ok(!lei(qw(q --import-before bogus -o), "mboxrd:$o"),
  50                 '--import-before fails on non-seekable output');
  51         like($lei_err, qr/not seekable/, 'unseekable noted in error');
  52         is(do { local $/; <$cat> }, '', 'no output on FIFO');
  53         close $cat;
  54         $cat = popen_rd(['cat', $o]);
  55         lei_ok(qw(q m:qp@example.com -o), "mboxrd:$o");
  56         my $buf = do { local $/; <$cat> };
  57         open my $fh, '<', \$buf or BAIL_OUT $!;
  58         PublicInbox::MboxReader->mboxrd($fh, sub {
  59                 my ($eml) = @_;
  60                 $eml->header_set('Status', 'RO');
  61                 is_deeply($eml, $exp->{'<qp@example.com>'},
  62                         'FIFO output works as expected');
  63         });
  64 };
  65
  66 lei_ok qw(import -F eml t/utf8.eml), \'for augment test';
  67 my $read_file = sub {
  68         if ($_[0] =~ /\.gz\z/) {
  69                 gunzip($_[0] => \(my $buf = ''), MultiStream => 1) or
  70                         BAIL_OUT 'gunzip';
  71                 $buf;
  72         } else {
  73                 open my $fh, '+<', $_[0] or BAIL_OUT $!;
  74                 do { local $/; <$fh> };
  75         }
  76 };
  77
  78 my $write_file = sub {
  79         if ($_[0] =~ /\.gz\z/) {
  80                 gzip(\($_[1]), $_[0]) or BAIL_OUT 'gzip';
  81         } else {
  82                 open my $fh, '>', $_[0] or BAIL_OUT $!;
  83                 print $fh $_[1] or BAIL_OUT $!;
  84                 close $fh or BAIL_OUT;
  85         }
  86 };
  87
  88 for my $sfx ('', '.gz') {
  89         $o = "$ENV{HOME}/dst.mboxrd$sfx";
  90         lei_ok(qw(q -o), "mboxrd:$o", qw(m:qp@example.com));
  91         my $buf = $read_file->($o);
  92         $buf =~ s/^Status: [^\n]*\n//sm or BAIL_OUT "no status in $buf";
  93         $write_file->($o, $buf);
  94         lei_ok(qw(q -o), "mboxrd:$o", qw(rereadandimportkwchange));
  95         $buf = $read_file->($o);
  96         is($buf, '', 'emptied');
  97         lei_ok(qw(q -o), "mboxrd:$o", qw(m:qp@example.com));
  98         $buf = $read_file->($o);
  99         $buf =~ s/\nStatus: O\n\n/\nStatus: RO\n\n/s or
 100                 BAIL_OUT "no Status in $buf";
 101         $write_file->($o, $buf);
 102         lei_ok(qw(q -a -o), "mboxrd:$o", qw(m:testmessage@example.com));
 103         $buf = $read_file->($o);
 104         open my $fh, '<', \$buf or BAIL_OUT "PerlIO::scalar $!";
 105         my %res;
 106         PublicInbox::MboxReader->mboxrd($fh, sub {
 107                 my ($eml) = @_;
 108                 my $mid = $eml->header_raw('Message-ID');
 109                 if ($mid eq '<testmessage@example.com>') {
 110                         is_deeply([$eml->header('Status')], [],
 111                                 "no status $sfx");
 112                         $eml->header_set('Status');
 113                 } elsif ($mid eq '<qp@example.com>') {
 114                         is($eml->header('Status'), 'RO', 'status preserved');
 115                 } else {
 116                         fail("unknown mid $mid");
 117                 }
 118                 $res{$mid} = $eml;
 119         });
 120         is_deeply(\%res, $exp, '--augment worked') or diag $lei_err;
 121
 122         lei_ok(qw(q -o), "mboxrd:/dev/stdout", qw(m:qp@example.com)) or
 123                 diag $lei_err;
 124         like($lei_out, qr/^Status: RO\n/sm, 'Status set by previous augment');
 125 } # /mbox + mbox.gz tests
 126
 127 my ($ro_home, $cfg_path) = setup_public_inboxes;
 128
 129 # import keywords-only for external messages:
 130 $o = "$ENV{HOME}/kwdir";
 131 my $m = 'alpine.DEB.2.20.1608131214070.4924@example';
 132 my @inc = ('-I', "$ro_home/t1");
 133 lei_ok(qw(q -o), $o, "m:$m", @inc);
 134
 135 # emulate MUA marking a Maildir message as read:
 136 @fn = glob("$o/cur/*");
 137 scalar(@fn) == 1 or xbail $lei_err, 'wrote multiple or zero files:', \@fn;
 138 rename($fn[0], "$fn[0]S") or BAIL_OUT "rename $!";
 139
 140 lei_ok(qw(q -o), $o, 'bogus', \'clobber output dir to import keywords');
 141 @fn = glob("$o/cur/*");
 142 is_deeply(\@fn, [], 'output dir actually clobbered');
 143 lei_ok('q', "m:$m", @inc);
 144 my $res = json_utf8->decode($lei_out);
 145 is_deeply($res->[0]->{kw}, ['seen'], 'seen flag set for external message')
 146         or diag explain($res);
 147 lei_ok('q', "m:$m", '--no-external');
 148 is_deeply($res = json_utf8->decode($lei_out), [ undef ],
 149         'external message not imported') or diag explain($res);
 150
 151 $o = "$ENV{HOME}/kwmboxrd";
 152 lei_ok(qw(q -o), "mboxrd:$o", "m:$m", @inc);
 153
 154 # emulate MUA marking mboxrd message as unread
 155 open my $fh, '<', $o or BAIL_OUT;
 156 my $s = do { local $/; <$fh> };
 157 $s =~ s/^Status: RO\n/Status: O\nX-Status: AF\n/sm or
 158         fail "failed to clear R flag in $s";
 159 open $fh, '>', $o or BAIL_OUT;
 160 print $fh $s or BAIL_OUT;
 161 close $fh or BAIL_OUT;
 162
 163 lei_ok(qw(q -o), "mboxrd:$o", 'm:bogus', @inc,
 164         \'clobber mbox to import keywords');
 165 lei_ok(qw(q -o), "mboxrd:$o", "m:$m", @inc);
 166 open $fh, '<', $o or BAIL_OUT;
 167 $s = do { local $/; <$fh> };
 168 like($s, qr/^Status: O\nX-Status: AF\n/ms,
 169         'seen keyword gone in mbox, answered + flagged set');
 170
 171 lei_ok(qw(q --pretty), "m:$m", @inc);
 172 like($lei_out, qr/^  "kw": \["answered", "flagged"\],\n/sm,
 173         '--pretty JSON output shows kw: on one line');
 174
 175 # ensure import on previously external-only message works
 176 lei_ok('q', "m:$m");
 177 is_deeply(json_utf8->decode($lei_out), [ undef ],
 178         'to-be-imported message non-existent');
 179 lei_ok(qw(import -F eml t/x-unknown-alpine.eml));
 180 is($lei_err, '', 'no errors importing previous external-only message');
 181 lei_ok('q', "m:$m");
 182 $res = json_utf8->decode($lei_out);
 183 is($res->[1], undef, 'got one result');
 184 is_deeply($res->[0]->{kw}, [ qw(answered flagged) ], 'kw preserved on exact');
 185
 186 # ensure fuzzy match import works, too
 187 $m = 'multipart@example.com';
 188 $o = "$ENV{HOME}/fuzz";
 189 lei_ok('q', '-o', $o, "m:$m", @inc);
 190 @fn = glob("$o/cur/*");
 191 scalar(@fn) == 1 or xbail $lei_err, "wrote multiple or zero files", \@fn;
 192 rename($fn[0], "$fn[0]S") or BAIL_OUT "rename $!";
 193 lei_ok('q', '-o', $o, "m:$m");
 194 is_deeply([glob("$o/cur/*")], [], 'clobbered output results');
 195 my $eml = eml_load('t/plack-2-txt-bodies.eml');
 196 $eml->header_set('List-Id', '<list.example.com>');
 197 my $in = $eml->as_string;
 198 lei_ok([qw(import -F eml --stdin)], undef, { 0 => \$in, %$lei_opt });
 199 is($lei_err, '', 'no errors from import');
 200 lei_ok(qw(q -f mboxrd), "m:$m");
 201 open $fh, '<', \$lei_out or BAIL_OUT $!;
 202 my @res;
 203 PublicInbox::MboxReader->mboxrd($fh, sub { push @res, shift });
 204 is($res[0]->header('Status'), 'RO', 'seen kw set');
 205 $res[0]->header_set('Status');
 206 is_deeply(\@res, [ $eml ], 'imported message matches w/ List-Id');
 207
 208 $eml->header_set('List-Id', '<another.example.com>');
 209 $in = $eml->as_string;
 210 lei_ok([qw(import -F eml --stdin)], undef, { 0 => \$in, %$lei_opt });
 211 is($lei_err, '', 'no errors from 2nd import');
 212 lei_ok(qw(q -f mboxrd), "m:$m", 'l:another.example.com');
 213 my @another;
 214 open $fh, '<', \$lei_out or BAIL_OUT $!;
 215 PublicInbox::MboxReader->mboxrd($fh, sub { push @another, shift });
 216 is($another[0]->header('Status'), 'RO', 'seen kw set');
 217
 218 # forwarded
 219 {
 220         local $ENV{DBG} = 1;
 221         $o = "$ENV{HOME}/forwarded";
 222         lei_ok(qw(q -o), $o, "m:$m");
 223         my @p = glob("$o/cur/*");
 224         scalar(@p) == 1 or xbail('multiple when 1 expected', \@p);
 225         my $passed = $p[0];
 226         $passed =~ s/,S\z/,PS/ or xbail "failed to replace $passed";
 227         rename($p[0], $passed) or xbail "rename $!";
 228         lei_ok(qw(q -o), $o, 'm:bogus', \'clobber maildir');
 229         is_deeply([glob("$o/cur/*")], [], 'old results clobbered');
 230         lei_ok(qw(q -o), $o, "m:$m");
 231         @p = glob("$o/cur/*");
 232         scalar(@p) == 1 or xbail('multiple when 1 expected', \@p);
 233         like($p[0], qr/,PS/, 'passed (Forwarded) flag kept');
 234         lei_ok(qw(q -o), "mboxrd:$o.mboxrd", "m:$m");
 235         open $fh, '<', "$o.mboxrd" or xbail $!;
 236         my @res;
 237         PublicInbox::MboxReader->mboxrd($fh, sub { push @res, shift });
 238         scalar(@res) == 1 or xbail('multiple when 1 expected', \@res);
 239         is($res[0]->header('Status'), 'RO', 'seen kw set');
 240         is($res[0]->header('X-Status'), undef, 'no X-Status');
 241
 242         lei_ok(qw(q -o), "mboxrd:$o.mboxrd", 'bogus-for-import-before');
 243         lei_ok(qw(q -o), $o, "m:$m");
 244         @p = glob("$o/cur/*");
 245         scalar(@p) == 1 or xbail('multiple when 1 expected', \@p);
 246         like($p[0], qr/,PS/, 'passed (Forwarded) flag still kept');
 247 }
 248
 249 }); # test_lei
 250 done_testing;