]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/LeiToMail.pm
lei q: support mbox locking by default
[public-inbox.git] / lib / PublicInbox / LeiToMail.pm
index 1f815e4079e9d7e9419194baa1f9b74482aa7408..de64065706c6960c60f9ca7b3303808378b447ba 100644 (file)
@@ -11,13 +11,15 @@ use PublicInbox::Lock;
 use PublicInbox::ProcessPipe;
 use PublicInbox::Spawn qw(which spawn popen_rd);
 use PublicInbox::LeiDedupe;
-use PublicInbox::OnDestroy;
 use PublicInbox::Git;
 use PublicInbox::GitAsyncCat;
+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 Errno qw(EEXIST ESPIPE ENOENT EPIPE);
+use Digest::SHA qw(sha256_hex);
+my ($maildir_each_file);
 
 # struggles with short-lived repos, Gcf2Client makes little sense with lei;
 # but we may use in-process libgit2 in the future.
@@ -216,7 +218,7 @@ sub _post_augment_mbox { # open a compressor process
        my $cmd = zsfx2cmd($zsfx, undef, $lei);
        my ($r, $w) = @{delete $lei->{zpipe}};
        my $rdr = { 0 => $r, 1 => $lei->{1}, 2 => $lei->{2} };
-       my $pid = spawn($cmd, $lei->{env}, $rdr);
+       my $pid = spawn($cmd, undef, $rdr);
        my $pp = gensym;
        my $dup = bless { "pid.$pid" => $cmd }, ref($lei);
        $dup->{$_} = $lei->{$_} for qw(2 sock);
@@ -229,7 +231,7 @@ sub _post_augment_mbox { # open a compressor process
 sub decompress_src ($$$) {
        my ($in, $zsfx, $lei) = @_;
        my $cmd = zsfx2cmd($zsfx, 1, $lei);
-       popen_rd($cmd, $lei->{env}, { 0 => $in, 2 => $lei->{2} });
+       popen_rd($cmd, undef, { 0 => $in, 2 => $lei->{2} });
 }
 
 sub dup_src ($) {
@@ -266,24 +268,21 @@ sub _mbox_write_cb ($$) {
        }
 }
 
-sub _maildir_each_file ($$;@) {
-       my ($dir, $cb, @arg) = @_;
-       for my $d (qw(new/ cur/)) {
-               my $pfx = $dir.$d;
-               opendir my $dh, $pfx or next;
-               while (defined(my $fn = readdir($dh))) {
-                       $cb->($pfx.$fn, @arg) if $fn =~ /:2,[A-Za-z]*\z/;
-               }
+sub _augment_file { # maildir_each_file cb
+       my ($f, $lei, $mod, $shard) = @_;
+       if ($mod) {
+               # can't get dirent.d_ino w/ pure Perl, so we extract the OID
+               # if it looks like one:
+               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;
        }
-}
-
-sub _augment_file { # _maildir_each_file cb
-       my ($f, $lei) = @_;
        my $eml = PublicInbox::InboxWritable::eml_from_path($f) or return;
        _augment($eml, $lei);
 }
 
-# _maildir_each_file callback, \&CORE::unlink doesn't work with it
+# maildir_each_file callback, \&CORE::unlink doesn't work with it
 sub _unlink { unlink($_[0]) }
 
 sub _rand () {
@@ -312,8 +311,9 @@ sub _buf2maildir {
                $rand = '';
                do {
                        $final = $dst.$rand.$common.':2,'.$sfx;
-               } while (!link($tmp, $final) && $! == EEXIST &&
+               } while (!($ok = link($tmp, $final)) && $! == EEXIST &&
                        ($rand = _rand.','));
+               die "link($tmp, $final): $!" unless $ok;
                unlink($tmp) or warn "W: failed to unlink $tmp: $!\n";
        } else {
                my $err = "Error writing $smsg->{blob} to $dst: $!\n";
@@ -340,9 +340,31 @@ sub _maildir_write_cb ($$) {
        }
 }
 
+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 $mic = $lei->{net}->mic_get($self->{uri});
+       my $folder = $self->{uri}->mailbox;
+       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});
+               }
+               eval { $imap_append->($mic, $folder, $bref, $smsg, $eml) };
+               if (my $err = $@) {
+                       undef $mic;
+                       die $err;
+               }
+       }
+}
+
 sub write_cb { # returns a callback for git_to_mail
        my ($self, $lei) = @_;
-       # _mbox_write_cb or _maildir_write_cb
+       # _mbox_write_cb, _maildir_write_cb or _imap_write_cb
        my $m = "_$self->{base_type}_write_cb";
        $self->$m($lei);
 }
