]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/Import.pm
imap+nntp: share COMPRESS implementation
[public-inbox.git] / lib / PublicInbox / Import.pm
index 07a4951871375674b442c1a0c5bd7710013e608f..60ce7b66419b3ee0e9ad2dca4b93644497539378 100644 (file)
@@ -1,4 +1,4 @@
-# Copyright (C) 2016-2020 all contributors <meta@public-inbox.org>
+# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 #
 # git fast-import-based ssoma-mda MDA replacement
@@ -9,7 +9,7 @@ package PublicInbox::Import;
 use strict;
 use parent qw(PublicInbox::Lock);
 use v5.10.1;
-use PublicInbox::Spawn qw(spawn popen_rd);
+use PublicInbox::Spawn qw(run_die popen_rd);
 use PublicInbox::MID qw(mids mid2path);
 use PublicInbox::Address;
 use PublicInbox::Smsg;
@@ -19,13 +19,23 @@ use PublicInbox::MDA;
 use PublicInbox::Eml;
 use POSIX qw(strftime);
 
+sub default_branch () {
+       state $default_branch = do {
+               my $r = popen_rd([qw(git config --global init.defaultBranch)],
+                                { GIT_CONFIG => undef });
+               chomp(my $h = <$r> // '');
+               close $r;
+               $h eq '' ? 'refs/heads/master' : "refs/heads/$h";
+       }
+}
+
 sub new {
        # we can't change arg order, this is documented in POD
        # and external projects may rely on it:
        my ($class, $git, $name, $email, $ibx) = @_;
-       my $ref = 'refs/heads/master';
+       my $ref;
        if ($ibx) {
-               $ref = $ibx->{ref_head} // 'refs/heads/master';
+               $ref = $ibx->{ref_head};
                $name //= $ibx->{name};
                $email //= $ibx->{-primary_address};
                $git //= $ibx->git;
@@ -34,7 +44,7 @@ sub new {
                git => $git,
                ident => "$name <$email>",
                mark => 1,
-               ref => $ref,
+               ref => $ref // default_branch,
                ibx => $ibx,
                path_type => '2/38', # or 'v2'
                lock_path => "$git->{git_dir}/ssoma.lock", # v2 changes this
@@ -46,9 +56,9 @@ sub new {
 sub gfi_start {
        my ($self) = @_;
 
-       return ($self->{in}, $self->{out}) if $self->{pid};
+       return ($self->{in}, $self->{out}) if $self->{in};
 
-       my (@ret, $out_r, $out_w);
+       my ($in_r, $out_r, $out_w);
        pipe($out_r, $out_w) or die "pipe failed: $!";
 
        $self->lock_acquire;
@@ -56,27 +66,24 @@ sub gfi_start {
                my ($git, $ref) = @$self{qw(git ref)};
                local $/ = "\n";
                chomp($self->{tip} = $git->qx(qw(rev-parse --revs-only), $ref));
+               die "fatal: rev-parse --revs-only $ref: \$?=$?" if $?;
                if ($self->{path_type} ne '2/38' && $self->{tip}) {
-                       local $/ = "\0";
-                       my @t = $git->qx(qw(ls-tree -r -z --name-only), $ref);
-                       chomp @t;
-                       $self->{-tree} = { map { $_ => 1 } @t };
+                       my $t = $git->qx(qw(ls-tree -r -z --name-only), $ref);
+                       die "fatal: ls-tree -r -z --name-only $ref: \$?=$?" if $?;
+                       $self->{-tree} = { map { $_ => 1 } split(/\0/, $t) };
                }
-               my @cmd = ('git', "--git-dir=$git->{git_dir}",
-                       qw(fast-import --quiet --done --date-format=raw));
-               my ($in_r, $pid) = popen_rd(\@cmd, undef, { 0 => $out_r });
+               $in_r = $self->{in} = $git->popen(qw(fast-import
+                                       --quiet --done --date-format=raw),
+                                       undef, { 0 => $out_r });
                $out_w->autoflush(1);
-               $self->{in} = $in_r;
                $self->{out} = $out_w;
-               $self->{pid} = $pid;
                $self->{nchg} = 0;
-               @ret = ($in_r, $out_w);
        };
        if ($@) {
                $self->lock_release;
                die $@;
        }
-       @ret;
+       ($in_r, $out_w);
 }
 
 sub wfail () { die "write to fast-import failed: $!" }
@@ -106,7 +113,7 @@ sub _cat_blob ($$$) {
        local $/ = "\n";
        my $info = <$r>;
        defined $info or die "EOF from fast-import / cat-blob: $!";
-       $info =~ /\A[a-f0-9]{40} blob ([0-9]+)\n\z/ or return;
+       $info =~ /\A[a-f0-9]{40,} blob ([0-9]+)\n\z/ or return;
        my $left = $1;
        my $offset = 0;
        my $buf = '';
@@ -137,7 +144,7 @@ sub check_remove_v1 {
        my ($r, $w, $tip, $path, $mime) = @_;
 
        my $info = _check_path($r, $w, $tip, $path) or return ('MISSING',undef);
-       $info =~ m!\A100644 blob ([a-f0-9]{40})\t!s or die "not blob: $info";
+       $info =~ m!\A100644 blob ([a-f0-9]{40,})\t!s or die "not blob: $info";
        my $oid = $1;
        my $msg = _cat_blob($r, $w, $oid) or die "BUG: cat-blob $1 failed";
        my $cur = PublicInbox::Eml->new($msg);
@@ -153,14 +160,14 @@ sub check_remove_v1 {
 
 sub checkpoint {
        my ($self) = @_;
-       return unless $self->{pid};
+       return unless $self->{in};
        print { $self->{out} } "checkpoint\n" or wfail;
        undef;
 }
 
 sub progress {
        my ($self, $msg) = @_;
-       return unless $self->{pid};
+       return unless $self->{in};
        print { $self->{out} } "progress $msg\n" or wfail;
        readline($self->{in}) eq "progress $msg\n" or die
                "progress $msg not received\n";
@@ -209,7 +216,7 @@ sub barrier {
 # used for v2
 sub get_mark {
        my ($self, $mark) = @_;
-       die "not active\n" unless $self->{pid};
+       die "not active\n" unless $self->{in};
        my ($r, $w) = $self->gfi_start;
        print $w "get-mark $mark\n" or wfail;
        defined(my $oid = <$r>) or die "get-mark failed, need git 2.6.0+\n";
@@ -285,15 +292,14 @@ sub extract_cmt_info ($;$) {
        # $mime is PublicInbox::Eml, but remains Email::MIME-compatible
        $smsg //= bless {}, 'PublicInbox::Smsg';
 
-       my $hdr = $mime->header_obj;
-       $smsg->populate($hdr);
+       $smsg->populate($mime);
 
        my $sender = '';
        my $from = delete($smsg->{From}) // '';
        my ($email) = PublicInbox::Address::emails($from);
        my ($name) = PublicInbox::Address::names($from);
        if (!defined($name) || !defined($email)) {
-               $sender = $hdr->header('Sender') // '';
+               $sender = $mime->header('Sender') // '';
                $name //= (PublicInbox::Address::names($sender))[0];
                $email //= (PublicInbox::Address::emails($sender))[0];
        }
@@ -329,11 +335,13 @@ sub extract_cmt_info ($;$) {
 }
 
 # kill potentially confusing/misleading headers
+our @UNWANTED_HEADERS = (qw(Bytes Lines Content-Length),
+                       qw(Status X-Status));
 sub drop_unwanted_headers ($) {
-       my ($mime) = @_;
-
-       $mime->header_set($_) for qw(Bytes Lines Content-Length Status);
-       $mime->header_set($_) for @PublicInbox::MDA::BAD_HEADERS;
+       my ($eml) = @_;
+       for (@UNWANTED_HEADERS, @PublicInbox::MDA::BAD_HEADERS) {
+               $eml->header_set($_);
+       }
 }
 
 # used by V2Writable, too
@@ -346,13 +354,12 @@ sub append_mid ($$) {
 }
 
 sub v1_mid0 ($) {
-       my ($mime) = @_;
-       my $hdr = $mime->header_obj;
-       my $mids = mids($hdr);
+       my ($eml) = @_;
+       my $mids = mids($eml);
 
        if (!scalar(@$mids)) { # spam often has no Message-ID
-               my $mid0 = digest2mid(content_digest($mime), $hdr);
-               append_mid($hdr, $mid0);
+               my $mid0 = digest2mid(content_digest($eml), $eml);
+               append_mid($eml, $mid0);
                return $mid0;
        }
        $mids->[0];
@@ -404,8 +411,22 @@ sub add {
        # v2: we need this for Xapian
        if ($smsg) {
                $smsg->{blob} = $self->get_mark(":$blob");
-               $smsg->{raw_bytes} = $n;
-               $smsg->{-raw_email} = \$raw_email;
+               $smsg->set_bytes($raw_email, $n);
+               if (my $oidx = delete $smsg->{-oidx}) { # used by LeiStore
+                       my $eidx_git = delete $smsg->{-eidx_git};
+
+                       # we need this sharedkv to dedupe blobs added in the
+                       # same fast-import transaction
+                       my $u = $self->{uniq_skv} //= do {
+                               require PublicInbox::SharedKV;
+                               my $x = PublicInbox::SharedKV->new;
+                               $x->dbh;
+                               $x;
+                       };
+                       return if !$u->set_maybe($smsg->oidbin, 1);
+                       return if (!$oidx->vivify_xvmd($smsg) &&
+                                       $eidx_git->check($smsg->{blob}));
+               }
        }
        my $ref = $self->{ref};
        my $commit = $self->{mark}++;
@@ -429,17 +450,7 @@ sub add {
        $self->{tip} = ":$commit";
 }
 
-sub run_die ($;$$) {
-       my ($cmd, $env, $rdr) = @_;
-       my $pid = spawn($cmd, $env, $rdr);
-       waitpid($pid, 0) == $pid or die join(' ', @$cmd) .' did not finish';
-       $? == 0 or die join(' ', @$cmd) . " failed: $?\n";
-}
-
-my @INIT_FILES = ('HEAD' => "ref: refs/heads/master\n",
-               'description' => <<EOD,
-Unnamed repository; edit this file 'description' to name the repository.
-EOD
+my @INIT_FILES = ('HEAD' => undef, # filled in at runtime
                'config' => <<EOC);
 [core]
        repositoryFormatVersion = 0
@@ -450,29 +461,32 @@ EOD
 EOC
 
 sub init_bare {
-       my ($dir) = @_; # or self
+       my ($dir, $head) = @_; # or self
        $dir = $dir->{git}->{git_dir} if ref($dir);
        require File::Path;
        File::Path::mkpath([ map { "$dir/$_" } qw(objects/info refs/heads) ]);
-       for (my $i = 0; $i < @INIT_FILES; $i++) {
-               my $f = $dir.'/'.$INIT_FILES[$i++];
+       $INIT_FILES[1] //= 'ref: '.default_branch."\n";
+       my @fn_contents = @INIT_FILES;
+       $fn_contents[1] = "ref: refs/heads/$head\n" if defined $head;
+       while (my ($fn, $contents) = splice(@fn_contents, 0, 2)) {
+               my $f = $dir.'/'.$fn;
                next if -f $f;
                open my $fh, '>', $f or die "open $f: $!";
-               print $fh $INIT_FILES[$i] or die "print $f: $!";
+               print $fh $contents or die "print $f: $!";
                close $fh or die "close $f: $!";
        }
 }
 
+# true if locked and active
+sub active { !!$_[0]->{out} }
+
 sub done {
        my ($self) = @_;
        my $w = delete $self->{out} or return;
        eval {
                my $r = delete $self->{in} or die 'BUG: missing {in} when done';
                print $w "done\n" or wfail;
-               my $pid = delete $self->{pid} or
-                               die 'BUG: missing {pid} when done';
-               waitpid($pid, 0) == $pid or die 'fast-import did not finish';
-               $? == 0 or die "fast-import failed: $?";
+               close $r or die "fast-import failed: $?"; # ProcessPipe::CLOSE
        };
        my $wait_err = $@;
        my $nchg = delete $self->{nchg};
@@ -493,8 +507,8 @@ sub atfork_child {
        }
 }
 
-sub digest2mid ($$) {
-       my ($dig, $hdr) = @_;
+sub digest2mid ($$;$) {
+       my ($dig, $hdr, $fallback_time) = @_;
        my $b64 = $dig->clone->b64digest;
        # Make our own URLs nicer:
        # See "Base 64 Encoding with URL and Filename Safe Alphabet" in RFC4648
@@ -503,7 +517,7 @@ sub digest2mid ($$) {
        # Add a date prefix to prevent a leading '-' in case that trips
        # up some tools (e.g. if a Message-ID were a expected as a
        # command-line arg)
-       my $dt = msg_datestamp($hdr);
+       my $dt = msg_datestamp($hdr, $fallback_time);
        $dt = POSIX::strftime('%Y%m%d%H%M%S', gmtime($dt));
        "$dt.$b64" . '@z';
 }
@@ -671,8 +685,7 @@ version 1.0
        my $parsed = PublicInbox::Eml->new($message);
        my $ret = $im->add($parsed);
        if (!defined $ret) {
-               warn "duplicate: ",
-                       $parsed->header_obj->header_raw('Message-ID'), "\n";
+               warn "duplicate: ", $parsed->header_raw('Message-ID'), "\n";
        } else {
                print "imported at mark $ret\n";
        }