]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/LeiToMail.pm
lei: show {pct} and {oid} in From_ lines and filenames
[public-inbox.git] / lib / PublicInbox / LeiToMail.pm
index 0e23b8da6ad01f56098e19af817ee618886a2b96..3dcce9e71687f4628152277aa98be83b63238e92 100644 (file)
@@ -5,6 +5,7 @@
 package PublicInbox::LeiToMail;
 use strict;
 use v5.10.1;
+use parent qw(PublicInbox::IPC);
 use PublicInbox::Eml;
 use PublicInbox::Lock;
 use PublicInbox::ProcessPipe;
@@ -14,6 +15,7 @@ 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);
+use PublicInbox::Git;
 
 my %kw2char = ( # Maildir characters
        draft => 'D',
@@ -30,10 +32,14 @@ my %kw2status = (
 );
 
 sub _mbox_hdr_buf ($$$) {
-       my ($eml, $type, $kw) = @_;
+       my ($eml, $type, $smsg) = @_;
        $eml->header_set($_) for (qw(Lines Bytes Content-Length));
-       my %hdr; # set Status, X-Status
-       for my $k (@$kw) {
+
+       # Messages are always 'O' (non-\Recent in IMAP), it saves
+       # MUAs the trouble of rewriting the mbox if no other
+       # changes are made
+       my %hdr = (Status => [ 'O' ]); # set Status, X-Status
+       for my $k (@{$smsg->{kw} // []}) {
                if (my $ent = $kw2status{$k}) {
                        push @{$hdr{$ent->[0]}}, $ent->[1];
                } else { # X-Label?
@@ -47,9 +53,11 @@ sub _mbox_hdr_buf ($$$) {
 
        # fixup old bug from import (pre-a0c07cba0e5d8b6a)
        $$buf =~ s/\A[\r\n]*From [^\r\n]*\r?\n//s;
+       my $ident = $smsg->{blob} // 'lei';
+       if (defined(my $pct = $smsg->{pct})) { $ident .= "=$pct" }
 
        substr($$buf, 0, 0, # prepend From line
-               "From lei\@$type Thu Jan  1 00:00:00 1970$eml->{crlf}");
+               "From $ident\@$type Thu Jan  1 00:00:00 1970$eml->{crlf}");
        $buf;
 }
 
@@ -65,8 +73,8 @@ sub _print_full {
 }
 
 sub eml2mboxrd ($;$) {
-       my ($eml, $kw) = @_;
-       my $buf = _mbox_hdr_buf($eml, 'mboxrd', $kw);
+       my ($eml, $smsg) = @_;
+       my $buf = _mbox_hdr_buf($eml, 'mboxrd', $smsg);
        if (my $bdy = delete $eml->{bdy}) {
                $$bdy =~ s/^(>*From )/>$1/gm;
                $$buf .= $eml->{crlf};
@@ -78,8 +86,8 @@ sub eml2mboxrd ($;$) {
 }
 
 sub eml2mboxo {
-       my ($eml, $kw) = @_;
-       my $buf = _mbox_hdr_buf($eml, 'mboxo', $kw);
+       my ($eml, $smsg) = @_;
+       my $buf = _mbox_hdr_buf($eml, 'mboxo', $smsg);
        if (my $bdy = delete $eml->{bdy}) {
                $$bdy =~ s/^From />From /gm;
                $$buf .= $eml->{crlf};
@@ -90,16 +98,24 @@ sub eml2mboxo {
        $buf;
 }
 
+sub _mboxcl_common ($$$) {
+       my ($buf, $bdy, $crlf) = @_;
+       # add Lines: so mutt won't have to add it on MUA close
+       my $lines = $$bdy =~ tr!\n!\n!;
+       $$buf .= 'Content-Length: '.length($$bdy).$crlf.
+               'Lines: '.$lines.$crlf.$crlf;
+       substr($$bdy, 0, 0, $$buf); # prepend header
+       $_[0] = $bdy;
+}
+
 # mboxcl still escapes "From " lines
 sub eml2mboxcl {
-       my ($eml, $kw) = @_;
-       my $buf = _mbox_hdr_buf($eml, 'mboxcl', $kw);
+       my ($eml, $smsg) = @_;
+       my $buf = _mbox_hdr_buf($eml, 'mboxcl', $smsg);
        my $crlf = $eml->{crlf};
        if (my $bdy = delete $eml->{bdy}) {
                $$bdy =~ s/^From />From /gm;
-               $$buf .= 'Content-Length: '.length($$bdy).$crlf.$crlf;
-               substr($$bdy, 0, 0, $$buf); # prepend header
-               $buf = $bdy;
+               _mboxcl_common($buf, $bdy, $crlf);
        }
        $$buf .= $crlf;
        $buf;
@@ -107,13 +123,11 @@ sub eml2mboxcl {
 
 # mboxcl2 has no "From " escaping
 sub eml2mboxcl2 {
-       my ($eml, $kw) = @_;
-       my $buf = _mbox_hdr_buf($eml, 'mboxcl2', $kw);
+       my ($eml, $smsg) = @_;
+       my $buf = _mbox_hdr_buf($eml, 'mboxcl2', $smsg);
        my $crlf = $eml->{crlf};
        if (my $bdy = delete $eml->{bdy}) {
-               $$buf .= 'Content-Length: '.length($$bdy).$crlf.$crlf;
-               substr($$bdy, 0, 0, $$buf); # prepend header
-               $buf = $bdy;
+               _mboxcl_common($buf, $bdy, $crlf);
        }
        $$buf .= $crlf;
        $buf;
@@ -128,10 +142,11 @@ sub git_to_mail { # git->cat_async callback
                        warn "unexpected type=$type for $oid\n";
                }
        }
-       if ($size > 0) {
-               my ($write_cb, $kw) = @$arg;
-               $write_cb->($bref, $oid, $kw);
+       my ($write_cb, $smsg) = @$arg;
+       if ($smsg->{blob} ne $oid) {
+               die "BUG: expected=$smsg->{blob} got=$oid";
        }
+       $write_cb->($bref, $smsg) if $size > 0;
 }
 
 sub reap_compress { # dwaitpid callback
@@ -188,18 +203,19 @@ sub zsfx2cmd ($$$) {
 }
 
 sub _post_augment_mbox { # open a compressor process
-       my ($self, $lei) = @_;
+       my ($self, $lei, $zpipe) = @_;
        my $zsfx = $self->{zsfx} or return;
        my $cmd = zsfx2cmd($zsfx, undef, $lei);
-       pipe(my ($r, $w)) or die "pipe: $!";
+       my ($r, $w) = splice(@$zpipe, 0, 2);
        my $rdr = { 0 => $r, 1 => $lei->{1}, 2 => $lei->{2} };
        my $pid = spawn($cmd, $lei->{env}, $rdr);
-       $lei->{"pid.$pid"} = $cmd;
        my $pp = gensym;
-       tie *$pp, 'PublicInbox::ProcessPipe', $pid, $w, \&reap_compress, $lei;
+       my $dup = bless { "pid.$pid" => $cmd }, ref($lei);
+       $dup->{$_} = $lei->{$_} for qw(2 sock);
+       tie *$pp, 'PublicInbox::ProcessPipe', $pid, $w, \&reap_compress, $dup;
        $lei->{1} = $pp;
        die 'BUG: unexpected {ovv}->{lock_path}' if $lei->{ovv}->{lock_path};
-       $lei->{ovv}->ovv_out_lk_init if ($lei->{opt}->{jobs} // 2) > 1;
+       $lei->{ovv}->ovv_out_lk_init;
 }
 
 sub decompress_src ($$$) {
@@ -234,12 +250,17 @@ sub _mbox_write_cb ($$) {
        my $dedupe = $lei->{dedupe};
        $dedupe->prepare_dedupe;
        sub { # for git_to_mail
-               my ($buf, $oid, $kw) = @_;
+               my ($buf, $smsg) = @_;
+               return unless $out;
                my $eml = PublicInbox::Eml->new($buf);
-               if (!$dedupe->is_dup($eml, $oid)) {
-                       $buf = $eml2mbox->($eml, $kw);
+               if (!$dedupe->is_dup($eml, $smsg->{blob})) {
+                       $buf = $eml2mbox->($eml, $smsg);
                        my $lk = $ovv->lock_for_scope;
-                       $write->($out, $buf);
+                       eval { $write->($out, $buf) };
+                       if ($@) {
+                               die $@ if ref($@) ne 'PublicInbox::SIGPIPE';
+                               undef $out
+                       }
                }
        }
 }
@@ -265,26 +286,33 @@ sub _augment_file { # _maildir_each_file cb
 sub _unlink { unlink($_[0]) }
 
 sub _buf2maildir {
-       my ($dst, $buf, $oid, $kw) = @_;
+       my ($dst, $buf, $smsg) = @_;
+       my $kw = $smsg->{kw} // [];
        my $sfx = join('', sort(map { $kw2char{$_} // () } @$kw));
        my $rand = ''; # chosen by die roll :P
        my ($tmp, $fh, $final);
+       my $common = $smsg->{blob};
+       if (defined(my $pct = $smsg->{pct})) { $common .= "=$pct" }
        do {
-               $tmp = $dst.'tmp/'.$rand."oid=$oid";
+               $tmp = $dst.'tmp/'.$rand.$common;
        } while (!sysopen($fh, $tmp, O_CREAT|O_EXCL|O_WRONLY) &&
                $! == EEXIST && ($rand = int(rand 0x7fffffff).','));
        if (print $fh $$buf and close($fh)) {
-               $dst .= $sfx eq '' ? 'new/' : 'cur/';
+               # ignore new/ and write only to cur/, otherwise MUAs
+               # with R/W access to the Maildir will end up doing
+               # a mass rename which can take a while with thousands
+               # of messages.
+               $dst .= 'cur/';
                $rand = '';
                do {
-                       $final = $dst.$rand."oid=$oid:2,$sfx";
+                       $final = $dst.$rand.$common.':2,'.$sfx;
                } while (!link($tmp, $final) && $! == EEXIST &&
                        ($rand = int(rand 0x7fffffff).','));
                unlink($tmp) or warn "W: failed to unlink $tmp: $!\n";
        } else {
                my $err = $!;
                unlink($tmp);
-               die "Error writing $oid to $dst: $err";
+               die "Error writing $smsg->{blob} to $dst: $err";
        }
 }
 
@@ -294,12 +322,12 @@ sub _maildir_write_cb ($$) {
        $dedupe->prepare_dedupe;
        my $dst = $lei->{ovv}->{dst};
        sub { # for git_to_mail
-               my ($buf, $oid, $kw) = @_;
-               return _buf2maildir($dst, $buf, $oid, $kw) if !$dedupe;
+               my ($buf, $smsg) = @_;
+               return _buf2maildir($dst, $buf, $smsg) if !$dedupe;
                my $eml = PublicInbox::Eml->new($$buf); # copy buf
-               return if $dedupe->is_dup($eml, $oid);
+               return if $dedupe->is_dup($eml, $smsg->{blob});
                undef $eml;
-               _buf2maildir($dst, $buf, $oid, $kw);
+               _buf2maildir($dst, $buf, $smsg);
        }
 }
 
@@ -317,8 +345,12 @@ sub new {
        my $self = bless {}, $cls;
        if ($fmt eq 'maildir') {
                $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') {
+               (-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';
        } else {
@@ -352,7 +384,7 @@ sub _post_augment_maildir {
                my $d = $dst.$x;
                next if -d $d;
                require File::Path;
-               File::Path::mkpath($d) or die "mkpath($d): $!";
+               File::Path::mkpath($d);
                -d $d or die "$d is not a directory";
        }
 }
@@ -374,7 +406,9 @@ sub _pre_augment_mbox {
                die "seek($dst): $!\n";
        }
        state $zsfx_allow = join('|', keys %zsfx2cmd);
-       ($self->{zsfx}) = ($dst =~ /\.($zsfx_allow)\z/);
+       ($self->{zsfx}) = ($dst =~ /\.($zsfx_allow)\z/) or return;
+       pipe(my ($r, $w)) or die "pipe: $!";
+       [ $r, $w ];
 }
 
 sub _do_augment_mbox {
@@ -412,14 +446,38 @@ sub do_augment { # slow, runs in wq worker
 }
 
 sub post_augment { # fast (spawn compressor or mkdir), runs in main daemon
-       my ($self, $lei) = @_;
+       my ($self, $lei, @args) = @_;
        # _post_augment_maildir, _post_augment_mbox
        my $m = "_post_augment_$self->{base_type}";
-       $self->$m($lei);
+       $self->$m($lei, @args);
+}
+
+sub write_mail { # via ->wq_do
+       my ($self, $git_dir, $smsg, $lei) = @_;
+       my $not_done = delete $self->{4}; # write end of {each_smsg_done}
+       my $wcb = $self->{wcb} //= do { # first message
+               my %sig = $lei->atfork_child_wq($self);
+               @SIG{keys %sig} = values %sig; # not local
+               $lei->{dedupe}->prepare_dedupe;
+               $self->write_cb($lei);
+       };
+       my $git = $self->{"$$\0$git_dir"} //= PublicInbox::Git->new($git_dir);
+       $git->cat_async($smsg->{blob}, \&git_to_mail, [$wcb, $smsg, $not_done]);
+}
+
+sub ipc_atfork_prepare {
+       my ($self) = @_;
+       # (qry_status_wr, stdout|mbox, stderr, 3: sock, 4: each_smsg_done_wr)
+       $self->wq_set_recv_modes(qw[+<&= >&= >&= +<&= >&=]);
+       $self->SUPER::ipc_atfork_prepare; # PublicInbox::IPC
 }
 
-sub lock_free {
-       $_[0]->{base_type} =~ /\A(?:maildir|mh|imap|jmap)\z/ ? 1 : 0;
+sub DESTROY {
+       my ($self) = @_;
+       for my $pid_git (grep(/\A$$\0/, keys %$self)) {
+               $self->{$pid_git}->async_wait_all;
+       }
+       $self->SUPER::DESTROY; # PublicInbox::IPC
 }
 
 1;