]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/LeiToMail.pm
lei index: new command to index mail w/o git storage
[public-inbox.git] / lib / PublicInbox / LeiToMail.pm
index 76a11b0efcf5d1009eda9e883b3acd51a09f777a..da3a95d20d2e1869124f77d1e4b0f14b17d28ec6 100644 (file)
@@ -9,12 +9,10 @@ use parent qw(PublicInbox::IPC);
 use PublicInbox::Eml;
 use PublicInbox::ProcessPipe;
 use PublicInbox::Spawn qw(spawn);
-use PublicInbox::LeiDedupe;
 use PublicInbox::PktOp qw(pkt_do);
 use Symbol qw(gensym);
 use IO::Handle; # ->autoflush
 use Fcntl qw(SEEK_SET SEEK_END O_CREAT O_EXCL O_WRONLY);
-use Digest::SHA qw(sha256_hex);
 
 my %kw2char = ( # Maildir characters
        draft => 'D',
@@ -40,7 +38,7 @@ sub _mbox_hdr_buf ($$$) {
                if (my $ent = $kw2status{$k}) {
                        push @{$hdr{$ent->[0]}}, $ent->[1];
                } else { # X-Label?
-                       warn "TODO: keyword `$k' not supported for mbox\n";
+                       warn "# keyword `$k' not supported for mbox\n";
                }
        }
        # Messages are always 'O' (non-\Recent in IMAP), it saves
@@ -139,18 +137,17 @@ sub eml2mboxcl2 {
 
 sub git_to_mail { # git->cat_async callback
        my ($bref, $oid, $type, $size, $arg) = @_;
-       if ($type ne 'blob') {
-               if ($type eq 'missing') {
-                       warn "missing $oid\n";
-               } else {
-                       warn "unexpected type=$type for $oid\n";
-               }
-       }
        my ($write_cb, $smsg) = @$arg;
-       if ($smsg->{blob} ne $oid) {
-               die "BUG: expected=$smsg->{blob} got=$oid";
+       if ($type eq 'missing' && $smsg->{-lms_ro}) {
+               if ($bref = $smsg->{-lms_ro}->local_blob($oid, 1)) {
+                       $type = 'blob';
+                       $size = length($$bref);
+               }
        }
-       $write_cb->($bref, $smsg) if $size > 0;
+       return warn("W: $oid is $type (!= blob)\n") if $type ne 'blob';
+       return warn("E: $oid is empty\n") unless $size;
+       die "BUG: expected=$smsg->{blob} got=$oid" if $smsg->{blob} ne $oid;
+       $write_cb->($bref, $smsg);
 }
 
 sub reap_compress { # dwaitpid callback
@@ -160,7 +157,7 @@ sub reap_compress { # dwaitpid callback
        $lei->fail("@$cmd failed", $? >> 8);
 }
 
-sub _post_augment_mbox { # open a compressor process
+sub _post_augment_mbox { # open a compressor process from top-level process
        my ($self, $lei) = @_;
        my $zsfx = $self->{zsfx} or return;
        my $cmd = PublicInbox::MboxReader::zsfx2cmd($zsfx, undef, $lei);
@@ -174,12 +171,6 @@ sub _post_augment_mbox { # open a compressor process
        $lei->{1} = $pp;
 }
 
-sub dup_src ($) {
-       my ($in) = @_;
-       open my $dup, '+>>&', $in or die "dup: $!";
-       $dup;
-}
-
 # --augment existing output destination, with deduplication
 sub _augment { # MboxReader eml_cb
        my ($eml, $lei) = @_;
@@ -208,12 +199,16 @@ sub _mbox_write_cb ($$) {
        sub { # for git_to_mail
                my ($buf, $smsg, $eml) = @_;
                $eml //= PublicInbox::Eml->new($buf);
-               return if $dedupe->is_dup($eml, $smsg->{blob});
+               return if $dedupe->is_dup($eml, $smsg);
                $lse->xsmsg_vmd($smsg) if $lse;
                $buf = $eml2mbox->($eml, $smsg);
-               return atomic_append($lei, $buf) if $atomic_append;
-               my $lk = $ovv->lock_for_scope;
-               $lei->out($$buf);
+               if ($atomic_append) {
+                       atomic_append($lei, $buf);
+               } else {
+                       my $lk = $ovv->lock_for_scope;
+                       $lei->out($$buf);
+               }
+               ++$lei->{-nr_write};
        }
 }
 
@@ -234,17 +229,9 @@ sub update_kw_maybe ($$$$) {
        }
 }
 
-sub _augment_or_unlink { # maildir_each_eml cb
-       my ($f, $kw, $eml, $lei, $lse, $mod, $shard, $unlink) = @_;
-       if ($mod) {
-               # can't get dirent.d_ino w/ pure Perl readdir, so we extract
-               # the OID if it looks like one instead of doing stat(2)
-               my $hex = $f =~ m!\b([a-f0-9]{40,})[^/]*\z! ?
-                               $1 : sha256_hex($f);
-               my $recno = hex(substr($hex, 0, 8));
-               return if ($recno % $mod) != $shard;
-               update_kw_maybe($lei, $lse, $eml, $kw);
-       }
+sub _md_update { # maildir_each_eml cb
+       my ($f, $kw, $eml, $lei, $lse, $unlink) = @_;
+       update_kw_maybe($lei, $lse, $eml, $kw);
        $unlink ? unlink($f) : _augment($eml, $lei);
 }
 
@@ -261,7 +248,7 @@ sub _buf2maildir {
        my $kw = $smsg->{kw} // [];
        my $sfx = join('', sort(map { $kw2char{$_} // () } @$kw));
        my $rand = ''; # chosen by die roll :P
-       my ($tmp, $fh, $final, $ok);
+       my ($tmp, $fh, $base, $ok);
        my $common = $smsg->{blob} // _rand;
        if (defined(my $pct = $smsg->{pct})) { $common .= "=$pct" }
        do {
@@ -276,11 +263,12 @@ sub _buf2maildir {
                $dst .= 'cur/';
                $rand = '';
                do {
-                       $final = $dst.$rand.$common.':2,'.$sfx;
-               } while (!($ok = link($tmp, $final)) && $!{EEXIST} &&
+                       $base = $rand.$common.':2,'.$sfx
+               } while (!($ok = link($tmp, $dst.$base)) && $!{EEXIST} &&
                        ($rand = _rand.','));
-               die "link($tmp, $final): $!" unless $ok;
+               die "link($tmp, $dst$base): $!" unless $ok;
                unlink($tmp) or warn "W: failed to unlink $tmp: $!\n";
+               \$base;
        } else {
                my $err = "Error writing $smsg->{blob} to $dst: $!\n";
                $_[0] = undef; # clobber dst
@@ -295,16 +283,18 @@ sub _maildir_write_cb ($$) {
        $dedupe->prepare_dedupe if $dedupe;
        my $dst = $lei->{ovv}->{dst};
        my $lse = $lei->{lse}; # may be undef
+       my $sto = $lei->{opt}->{'mail-sync'} ? $lei->{sto} : undef;
+       my $out = $sto ? 'maildir:'.$lei->rel2abs($dst) : undef;
        sub { # for git_to_mail
-               my ($buf, $smsg, $eml) = @_;
+               my ($bref, $smsg, $eml) = @_;
                $dst // return $lei->fail; # dst may be undef-ed in last run
-               $buf //= \($eml->as_string);
+               return if $dedupe && $dedupe->is_dup($eml //
+                                               PublicInbox::Eml->new($$bref),
+                                               $smsg);
                $lse->xsmsg_vmd($smsg) if $lse;
-               return _buf2maildir($dst, $buf, $smsg) if !$dedupe;
-               $eml //= PublicInbox::Eml->new($$buf); # copy buf
-               return if $dedupe->is_dup($eml, $smsg->{blob});
-               undef $eml;
-               _buf2maildir($dst, $buf, $smsg);
+               my $n = _buf2maildir($dst, $bref // \($eml->as_string), $smsg);
+               $sto->ipc_do('set_sync_info', $smsg->{blob}, $out, $n) if $sto;
+               ++$lei->{-nr_write};
        }
 }
 
@@ -312,23 +302,49 @@ sub _imap_write_cb ($$) {
        my ($self, $lei) = @_;
        my $dedupe = $lei->{dedupe};
        $dedupe->prepare_dedupe if $dedupe;
-       my $imap_append = $lei->{net}->can('imap_append');
+       my $append = $lei->{net}->can('imap_append');
        my $mic = $lei->{net}->mic_get($self->{uri});
        my $folder = $self->{uri}->mailbox;
        my $lse = $lei->{lse}; # may be undef
+       my $sto = $lei->{opt}->{'mail-sync'} ? $lei->{sto} : undef;
+       my $out = $lei->{ovv}->{dst};
        sub { # for git_to_mail
                my ($bref, $smsg, $eml) = @_;
-               $mic // return $lei->fail; # dst may be undef-ed in last run
-               if ($dedupe) {
-                       $eml //= PublicInbox::Eml->new($$bref); # copy bref
-                       return if $dedupe->is_dup($eml, $smsg->{blob});
-               }
+               $mic // return $lei->fail; # mic may be undef-ed in last run
+               return if $dedupe && $dedupe->is_dup($eml //
+                                               PublicInbox::Eml->new($$bref),
+                                               $smsg);
                $lse->xsmsg_vmd($smsg) if $lse;
-               eval { $imap_append->($mic, $folder, $bref, $smsg, $eml) };
+               my $uid = eval { $append->($mic, $folder, $bref, $smsg, $eml) };
                if (my $err = $@) {
                        undef $mic;
                        die $err;
                }
+               # imap_append returns UID if IMAP server has UIDPLUS extension
+               ($sto && $uid =~ /\A[0-9]+\z/) and
+                       $sto->ipc_do('set_sync_info',
+                                       $smsg->{blob}, $out, $uid + 0);
+               ++$lei->{-nr_write};
+       }
+}
+
+sub _text_write_cb ($$) {
+       my ($self, $lei) = @_;
+       my $dedupe = $lei->{dedupe};
+       $dedupe->prepare_dedupe if $dedupe;
+       my $lvt = $lei->{lvt};
+       my $ovv = $lei->{ovv};
+       $lei->{1} // die "no stdout ($ovv->{dst})"; # redirected earlier
+       $lei->{1}->autoflush(1);
+       binmode $lei->{1}, ':utf8';
+       my $lse = $lei->{lse}; # may be undef
+       sub { # for git_to_mail
+               my ($bref, $smsg, $eml) = @_;
+               $lse->xsmsg_vmd($smsg) if $lse;
+               $eml //= PublicInbox::Eml->new($bref); # copy bref
+               return if $dedupe && $dedupe->is_dup($eml, $smsg);
+               my $lk = $ovv->lock_for_scope;
+               $lei->out(${$lvt->eml_to_text($smsg, $eml)}, "\n");
        }
 }
 
@@ -352,27 +368,47 @@ sub new {
                $lei->{ovv}->{dst} = $dst .= '/' if substr($dst, -1) ne '/';
        } elsif (substr($fmt, 0, 4) eq 'mbox') {
                require PublicInbox::MboxReader;
-               (-d $dst || (-e _ && !-w _)) and die
-                       "$dst exists and is not a writable file\n";
                $self->can("eml2$fmt") or die "bad mbox format: $fmt\n";
                $self->{base_type} = 'mbox';
-       } elsif ($fmt =~ /\Aimaps?\z/) { # TODO .onion support
+       } elsif ($fmt =~ /\Aimaps?\z/) {
                require PublicInbox::NetWriter;
+               require PublicInbox::URIimap;
                my $net = PublicInbox::NetWriter->new;
-               $net->add_url($dst);
                $net->{quiet} = $lei->{opt}->{quiet};
-               my $err = $net->errors($dst);
+               my $uri = PublicInbox::URIimap->new($dst)->canonical;
+               $net->add_url($uri);
+               my $err = $net->errors($lei);
                return $lei->fail($err) if $err;
-               require PublicInbox::URIimap; # TODO: URI cast early
-               $self->{uri} = PublicInbox::URIimap->new($dst);
-               $self->{uri}->mailbox or die "No mailbox: $dst";
+               $uri->mailbox or return $lei->fail("No mailbox: $dst");
+               $self->{uri} = $uri;
+               $dst = $lei->{ovv}->{dst} = $$uri; # canonicalized
                $lei->{net} = $net;
                $self->{base_type} = 'imap';
+       } elsif ($fmt eq 'text') {
+               require PublicInbox::LeiViewText;
+               $lei->{lvt} = PublicInbox::LeiViewText->new($lei);
+               $self->{base_type} = 'text';
        } else {
                die "bad mail --format=$fmt\n";
        }
+       if ($self->{base_type} =~ /\A(?:text|mbox)\z/) {
+               (-d $dst || (-e _ && !-w _)) and die
+                       "$dst exists and is not a writable file\n";
+       }
+       if ($self->{base_type} eq 'text') {
+               my @err = map {
+                       defined($lei->{opt}->{$_}) ? "--$_" : ();
+               } (qw(mua save));
+               die "@err incompatible with $fmt\n" if @err;
+       }
        $self->{dst} = $dst;
-       $lei->{dedupe} = PublicInbox::LeiDedupe->new($lei);
+       $lei->{dedupe} = $lei->{lss} // do {
+               my $dd_cls = 'PublicInbox::'.
+                       ($lei->{opt}->{save} ? 'LeiSavedSearch' : 'LeiDedupe');
+               eval "require $dd_cls";
+               die "$dd_cls: $@" if $@;
+               $dd_cls->new($lei);
+       };
        $self;
 }
 
@@ -386,27 +422,28 @@ sub _pre_augment_maildir {
                File::Path::mkpath($d);
                -d $d or die "$d is not a directory";
        }
+       # for utime, so no opendir
+       open $self->{poke_dh}, '<', "${dst}cur" or die "open ${dst}cur: $!";
 }
 
 sub _do_augment_maildir {
        my ($self, $lei) = @_;
+       return if ($lei->{opt}->{save} // 0) < 0;
        my $dst = $lei->{ovv}->{dst};
        my $lse = $lei->{opt}->{'import-before'} ? $lei->{lse} : undef;
-       my ($mod, $shard) = @{$self->{shard_info} // []};
+       my $mdr = PublicInbox::MdirReader->new;
        if ($lei->{opt}->{augment}) {
                my $dedupe = $lei->{dedupe};
                if ($dedupe && $dedupe->prepare_dedupe) {
-                       PublicInbox::MdirReader::maildir_each_eml($dst,
-                                               \&_augment_or_unlink,
-                                               $lei, $lse, $mod, $shard);
+                       $mdr->{shard_info} = $self->{shard_info};
+                       $mdr->maildir_each_eml($dst, \&_md_update, $lei, $lse);
                        $dedupe->pause_dedupe;
                }
        } elsif ($lse) {
-               PublicInbox::MdirReader::maildir_each_eml($dst,
-                                       \&_augment_or_unlink,
-                                       $lei, $lse, $mod, $shard, 1);
+               $mdr->{shard_info} = $self->{shard_info};
+               $mdr->maildir_each_eml($dst, \&_md_update, $lei, $lse, 1);
        } else {# clobber existing Maildir
-               PublicInbox::MdirReader::maildir_each_file($dst, \&_unlink);
+               $mdr->maildir_each_file($dst, \&_unlink);
        }
 }
 
@@ -422,6 +459,7 @@ sub _imap_augment_or_delete { # PublicInbox::NetReader::imap_each cb
 
 sub _do_augment_imap {
        my ($self, $lei) = @_;
+       return if ($lei->{opt}->{save} // 0) < 0;
        my $net = $lei->{net};
        my $lse = $lei->{opt}->{'import-before'} ? $lei->{lse} : undef;
        if ($lei->{opt}->{augment}) {
@@ -442,6 +480,29 @@ sub _do_augment_imap {
        }
 }
 
+sub _pre_augment_text {
+       my ($self, $lei) = @_;
+       my $dst = $lei->{ovv}->{dst};
+       my $out;
+       my $devfd = $lei->path_to_fd($dst) // die "bad $dst";
+       if ($devfd >= 0) {
+               $out = $lei->{$devfd};
+       } else { # normal-looking path
+               if (-p $dst) {
+                       open $out, '>', $dst or die "open($dst): $!";
+               } elsif (-f _ || !-e _) {
+                       # text allows augment, HTML/Atom won't
+                       my $mode = $lei->{opt}->{augment} ? '>>' : '>';
+                       open $out, $mode, $dst or die "open($mode, $dst): $!";
+               } else {
+                       die "$dst is not a file or FIFO\n";
+               }
+       }
+       $lei->{ovv}->ovv_out_lk_init if !$lei->{ovv}->{lock_path};
+       $lei->{1} = $out;
+       undef;
+}
+
 sub _pre_augment_mbox {
        my ($self, $lei) = @_;
        my $dst = $lei->{ovv}->{dst};
@@ -492,6 +553,7 @@ sub _do_augment_mbox {
        my ($self, $lei) = @_;
        return unless $self->{seekable};
        my $opt = $lei->{opt};
+       return if ($opt->{save} // 0) < 0;
        my $out = $lei->{1};
        my ($fmt, $dst) = @{$lei->{ovv}}{qw(fmt dst)};
        return unless -s $out;
@@ -499,9 +561,12 @@ sub _do_augment_mbox {
                truncate($out, 0) or die "truncate($dst): $!";
                return;
        }
-       my $zsfx = $self->{zsfx};
-       my $rd = $zsfx ? PublicInbox::MboxReader::zsfxcat($out, $zsfx, $lei)
-                       : dup_src($out);
+       my $rd;
+       if (my $zsfx = $self->{zsfx}) {
+               $rd = PublicInbox::MboxReader::zsfxcat($out, $zsfx, $lei);
+       } else {
+               open($rd, '+>>&', $out) or die "dup: $!";
+       }
        my $dedupe;
        if ($opt->{augment}) {
                $dedupe = $lei->{dedupe};
@@ -532,8 +597,8 @@ sub pre_augment { # fast (1 disk seek), runs in same process as post_augment
 sub do_augment { # slow, runs in wq worker
        my ($self, $lei) = @_;
        # _do_augment_maildir, _do_augment_mbox, or _do_augment_imap
-       my $m = "_do_augment_$self->{base_type}";
-       $self->$m($lei);
+       my $m = $self->can("_do_augment_$self->{base_type}") or return;
+       $m->($self, $lei);
 }
 
 # fast (spawn compressor or mkdir), runs in same process as pre_augment
@@ -546,6 +611,7 @@ sub post_augment {
        $m->($self, $lei, @args);
 }
 
+# called by every single l2m worker process
 sub do_post_auth {
        my ($self) = @_;
        my $lei = $self->{lei};
@@ -553,7 +619,7 @@ sub do_post_auth {
        pkt_do($lei->{pkt_op_p}, 'incr_start_query') or
                die "incr_start_query: $!";
        my $aug;
-       if (lock_free($self)) {
+       if (lock_free($self)) { # all workers do_augment
                my $mod = $self->{-wq_nr_workers};
                my $shard = $self->{-wq_worker_nr};
                if (my $net = $lei->{net}) {
@@ -562,7 +628,7 @@ sub do_post_auth {
                        $self->{shard_info} = [ $mod, $shard ];
                }
                $aug = '+'; # incr_post_augment
-       } elsif ($self->{-wq_worker_nr} == 0) {
+       } elsif ($self->{-wq_worker_nr} == 0) { # 1st worker do_augment
                $aug = '.'; # do_post_augment
        }
        if ($aug) {
@@ -572,6 +638,7 @@ sub do_post_auth {
                pkt_do($lei->{pkt_op_p}, $aug) == 1 or
                                die "do_post_augment trigger: $!";
        }
+       # done augmenting, connect the compressor pipe for each worker
        if (my $zpipe = delete $lei->{zpipe}) {
                $lei->{1} = $zpipe->[1];
                close $zpipe->[0];
@@ -583,6 +650,7 @@ sub ipc_atfork_child {
        my ($self) = @_;
        my $lei = $self->{lei};
        $lei->_lei_atfork_child;
+       $self->{-lms_ro} = $lei->{lse}->lms if $lei->{lse};
        $lei->{auth}->do_auth_atfork($self) if $lei->{auth};
        $SIG{__WARN__} = PublicInbox::Eml::warn_ignore_cb();
        $self->SUPER::ipc_atfork_child;
@@ -592,16 +660,19 @@ sub lock_free {
        $_[0]->{base_type} =~ /\A(?:maildir|imap|jmap)\z/ ? 1 : 0;
 }
 
+# wakes up the MUA when complete so it can refresh messages list
 sub poke_dst {
        my ($self) = @_;
        if ($self->{base_type} eq 'maildir') {
                my $t = time + 1;
-               utime($t, $t, $self->{dst} . 'cur');
+               utime($t, $t, $self->{poke_dh}) or warn "futimes: $!";
        }
 }
 
 sub write_mail { # via ->wq_io_do
-       my ($self, $smsg) = @_;
+       my ($self, $smsg, $eml) = @_;
+       return $self->{wcb}->(undef, $smsg, $eml) if $eml;
+       $smsg->{-lms_ro} = $self->{-lms_ro};
        $self->{lei}->{ale}->git->cat_async($smsg->{blob}, \&git_to_mail,
                                [$self->{wcb}, $smsg]);
 }
@@ -609,12 +680,16 @@ sub write_mail { # via ->wq_io_do
 sub wq_atexit_child {
        my ($self) = @_;
        delete $self->{wcb};
-       $self->{lei}->{ale}->git->async_wait_all;
-       $SIG{__WARN__} = 'DEFAULT';
+       my $lei = $self->{lei};
+       $lei->{ale}->git->async_wait_all;
+       my $nr = delete($lei->{-nr_write}) or return;
+       return if $lei->{early_mua} || !$lei->{-progress} || !$lei->{pkt_op_p};
+       require PublicInbox::PktOp;
+       PublicInbox::PktOp::pkt_do($lei->{pkt_op_p}, 'l2m_progress', $nr);
 }
 
 # called in top-level lei-daemon when LeiAuth is done
-sub net_merge_complete {
+sub net_merge_all_done {
        my ($self) = @_;
        $self->wq_broadcast('do_post_auth');
        $self->wq_close(1);