use PublicInbox::ProcessPipe;
use PublicInbox::Spawn qw(which spawn popen_rd);
use PublicInbox::LeiDedupe;
+use PublicInbox::OnDestroy;
+use PublicInbox::Git;
+use PublicInbox::GitAsyncCat;
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;
+
+# struggles with short-lived repos, Gcf2Client makes little sense with lei;
+# but we may use in-process libgit2 in the future.
+$PublicInbox::GitAsyncCat::GCF2C = 0;
my %kw2char = ( # Maildir characters
draft => 'D',
);
sub _mbox_hdr_buf ($$$) {
- my ($eml, $type, $kw) = @_;
+ my ($eml, $type, $smsg) = @_;
$eml->header_set($_) for (qw(Lines Bytes Content-Length));
# 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 (@$kw) {
+ for my $k (@{$smsg->{kw} // []}) {
if (my $ent = $kw2status{$k}) {
push @{$hdr{$ent->[0]}}, $ent->[1];
} else { # X-Label?
# 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;
}
}
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};
}
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};
# 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;
# 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}) {
_mboxcl_common($buf, $bdy, $crlf);
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
sub dup_src ($) {
my ($in) = @_;
- # fileno needed because wq_set_recv_modes only used ">&=" for {1}
- # and Perl blindly trusts that to reject the '+' (readability flag)
- open my $dup, '+>>&=', fileno($in) or die "dup: $!";
+ open my $dup, '+>>&', $in or die "dup: $!";
$dup;
}
my $dedupe = $lei->{dedupe};
$dedupe->prepare_dedupe;
sub { # for git_to_mail
- my ($buf, $oid, $kw) = @_;
+ my ($buf, $smsg, $eml) = @_;
return unless $out;
- my $eml = PublicInbox::Eml->new($buf);
- if (!$dedupe->is_dup($eml, $oid)) {
- $buf = $eml2mbox->($eml, $kw);
+ $eml //= PublicInbox::Eml->new($buf);
+ if (!$dedupe->is_dup($eml, $smsg->{blob})) {
+ $buf = $eml2mbox->($eml, $smsg);
my $lk = $ovv->lock_for_scope;
eval { $write->($out, $buf) };
if ($@) {
# _maildir_each_file callback, \&CORE::unlink doesn't work with it
sub _unlink { unlink($_[0]) }
+sub _rand () {
+ state $seq = 0;
+ sprintf('%x,%x,%x,%x', rand(0xffffffff), time, $$, ++$seq);
+}
+
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} // _rand;
+ 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).','));
+ $! == EEXIST && ($rand = _rand.','));
if (print $fh $$buf and close($fh)) {
# ignore new/ and write only to cur/, otherwise MUAs
# with R/W access to the Maildir will end up doing
$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).','));
+ ($rand = _rand.','));
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";
}
}
sub _maildir_write_cb ($$) {
my ($self, $lei) = @_;
my $dedupe = $lei->{dedupe};
- $dedupe->prepare_dedupe;
+ $dedupe->prepare_dedupe if $dedupe;
my $dst = $lei->{ovv}->{dst};
sub { # for git_to_mail
- my ($buf, $oid, $kw) = @_;
- return _buf2maildir($dst, $buf, $oid, $kw) if !$dedupe;
- my $eml = PublicInbox::Eml->new($$buf); # copy buf
- return if $dedupe->is_dup($eml, $oid);
+ my ($buf, $smsg, $eml) = @_;
+ $buf //= \($eml->as_string);
+ 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, $oid, $kw);
+ _buf2maildir($dst, $buf, $smsg);
}
}
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 {
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";
}
}
$! == ENOENT or die "unlink($dst): $!";
}
open my $out, $mode, $dst or die "open($dst): $!";
+ $lei->{old_1} = $lei->{1};
$lei->{1} = $out;
}
# Perl does SEEK_END even with O_APPEND :<
}
sub write_mail { # via ->wq_do
- my ($self, $git_dir, $oid, $lei, $kw) = @_;
- my $not_done = delete $self->{4}; # write end of {each_smsg_done}
+ my ($self, $git_dir, $smsg, $lei) = @_;
+ my $not_done = delete $self->{$lei->{each_smsg_not_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($oid, \&git_to_mail, [ $wcb, $kw, $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
+ git_async_cat($git, $smsg->{blob}, \&git_to_mail,
+ [$wcb, $smsg, $not_done]);
}
-sub DESTROY {
+sub wq_atexit_child {
my ($self) = @_;
- for my $pid_git (grep(/\A$$\0/, keys %$self)) {
- $self->{$pid_git}->async_wait_all;
+ delete $self->{wcb};
+ for my $git (delete @$self{grep(/\A$$\0/, keys %$self)}) {
+ $git->async_wait_all;
}
+ $SIG{__WARN__} = 'DEFAULT';
+ $SIG{PIPE} = 'DEFAULT';
}
1;