t/lei-q-kw.t

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