]> Sergey Matveev's repositories - public-inbox.git/blob - lib/PublicInbox/LeiToMail.pm
lei: maildir: handle "forwarded" keyword as "P"
[public-inbox.git] / lib / PublicInbox / LeiToMail.pm
1 # Copyright (C) 2020-2021 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
3
4 # Writes PublicInbox::Eml objects atomically to a mbox variant or Maildir
5 package PublicInbox::LeiToMail;
6 use strict;
7 use v5.10.1;
8 use parent qw(PublicInbox::IPC);
9 use PublicInbox::Eml;
10 use PublicInbox::Lock;
11 use PublicInbox::ProcessPipe;
12 use PublicInbox::Spawn qw(spawn);
13 use PublicInbox::LeiDedupe;
14 use PublicInbox::Git;
15 use PublicInbox::GitAsyncCat;
16 use PublicInbox::PktOp qw(pkt_do);
17 use Symbol qw(gensym);
18 use IO::Handle; # ->autoflush
19 use Fcntl qw(SEEK_SET SEEK_END O_CREAT O_EXCL O_WRONLY);
20 use Errno qw(EEXIST ESPIPE ENOENT EPIPE);
21 use Digest::SHA qw(sha256_hex);
22
23 # struggles with short-lived repos, Gcf2Client makes little sense with lei;
24 # but we may use in-process libgit2 in the future.
25 $PublicInbox::GitAsyncCat::GCF2C = 0;
26
27 my %kw2char = ( # Maildir characters
28         draft => 'D',
29         flagged => 'F',
30         forwarded => 'P', # passed
31         answered => 'R',
32         seen => 'S',
33 );
34
35 my %kw2status = (
36         flagged => [ 'X-Status' => 'F' ],
37         answered => [ 'X-Status' => 'A' ],
38         seen => [ 'Status' => 'R' ],
39         draft => [ 'X-Status' => 'T' ],
40 );
41
42 sub _mbox_hdr_buf ($$$) {
43         my ($eml, $type, $smsg) = @_;
44         $eml->header_set($_) for (qw(Lines Bytes Content-Length));
45
46         my %hdr = (Status => []); # set Status, X-Status
47         for my $k (@{$smsg->{kw} // []}) {
48                 if (my $ent = $kw2status{$k}) {
49                         push @{$hdr{$ent->[0]}}, $ent->[1];
50                 } else { # X-Label?
51                         warn "TODO: keyword `$k' not supported for mbox\n";
52                 }
53         }
54         # Messages are always 'O' (non-\Recent in IMAP), it saves
55         # MUAs the trouble of rewriting the mbox if no other
56         # changes are made.  We put 'O' at the end (e.g. "Status: RO")
57         # to match mutt(1) output.
58         $eml->header_set('Status', join('', sort(@{$hdr{Status}})). 'O');
59         if (my $chars = delete $hdr{'X-Status'}) {
60                 $eml->header_set('X-Status', join('', sort(@$chars)));
61         }
62         my $buf = delete $eml->{hdr};
63
64         # fixup old bug from import (pre-a0c07cba0e5d8b6a)
65         $$buf =~ s/\A[\r\n]*From [^\r\n]*\r?\n//s;
66         my $ident = $smsg->{blob} // 'lei';
67         if (defined(my $pct = $smsg->{pct})) { $ident .= "=$pct" }
68
69         substr($$buf, 0, 0, # prepend From line
70                 "From $ident\@$type Thu Jan  1 00:00:00 1970$eml->{crlf}");
71         $buf;
72 }
73
74 sub atomic_append { # for on-disk destinations (O_APPEND, or O_EXCL)
75         my ($lei, $buf) = @_;
76         if (defined(my $w = syswrite($lei->{1} // return, $$buf))) {
77                 return if $w == length($$buf);
78                 $buf = "short atomic write: $w != ".length($$buf);
79         } elsif ($! == EPIPE) {
80                 return $lei->note_sigpipe(1);
81         } else {
82                 $buf = "atomic write: $!";
83         }
84         $lei->fail($buf);
85 }
86
87 sub eml2mboxrd ($;$) {
88         my ($eml, $smsg) = @_;
89         my $buf = _mbox_hdr_buf($eml, 'mboxrd', $smsg);
90         if (my $bdy = delete $eml->{bdy}) {
91                 $$bdy =~ s/^(>*From )/>$1/gm;
92                 $$buf .= $eml->{crlf};
93                 substr($$bdy, 0, 0, $$buf); # prepend header
94                 $buf = $bdy;
95         }
96         $$buf .= $eml->{crlf};
97         $buf;
98 }
99
100 sub eml2mboxo {
101         my ($eml, $smsg) = @_;
102         my $buf = _mbox_hdr_buf($eml, 'mboxo', $smsg);
103         if (my $bdy = delete $eml->{bdy}) {
104                 $$bdy =~ s/^From />From /gm;
105                 $$buf .= $eml->{crlf};
106                 substr($$bdy, 0, 0, $$buf); # prepend header
107                 $buf = $bdy;
108         }
109         $$buf .= $eml->{crlf};
110         $buf;
111 }
112
113 sub _mboxcl_common ($$$) {
114         my ($buf, $bdy, $crlf) = @_;
115         # add Lines: so mutt won't have to add it on MUA close
116         my $lines = $$bdy =~ tr!\n!\n!;
117         $$buf .= 'Content-Length: '.length($$bdy).$crlf.
118                 'Lines: '.$lines.$crlf.$crlf;
119         substr($$bdy, 0, 0, $$buf); # prepend header
120         $_[0] = $bdy;
121 }
122
123 # mboxcl still escapes "From " lines
124 sub eml2mboxcl {
125         my ($eml, $smsg) = @_;
126         my $buf = _mbox_hdr_buf($eml, 'mboxcl', $smsg);
127         my $crlf = $eml->{crlf};
128         if (my $bdy = delete $eml->{bdy}) {
129                 $$bdy =~ s/^From />From /gm;
130                 _mboxcl_common($buf, $bdy, $crlf);
131         }
132         $$buf .= $crlf;
133         $buf;
134 }
135
136 # mboxcl2 has no "From " escaping
137 sub eml2mboxcl2 {
138         my ($eml, $smsg) = @_;
139         my $buf = _mbox_hdr_buf($eml, 'mboxcl2', $smsg);
140         my $crlf = $eml->{crlf};
141         if (my $bdy = delete $eml->{bdy}) {
142                 _mboxcl_common($buf, $bdy, $crlf);
143         }
144         $$buf .= $crlf;
145         $buf;
146 }
147
148 sub git_to_mail { # git->cat_async callback
149         my ($bref, $oid, $type, $size, $arg) = @_;
150         if ($type ne 'blob') {
151                 if ($type eq 'missing') {
152                         warn "missing $oid\n";
153                 } else {
154                         warn "unexpected type=$type for $oid\n";
155                 }
156         }
157         my ($write_cb, $smsg) = @$arg;
158         if ($smsg->{blob} ne $oid) {
159                 die "BUG: expected=$smsg->{blob} got=$oid";
160         }
161         $write_cb->($bref, $smsg) if $size > 0;
162 }
163
164 sub reap_compress { # dwaitpid callback
165         my ($lei, $pid) = @_;
166         my $cmd = delete $lei->{"pid.$pid"};
167         return if $? == 0;
168         $lei->fail("@$cmd failed", $? >> 8);
169 }
170
171 sub _post_augment_mbox { # open a compressor process
172         my ($self, $lei) = @_;
173         my $zsfx = $self->{zsfx} or return;
174         my $cmd = PublicInbox::MboxReader::zsfx2cmd($zsfx, undef, $lei);
175         my ($r, $w) = @{delete $lei->{zpipe}};
176         my $rdr = { 0 => $r, 1 => $lei->{1}, 2 => $lei->{2} };
177         my $pid = spawn($cmd, undef, $rdr);
178         my $pp = gensym;
179         my $dup = bless { "pid.$pid" => $cmd }, ref($lei);
180         $dup->{$_} = $lei->{$_} for qw(2 sock);
181         tie *$pp, 'PublicInbox::ProcessPipe', $pid, $w, \&reap_compress, $dup;
182         $lei->{1} = $pp;
183 }
184
185 sub dup_src ($) {
186         my ($in) = @_;
187         open my $dup, '+>>&', $in or die "dup: $!";
188         $dup;
189 }
190
191 # --augment existing output destination, with deduplication
192 sub _augment { # MboxReader eml_cb
193         my ($eml, $lei) = @_;
194         # ignore return value, just populate the skv
195         $lei->{dedupe}->is_dup($eml);
196 }
197
198 sub _mbox_augment_kw_maybe {
199         my ($eml, $lei, $lse, $augment) = @_;
200         my $kw = PublicInbox::MboxReader::mbox_keywords($eml);
201         update_kw_maybe($lei, $lse, $eml, $kw);
202         _augment($eml, $lei) if $augment;
203 }
204
205 sub _mbox_write_cb ($$) {
206         my ($self, $lei) = @_;
207         my $ovv = $lei->{ovv};
208         my $m = 'eml2'.$ovv->{fmt};
209         my $eml2mbox = $self->can($m) or die "$self->$m missing";
210         $lei->{1} // die "no stdout ($m, $ovv->{dst})"; # redirected earlier
211         $lei->{1}->autoflush(1);
212         my $atomic_append = !defined($ovv->{lock_path});
213         my $dedupe = $lei->{dedupe};
214         $dedupe->prepare_dedupe;
215         my $lse = $lei->{lse}; # may be undef
216         sub { # for git_to_mail
217                 my ($buf, $smsg, $eml) = @_;
218                 $eml //= PublicInbox::Eml->new($buf);
219                 return if $dedupe->is_dup($eml, $smsg->{blob});
220                 $lse->xsmsg_vmd($smsg) if $lse;
221                 $buf = $eml2mbox->($eml, $smsg);
222                 return atomic_append($lei, $buf) if $atomic_append;
223                 my $lk = $ovv->lock_for_scope;
224                 $lei->out($$buf);
225         }
226 }
227
228 sub update_kw_maybe ($$$$) {
229         my ($lei, $lse, $eml, $kw) = @_;
230         return unless $lse;
231         my $c = $lse->kw_changed($eml, $kw, my $docids = []);
232         my $vmd = { kw => $kw };
233         if (scalar @$docids) { # already in lei/store
234                 $lei->{sto}->ipc_do('set_eml_vmd', undef, $vmd, $docids) if $c;
235         } elsif (my $xoids = $lei->{ale}->xoids_for($eml)) {
236                 # it's in an external, only set kw, here
237                 $lei->{sto}->ipc_do('set_xvmd', $xoids, $eml, $vmd);
238         } else { # never-before-seen, import the whole thing
239                 # XXX this is critical in protecting against accidental
240                 # data loss without --augment
241                 $lei->{sto}->ipc_do('set_eml', $eml, $vmd);
242         }
243 }
244
245 sub _augment_or_unlink { # maildir_each_eml cb
246         my ($f, $kw, $eml, $lei, $lse, $mod, $shard, $unlink) = @_;
247         if ($mod) {
248                 # can't get dirent.d_ino w/ pure Perl readdir, so we extract
249                 # the OID if it looks like one instead of doing stat(2)
250                 my $hex = $f =~ m!\b([a-f0-9]{40,})[^/]*\z! ?
251                                 $1 : sha256_hex($f);
252                 my $recno = hex(substr($hex, 0, 8));
253                 return if ($recno % $mod) != $shard;
254                 update_kw_maybe($lei, $lse, $eml, $kw);
255         }
256         $unlink ? unlink($f) : _augment($eml, $lei);
257 }
258
259 # maildir_each_file callback, \&CORE::unlink doesn't work with it
260 sub _unlink { unlink($_[0]) }
261
262 sub _rand () {
263         state $seq = 0;
264         sprintf('%x,%x,%x,%x', rand(0xffffffff), time, $$, ++$seq);
265 }
266
267 sub _buf2maildir {
268         my ($dst, $buf, $smsg) = @_;
269         my $kw = $smsg->{kw} // [];
270         my $sfx = join('', sort(map { $kw2char{$_} // () } @$kw));
271         my $rand = ''; # chosen by die roll :P
272         my ($tmp, $fh, $final, $ok);
273         my $common = $smsg->{blob} // _rand;
274         if (defined(my $pct = $smsg->{pct})) { $common .= "=$pct" }
275         do {
276                 $tmp = $dst.'tmp/'.$rand.$common;
277         } while (!($ok = sysopen($fh, $tmp, O_CREAT|O_EXCL|O_WRONLY)) &&
278                 $! == EEXIST && ($rand = _rand.','));
279         if ($ok && print $fh $$buf and close($fh)) {
280                 # ignore new/ and write only to cur/, otherwise MUAs
281                 # with R/W access to the Maildir will end up doing
282                 # a mass rename which can take a while with thousands
283                 # of messages.
284                 $dst .= 'cur/';
285                 $rand = '';
286                 do {
287                         $final = $dst.$rand.$common.':2,'.$sfx;
288                 } while (!($ok = link($tmp, $final)) && $! == EEXIST &&
289                         ($rand = _rand.','));
290                 die "link($tmp, $final): $!" unless $ok;
291                 unlink($tmp) or warn "W: failed to unlink $tmp: $!\n";
292         } else {
293                 my $err = "Error writing $smsg->{blob} to $dst: $!\n";
294                 $_[0] = undef; # clobber dst
295                 unlink($tmp);
296                 die $err;
297         }
298 }
299
300 sub _maildir_write_cb ($$) {
301         my ($self, $lei) = @_;
302         my $dedupe = $lei->{dedupe};
303         $dedupe->prepare_dedupe if $dedupe;
304         my $dst = $lei->{ovv}->{dst};
305         my $lse = $lei->{lse}; # may be undef
306         sub { # for git_to_mail
307                 my ($buf, $smsg, $eml) = @_;
308                 $dst // return $lei->fail; # dst may be undef-ed in last run
309                 $buf //= \($eml->as_string);
310                 $lse->xsmsg_vmd($smsg) if $lse;
311                 return _buf2maildir($dst, $buf, $smsg) if !$dedupe;
312                 $eml //= PublicInbox::Eml->new($$buf); # copy buf
313                 return if $dedupe->is_dup($eml, $smsg->{blob});
314                 undef $eml;
315                 _buf2maildir($dst, $buf, $smsg);
316         }
317 }
318
319 sub _imap_write_cb ($$) {
320         my ($self, $lei) = @_;
321         my $dedupe = $lei->{dedupe};
322         $dedupe->prepare_dedupe if $dedupe;
323         my $imap_append = $lei->{net}->can('imap_append');
324         my $mic = $lei->{net}->mic_get($self->{uri});
325         my $folder = $self->{uri}->mailbox;
326         my $lse = $lei->{lse}; # may be undef
327         sub { # for git_to_mail
328                 my ($bref, $smsg, $eml) = @_;
329                 $mic // return $lei->fail; # dst may be undef-ed in last run
330                 if ($dedupe) {
331                         $eml //= PublicInbox::Eml->new($$bref); # copy bref
332                         return if $dedupe->is_dup($eml, $smsg->{blob});
333                 }
334                 $lse->xsmsg_vmd($smsg) if $lse;
335                 eval { $imap_append->($mic, $folder, $bref, $smsg, $eml) };
336                 if (my $err = $@) {
337                         undef $mic;
338                         die $err;
339                 }
340         }
341 }
342
343 sub write_cb { # returns a callback for git_to_mail
344         my ($self, $lei) = @_;
345         # _mbox_write_cb, _maildir_write_cb or _imap_write_cb
346         my $m = "_$self->{base_type}_write_cb";
347         $self->$m($lei);
348 }
349
350 sub new {
351         my ($cls, $lei) = @_;
352         my $fmt = $lei->{ovv}->{fmt};
353         my $dst = $lei->{ovv}->{dst};
354         my $self = bless {}, $cls;
355         if ($fmt eq 'maildir') {
356                 require PublicInbox::MdirReader;
357                 $self->{base_type} = 'maildir';
358                 -e $dst && !-d _ and die
359                                 "$dst exists and is not a directory\n";
360                 $lei->{ovv}->{dst} = $dst .= '/' if substr($dst, -1) ne '/';
361         } elsif (substr($fmt, 0, 4) eq 'mbox') {
362                 require PublicInbox::MboxReader;
363                 (-d $dst || (-e _ && !-w _)) and die
364                         "$dst exists and is not a writable file\n";
365                 $self->can("eml2$fmt") or die "bad mbox format: $fmt\n";
366                 $self->{base_type} = 'mbox';
367         } elsif ($fmt =~ /\Aimaps?\z/) { # TODO .onion support
368                 require PublicInbox::NetWriter;
369                 my $net = PublicInbox::NetWriter->new;
370                 $net->add_url($dst);
371                 $net->{quiet} = $lei->{opt}->{quiet};
372                 my $err = $net->errors($dst);
373                 return $lei->fail($err) if $err;
374                 require PublicInbox::URIimap; # TODO: URI cast early
375                 $self->{uri} = PublicInbox::URIimap->new($dst);
376                 $self->{uri}->mailbox or die "No mailbox: $dst";
377                 $lei->{net} = $net;
378                 $self->{base_type} = 'imap';
379         } else {
380                 die "bad mail --format=$fmt\n";
381         }
382         $self->{dst} = $dst;
383         $lei->{dedupe} = PublicInbox::LeiDedupe->new($lei);
384         $self;
385 }
386
387 sub _pre_augment_maildir {
388         my ($self, $lei) = @_;
389         my $dst = $lei->{ovv}->{dst};
390         for my $x (qw(tmp new cur)) {
391                 my $d = $dst.$x;
392                 next if -d $d;
393                 require File::Path;
394                 File::Path::mkpath($d);
395                 -d $d or die "$d is not a directory";
396         }
397 }
398
399 sub _do_augment_maildir {
400         my ($self, $lei) = @_;
401         my $dst = $lei->{ovv}->{dst};
402         my $lse = $lei->{opt}->{'import-before'} ? $lei->{lse} : undef;
403         my ($mod, $shard) = @{$self->{shard_info} // []};
404         if ($lei->{opt}->{augment}) {
405                 my $dedupe = $lei->{dedupe};
406                 if ($dedupe && $dedupe->prepare_dedupe) {
407                         PublicInbox::MdirReader::maildir_each_eml($dst,
408                                                 \&_augment_or_unlink,
409                                                 $lei, $lse, $mod, $shard);
410                         $dedupe->pause_dedupe;
411                 }
412         } elsif ($lse) {
413                 PublicInbox::MdirReader::maildir_each_eml($dst,
414                                         \&_augment_or_unlink,
415                                         $lei, $lse, $mod, $shard, 1);
416         } else {# clobber existing Maildir
417                 PublicInbox::MdirReader::maildir_each_file($dst, \&_unlink);
418         }
419 }
420
421 sub _imap_augment_or_delete { # PublicInbox::NetReader::imap_each cb
422         my ($url, $uid, $kw, $eml, $lei, $lse, $delete_mic) = @_;
423         update_kw_maybe($lei, $lse, $eml, $kw);
424         if ($delete_mic) {
425                 $lei->{net}->imap_delete_1($url, $uid, $delete_mic);
426         } else {
427                 _augment($eml, $lei);
428         }
429 }
430
431 sub _do_augment_imap {
432         my ($self, $lei) = @_;
433         my $net = $lei->{net};
434         my $lse = $lei->{opt}->{'import-before'} ? $lei->{lse} : undef;
435         if ($lei->{opt}->{augment}) {
436                 my $dedupe = $lei->{dedupe};
437                 if ($dedupe && $dedupe->prepare_dedupe) {
438                         $net->imap_each($self->{uri}, \&_imap_augment_or_delete,
439                                         $lei, $lse);
440                         $dedupe->pause_dedupe;
441                 }
442         } elsif ($lse) {
443                 my $delete_mic;
444                 $net->imap_each($self->{uri}, \&_imap_augment_or_delete,
445                                         $lei, $lse, \$delete_mic);
446                 $delete_mic->expunge if $delete_mic;
447         } elsif (!$self->{-wq_worker_nr}) { # undef or 0
448                 # clobber existing IMAP folder
449                 $net->imap_delete_all($self->{uri});
450         }
451 }
452
453 sub _pre_augment_mbox {
454         my ($self, $lei) = @_;
455         my $dst = $lei->{ovv}->{dst};
456         my $out;
457         my $devfd = $lei->path_to_fd($dst) // die "bad $dst";
458         if ($devfd >= 0) {
459                 $out = $lei->{$devfd};
460         } else { # normal-looking path
461                 if (-p $dst) {
462                         open $out, '>', $dst or die "open($dst): $!";
463                 } elsif (-f _ || !-e _) {
464                         require PublicInbox::MboxLock;
465                         my $m = $lei->{opt}->{'lock'} //
466                                         PublicInbox::MboxLock->defaults;
467                         $self->{mbl} = PublicInbox::MboxLock->acq($dst, 1, $m);
468                         $out = $self->{mbl}->{fh};
469                 } else {
470                         die "$dst is not a file or FIFO\n";
471                 }
472                 $lei->{old_1} = $lei->{1}; # keep for spawning MUA
473         }
474         # Perl does SEEK_END even with O_APPEND :<
475         $self->{seekable} = seek($out, 0, SEEK_SET);
476         if (!$self->{seekable} && $! != ESPIPE && !defined($devfd)) {
477                 die "seek($dst): $!\n";
478         }
479         if (!$self->{seekable}) {
480                 my $imp_before = $lei->{opt}->{'import-before'};
481                 die "--import-before specified but $dst is not seekable\n"
482                         if $imp_before && !ref($imp_before);
483                 die "--augment specified but $dst is not seekable\n" if
484                         $lei->{opt}->{augment};
485         }
486         if ($self->{zsfx} = PublicInbox::MboxReader::zsfx($dst)) {
487                 pipe(my ($r, $w)) or die "pipe: $!";
488                 $lei->{zpipe} = [ $r, $w ];
489                 $lei->{ovv}->{lock_path} and
490                         die 'BUG: unexpected {ovv}->{lock_path}';
491                 $lei->{ovv}->ovv_out_lk_init;
492         } elsif (!$self->{seekable} && !$lei->{ovv}->{lock_path}) {
493                 $lei->{ovv}->ovv_out_lk_init;
494         }
495         $lei->{1} = $out;
496         undef;
497 }
498
499 sub _do_augment_mbox {
500         my ($self, $lei) = @_;
501         return unless $self->{seekable};
502         my $opt = $lei->{opt};
503         my $out = $lei->{1};
504         my ($fmt, $dst) = @{$lei->{ovv}}{qw(fmt dst)};
505         return unless -s $out;
506         unless ($opt->{augment} || $opt->{'import-before'}) {
507                 truncate($out, 0) or die "truncate($dst): $!";
508                 return;
509         }
510         my $zsfx = $self->{zsfx};
511         my $rd = $zsfx ? PublicInbox::MboxReader::zsfxcat($out, $zsfx, $lei)
512                         : dup_src($out);
513         my $dedupe;
514         if ($opt->{augment}) {
515                 $dedupe = $lei->{dedupe};
516                 $dedupe->prepare_dedupe if $dedupe;
517         }
518         if ($opt->{'import-before'}) { # the default
519                 my $lse = $lei->{lse};
520                 PublicInbox::MboxReader->$fmt($rd, \&_mbox_augment_kw_maybe,
521                                                 $lei, $lse, $opt->{augment});
522                 if (!$opt->{augment} and !truncate($out, 0)) {
523                         die "truncate($dst): $!";
524                 }
525         } else { # --augment --no-import-before
526                 PublicInbox::MboxReader->$fmt($rd, \&_augment, $lei);
527         }
528         # maybe some systems don't honor O_APPEND, Perl does this:
529         seek($out, 0, SEEK_END) or die "seek $dst: $!";
530         $dedupe->pause_dedupe if $dedupe;
531 }
532
533 sub pre_augment { # fast (1 disk seek), runs in same process as post_augment
534         my ($self, $lei) = @_;
535         # _pre_augment_maildir, _pre_augment_mbox
536         my $m = $self->can("_pre_augment_$self->{base_type}") or return;
537         $m->($self, $lei);
538 }
539
540 sub do_augment { # slow, runs in wq worker
541         my ($self, $lei) = @_;
542         # _do_augment_maildir, _do_augment_mbox, or _do_augment_imap
543         my $m = "_do_augment_$self->{base_type}";
544         $self->$m($lei);
545 }
546
547 # fast (spawn compressor or mkdir), runs in same process as pre_augment
548 sub post_augment {
549         my ($self, $lei, @args) = @_;
550         my $wait = $lei->{opt}->{'import-before'} ?
551                         $lei->{sto}->ipc_do('checkpoint', 1) : 0;
552         # _post_augment_mbox
553         my $m = $self->can("_post_augment_$self->{base_type}") or return;
554         $m->($self, $lei, @args);
555 }
556
557 sub do_post_auth {
558         my ($self) = @_;
559         my $lei = $self->{lei};
560         # lei_xsearch can start as soon as all l2m workers get here
561         pkt_do($lei->{pkt_op_p}, 'incr_start_query') or
562                 die "incr_start_query: $!";
563         my $aug;
564         if (lock_free($self)) {
565                 my $mod = $self->{-wq_nr_workers};
566                 my $shard = $self->{-wq_worker_nr};
567                 if (my $net = $lei->{net}) {
568                         $net->{shard_info} = [ $mod, $shard ];
569                 } else { # Maildir
570                         $self->{shard_info} = [ $mod, $shard ];
571                 }
572                 $aug = '+'; # incr_post_augment
573         } elsif ($self->{-wq_worker_nr} == 0) {
574                 $aug = '.'; # do_post_augment
575         }
576         if ($aug) {
577                 local $0 = 'do_augment';
578                 eval { do_augment($self, $lei) };
579                 $lei->fail($@) if $@;
580                 pkt_do($lei->{pkt_op_p}, $aug) == 1 or
581                                 die "do_post_augment trigger: $!";
582         }
583         if (my $zpipe = delete $lei->{zpipe}) {
584                 $lei->{1} = $zpipe->[1];
585                 close $zpipe->[0];
586         }
587         $self->{wcb} = $self->write_cb($lei);
588 }
589
590 sub ipc_atfork_child {
591         my ($self) = @_;
592         my $lei = $self->{lei};
593         $lei->_lei_atfork_child;
594         $lei->{auth}->do_auth_atfork($self) if $lei->{auth};
595         $SIG{__WARN__} = PublicInbox::Eml::warn_ignore_cb();
596         $self->SUPER::ipc_atfork_child;
597 }
598
599 sub lock_free {
600         $_[0]->{base_type} =~ /\A(?:maildir|imap|jmap)\z/ ? 1 : 0;
601 }
602
603 sub poke_dst {
604         my ($self) = @_;
605         if ($self->{base_type} eq 'maildir') {
606                 my $t = time + 1;
607                 utime($t, $t, $self->{dst} . 'cur');
608         }
609 }
610
611 sub write_mail { # via ->wq_io_do
612         my ($self, $smsg) = @_;
613         git_async_cat($self->{lei}->{ale}->git, $smsg->{blob}, \&git_to_mail,
614                                 [$self->{wcb}, $smsg]);
615 }
616
617 sub wq_atexit_child {
618         my ($self) = @_;
619         delete $self->{wcb};
620         $self->{lei}->{ale}->git->async_wait_all;
621         $SIG{__WARN__} = 'DEFAULT';
622 }
623
624 # called in top-level lei-daemon when LeiAuth is done
625 sub net_merge_complete {
626         my ($self) = @_;
627         $self->wq_broadcast('do_post_auth');
628         $self->wq_close(1);
629 }
630
631 no warnings 'once'; # the following works even when LeiAuth is lazy-loaded
632 *net_merge_all = \&PublicInbox::LeiAuth::net_merge_all;
633 1;