@@ -353,15 +375,34 @@ sub new {
        my $dst = $lei->{ovv}->{dst};
        my $self = bless {}, $cls;
        if ($fmt eq 'maildir') {
+               $maildir_each_file //= do {
+                       require PublicInbox::MdirReader;
+                       PublicInbox::MdirReader->can('maildir_each_file');
+               };
+               $lei->{opt}->{augment} and
+                       require PublicInbox::InboxWritable; # eml_from_path
                $self->{base_type} = 'maildir';
                -e $dst && !-d _ and die
                                "$dst exists and is not a directory\n";
                $lei->{ovv}->{dst} = $dst .= '/' if substr($dst, -1) ne '/';
        } elsif (substr($fmt, 0, 4) eq 'mbox') {
+               require PublicInbox::MboxReader if $lei->{opt}->{augment};
                (-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->can("eml2$fmt") or die "bad mbox format: $fmt\n";
                $self->{base_type} = 'mbox';
+       } elsif ($fmt =~ /\Aimaps?\z/) { # TODO .onion support
+               require PublicInbox::NetWriter;
+               my $net = PublicInbox::NetWriter->new;
+               $net->add_url($dst);
+               $net->{quiet} = $lei->{opt}->{quiet};
+               my $err = $net->errors($dst);
+               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";
+               $lei->{net} = $net;
+               $self->{base_type} = 'imap';
        } else {
                die "bad mail --format=$fmt\n";
        }
@@ -370,7 +411,17 @@ sub new {
        $self;
 }
 
-sub _pre_augment_maildir {} # noop
+sub _pre_augment_maildir {
+       my ($self, $lei) = @_;
+       my $dst = $lei->{ovv}->{dst};
+       for my $x (qw(tmp new cur)) {
+               my $d = $dst.$x;
+               next if -d $d;
+               require File::Path;
+               File::Path::mkpath($d);
+               -d $d or die "$d is not a directory";
+       }
+}
 
 sub _do_augment_maildir {
        my ($self, $lei) = @_;
@@ -378,24 +429,33 @@ sub _do_augment_maildir {
        if ($lei->{opt}->{augment}) {
                my $dedupe = $lei->{dedupe};
                if ($dedupe && $dedupe->prepare_dedupe) {
-                       require PublicInbox::InboxWritable; # eml_from_path
-                       _maildir_each_file($dst, \&_augment_file, $lei);
+                       my ($mod, $shard) = @{$self->{shard_info} // []};
+                       $maildir_each_file->($dst, \&_augment_file,
+                                               $lei, $mod, $shard);
                        $dedupe->pause_dedupe;
                }
        } else { # clobber existing Maildir
-               _maildir_each_file($dst, \&_unlink);
+               $maildir_each_file->($dst, \&_unlink);
        }
 }
 
-sub _post_augment_maildir {
+sub _augment_imap { # PublicInbox::NetReader::imap_each cb
+       my ($url, $uid, $kw, $eml, $lei) = @_;
+       _augment($eml, $lei);
+}
+
+sub _do_augment_imap {
        my ($self, $lei) = @_;
-       my $dst = $lei->{ovv}->{dst};
-       for my $x (qw(tmp new cur)) {
-               my $d = $dst.$x;
-               next if -d $d;
-               require File::Path;
-               File::Path::mkpath($d);
-               -d $d or die "$d is not a directory";
+       my $net = $lei->{net};
+       if ($lei->{opt}->{augment}) {
+               my $dedupe = $lei->{dedupe};
+               if ($dedupe && $dedupe->prepare_dedupe) {
+                       $net->imap_each($self->{uri}, \&_augment_imap, $lei);
+                       $dedupe->pause_dedupe;
+               }
+       } elsif (!$self->{-wq_worker_nr}) { # undef or 0
+               # clobber existing IMAP folder
+               $net->imap_delete_all($self->{uri});
        }
 }
 
@@ -403,11 +463,19 @@ sub _pre_augment_mbox {
        my ($self, $lei) = @_;
        my $dst = $lei->{ovv}->{dst};
        if ($dst ne '/dev/stdout') {
-               my $mode = -p $dst ? '>' : '+>>';
-               if (-f _ && !$lei->{opt}->{augment} and !unlink($dst)) {
-                       $! == ENOENT or die "unlink($dst): $!";
+               my $out;
+               if (-p $dst) {
+                       open $out, '>', $dst or die "open($dst): $!";
+               } elsif (-f _ || !-e _) {
+                       require PublicInbox::MboxLock;
+                       my $m = $lei->{opt}->{'lock'} //
+                                       PublicInbox::MboxLock->defaults;
+                       $self->{mbl} = PublicInbox::MboxLock->acq($dst, 1, $m);
+                       $out = $self->{mbl}->{fh};
+                       if (!$lei->{opt}->{augment} and !truncate($out, 0)) {
+                               die "truncate($dst): $!";
+                       }
                }
-               open my $out, $mode, $dst or die "open($dst): $!";
                $lei->{old_1} = $lei->{1}; # keep for spawning MUA
                $lei->{1} = $out;
        }
@@ -434,7 +502,6 @@ sub _do_augment_mbox {
                my $rd = $zsfx ? decompress_src($out, $zsfx, $lei) :
                                dup_src($out);
                my $fmt = $lei->{ovv}->{fmt};
-               require PublicInbox::MboxReader;
                PublicInbox::MboxReader->$fmt($rd, \&_augment, $lei);
        }
        # maybe some systems don't honor O_APPEND, Perl does this:
@@ -442,36 +509,66 @@ sub _do_augment_mbox {
        $dedupe->pause_dedupe if $dedupe;
 }
 
-sub pre_augment { # fast (1 disk seek), runs in main daemon
+sub pre_augment { # fast (1 disk seek), runs in same process as post_augment
        my ($self, $lei) = @_;
        # _pre_augment_maildir, _pre_augment_mbox
-       my $m = "_pre_augment_$self->{base_type}";
-       $self->$m($lei);
+       my $m = $self->can("_pre_augment_$self->{base_type}") or return;
+       $m->($self, $lei);
 }
 
 sub do_augment { # slow, runs in wq worker
        my ($self, $lei) = @_;
-       # _do_augment_maildir, _do_augment_mbox
+       # _do_augment_maildir, _do_augment_mbox, or _do_augment_imap
        my $m = "_do_augment_$self->{base_type}";
        $self->$m($lei);
 }
 
-sub post_augment { # fast (spawn compressor or mkdir), runs in main daemon
+# fast (spawn compressor or mkdir), runs in same process as pre_augment
+sub post_augment {
        my ($self, $lei, @args) = @_;
-       # _post_augment_maildir, _post_augment_mbox
-       my $m = "_post_augment_$self->{base_type}";
-       $self->$m($lei, @args);
+       # _post_augment_mbox
+       my $m = $self->can("_post_augment_$self->{base_type}") or return;
+       $m->($self, $lei, @args);
 }
 
-sub ipc_atfork_child {
+sub do_post_auth {
        my ($self) = @_;
-       my $lei = delete $self->{lei};
-       $lei->lei_atfork_child;
+       my $lei = $self->{lei};
+       # lei_xsearch can start as soon as all l2m workers get here
+       pkt_do($lei->{pkt_op_p}, 'incr_start_query') or
+               die "incr_start_query: $!";
+       my $aug;
+       if (lock_free($self)) {
+               my $mod = $self->{-wq_nr_workers};
+               my $shard = $self->{-wq_worker_nr};
+               if (my $net = $lei->{net}) {
+                       $net->{shard_info} = [ $mod, $shard ];
+               } else { # Maildir (MH?)
+                       $self->{shard_info} = [ $mod, $shard ];
+               }
+               $aug = '+'; # incr_post_augment
+       } elsif ($self->{-wq_worker_nr} == 0) {
+               $aug = '.'; # do_post_augment
+       }
+       if ($aug) {
+               local $0 = 'do_augment';
+               eval { do_augment($self, $lei) };
+               $lei->fail($@) if $@;
+               pkt_do($lei->{pkt_op_p}, $aug) == 1 or
+                               die "do_post_augment trigger: $!";
+       }
        if (my $zpipe = delete $lei->{zpipe}) {
                $lei->{1} = $zpipe->[1];
                close $zpipe->[0];
        }
        $self->{wcb} = $self->write_cb($lei);
+}
+
+sub ipc_atfork_child {
+       my ($self) = @_;
+       my $lei = $self->{lei};
+       $lei->lei_atfork_child;
+       $lei->{auth}->do_auth_atfork($self) if $lei->{auth};
        $SIG{__WARN__} = PublicInbox::Eml::warn_ignore_cb();
        $self->SUPER::ipc_atfork_child;
 }
@@ -488,12 +585,11 @@ sub poke_dst {
        }
 }
 
-sub write_mail { # via ->wq_do
+sub write_mail { # via ->wq_io_do
        my ($self, $git_dir, $smsg) = @_;
-       my $not_done = delete $self->{0} // die 'BUG: $not_done missing';
        my $git = $self->{"$$\0$git_dir"} //= PublicInbox::Git->new($git_dir);
        git_async_cat($git, $smsg->{blob}, \&git_to_mail,
-                               [$self->{wcb}, $smsg, $not_done]);
+                               [$self->{wcb}, $smsg]);
 }
 
 sub wq_atexit_child {
@@ -505,4 +601,13 @@ sub wq_atexit_child {
        $SIG{__WARN__} = 'DEFAULT';
 }
 
+# called in top-level lei-daemon when LeiAuth is done
+sub net_merge_complete {
+       my ($self) = @_;
+       $self->wq_broadcast('do_post_auth');
+       $self->wq_close(1);
+}
+
+no warnings 'once'; # the following works even when LeiAuth is lazy-loaded
+*net_merge_all = \&PublicInbox::LeiAuth::net_merge_all;
 1;