lib/PublicInbox/Import.pm

   1 # Copyright (C) 2016-2021 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3 #
   4 # git fast-import-based ssoma-mda MDA replacement
   5 # This is only ever run by public-inbox-mda, public-inbox-learn
   6 # and public-inbox-watch. Not the WWW or NNTP code which only
   7 # requires read-only access.
   8 package PublicInbox::Import;
   9 use strict;
  10 use parent qw(PublicInbox::Lock);
  11 use v5.10.1;
  12 use PublicInbox::Spawn qw(run_die popen_rd);
  13 use PublicInbox::MID qw(mids mid2path);
  14 use PublicInbox::Address;
  15 use PublicInbox::Smsg;
  16 use PublicInbox::MsgTime qw(msg_datestamp);
  17 use PublicInbox::ContentHash qw(content_digest);
  18 use PublicInbox::MDA;
  19 use PublicInbox::Eml;
  20 use POSIX qw(strftime);
  21
  22 sub default_branch () {
  23         state $default_branch = do {
  24                 delete local $ENV{GIT_CONFIG};
  25                 my $r = popen_rd([qw(git config --global init.defaultBranch)]);
  26                 chomp(my $h = <$r> // '');
  27                 $h eq '' ? 'refs/heads/master' : $h;
  28         }
  29 }
  30
  31 sub new {
  32         # we can't change arg order, this is documented in POD
  33         # and external projects may rely on it:
  34         my ($class, $git, $name, $email, $ibx) = @_;
  35         my $ref;
  36         if ($ibx) {
  37                 $ref = $ibx->{ref_head};
  38                 $name //= $ibx->{name};
  39                 $email //= $ibx->{-primary_address};
  40                 $git //= $ibx->git;
  41         }
  42         bless {
  43                 git => $git,
  44                 ident => "$name <$email>",
  45                 mark => 1,
  46                 ref => $ref // default_branch,
  47                 ibx => $ibx,
  48                 path_type => '2/38', # or 'v2'
  49                 lock_path => "$git->{git_dir}/ssoma.lock", # v2 changes this
  50                 bytes_added => 0,
  51         }, $class
  52 }
  53
  54 # idempotent start function
  55 sub gfi_start {
  56         my ($self) = @_;
  57
  58         return ($self->{in}, $self->{out}) if $self->{pid};
  59
  60         my ($in_r, $pid, $out_r, $out_w);
  61         pipe($out_r, $out_w) or die "pipe failed: $!";
  62
  63         $self->lock_acquire;
  64         eval {
  65                 my ($git, $ref) = @$self{qw(git ref)};
  66                 local $/ = "\n";
  67                 chomp($self->{tip} = $git->qx(qw(rev-parse --revs-only), $ref));
  68                 die "fatal: rev-parse --revs-only $ref: \$?=$?" if $?;
  69                 if ($self->{path_type} ne '2/38' && $self->{tip}) {
  70                         local $/ = "\0";
  71                         my @t = $git->qx(qw(ls-tree -r -z --name-only), $ref);
  72                         die "fatal: ls-tree -r -z --name-only $ref: \$?=$?" if $?;
  73                         chomp @t;
  74                         $self->{-tree} = { map { $_ => 1 } @t };
  75                 }
  76                 my @cmd = ('git', "--git-dir=$git->{git_dir}",
  77                         qw(fast-import --quiet --done --date-format=raw));
  78                 ($in_r, $pid) = popen_rd(\@cmd, undef, { 0 => $out_r });
  79                 $out_w->autoflush(1);
  80                 $self->{in} = $in_r;
  81                 $self->{out} = $out_w;
  82                 $self->{pid} = $pid;
  83                 $self->{nchg} = 0;
  84         };
  85         if ($@) {
  86                 $self->lock_release;
  87                 die $@;
  88         }
  89         ($in_r, $out_w);
  90 }
  91
  92 sub wfail () { die "write to fast-import failed: $!" }
  93
  94 sub now_raw () { time . ' +0000' }
  95
  96 sub norm_body ($) {
  97         my ($mime) = @_;
  98         my $b = $mime->body_raw;
  99         $b =~ s/(\r?\n)+\z//s;
 100         $b
 101 }
 102
 103 # only used for v1 (ssoma) inboxes
 104 sub _check_path ($$$$) {
 105         my ($r, $w, $tip, $path) = @_;
 106         return if $tip eq '';
 107         print $w "ls $tip $path\n" or wfail;
 108         local $/ = "\n";
 109         defined(my $info = <$r>) or die "EOF from fast-import: $!";
 110         $info =~ /\Amissing / ? undef : $info;
 111 }
 112
 113 sub _cat_blob ($$$) {
 114         my ($r, $w, $oid) = @_;
 115         print $w "cat-blob $oid\n" or wfail;
 116         local $/ = "\n";
 117         my $info = <$r>;
 118         defined $info or die "EOF from fast-import / cat-blob: $!";
 119         $info =~ /\A[a-f0-9]{40,} blob ([0-9]+)\n\z/ or return;
 120         my $left = $1;
 121         my $offset = 0;
 122         my $buf = '';
 123         my $n;
 124         while ($left > 0) {
 125                 $n = read($r, $buf, $left, $offset);
 126                 defined($n) or die "read cat-blob failed: $!";
 127                 $n == 0 and die 'fast-export (cat-blob) died';
 128                 $left -= $n;
 129                 $offset += $n;
 130         }
 131         $n = read($r, my $lf, 1);
 132         defined($n) or die "read final byte of cat-blob failed: $!";
 133         die "bad read on final byte: <$lf>" if $lf ne "\n";
 134
 135         # fixup some bugginess in old versions:
 136         $buf =~ s/\A[\r\n]*From [^\r\n]*\r?\n//s;
 137         \$buf;
 138 }
 139
 140 sub cat_blob {
 141         my ($self, $oid) = @_;
 142         my ($r, $w) = $self->gfi_start;
 143         _cat_blob($r, $w, $oid);
 144 }
 145
 146 sub check_remove_v1 {
 147         my ($r, $w, $tip, $path, $mime) = @_;
 148
 149         my $info = _check_path($r, $w, $tip, $path) or return ('MISSING',undef);
 150         $info =~ m!\A100644 blob ([a-f0-9]{40,})\t!s or die "not blob: $info";
 151         my $oid = $1;
 152         my $msg = _cat_blob($r, $w, $oid) or die "BUG: cat-blob $1 failed";
 153         my $cur = PublicInbox::Eml->new($msg);
 154         my $cur_s = $cur->header('Subject');
 155         $cur_s = '' unless defined $cur_s;
 156         my $cur_m = $mime->header('Subject');
 157         $cur_m = '' unless defined $cur_m;
 158         if ($cur_s ne $cur_m || norm_body($cur) ne norm_body($mime)) {
 159                 return ('MISMATCH', $cur);
 160         }
 161         (undef, $cur);
 162 }
 163
 164 sub checkpoint {
 165         my ($self) = @_;
 166         return unless $self->{pid};
 167         print { $self->{out} } "checkpoint\n" or wfail;
 168         undef;
 169 }
 170
 171 sub progress {
 172         my ($self, $msg) = @_;
 173         return unless $self->{pid};
 174         print { $self->{out} } "progress $msg\n" or wfail;
 175         readline($self->{in}) eq "progress $msg\n" or die
 176                 "progress $msg not received\n";
 177         undef;
 178 }
 179
 180 sub _update_git_info ($$) {
 181         my ($self, $do_gc) = @_;
 182         # for compatibility with existing ssoma installations
 183         # we can probably remove this entirely by 2020
 184         my $git_dir = $self->{git}->{git_dir};
 185         my @cmd = ('git', "--git-dir=$git_dir");
 186         my $index = "$git_dir/ssoma.index";
 187         if (-e $index && !$ENV{FAST}) {
 188                 my $env = { GIT_INDEX_FILE => $index };
 189                 run_die([@cmd, qw(read-tree -m -v -i), $self->{ref}], $env);
 190         }
 191         eval { run_die([@cmd, 'update-server-info']) };
 192         my $ibx = $self->{ibx};
 193         if ($ibx && $ibx->version == 1 && -d "$ibx->{inboxdir}/public-inbox" &&
 194                                 eval { require PublicInbox::SearchIdx }) {
 195                 eval {
 196                         my $s = PublicInbox::SearchIdx->new($ibx);
 197                         $s->index_sync({ ref => $self->{ref} });
 198                 };
 199                 warn "$ibx->{inboxdir} index failed: $@\n" if $@;
 200         }
 201         eval { run_die([@cmd, qw(gc --auto)]) } if $do_gc;
 202 }
 203
 204 sub barrier {
 205         my ($self) = @_;
 206
 207         # For safety, we ensure git checkpoint is complete before because
 208         # the data in git is still more important than what is in Xapian
 209         # in v2.  Performance may be gained by delaying the ->progress
 210         # call but we lose safety
 211         if ($self->{nchg}) {
 212                 $self->checkpoint;
 213                 $self->progress('checkpoint');
 214                 _update_git_info($self, 0);
 215                 $self->{nchg} = 0;
 216         }
 217 }
 218
 219 # used for v2
 220 sub get_mark {
 221         my ($self, $mark) = @_;
 222         die "not active\n" unless $self->{pid};
 223         my ($r, $w) = $self->gfi_start;
 224         print $w "get-mark $mark\n" or wfail;
 225         defined(my $oid = <$r>) or die "get-mark failed, need git 2.6.0+\n";
 226         chomp($oid);
 227         $oid;
 228 }
 229
 230 # returns undef on non-existent
 231 # ('MISMATCH', PublicInbox::Eml) on mismatch
 232 # (:MARK, PublicInbox::Eml) on success
 233 #
 234 # v2 callers should check with Xapian before calling this as
 235 # it is not idempotent.
 236 sub remove {
 237         my ($self, $mime, $msg) = @_; # mime = PublicInbox::Eml or Email::MIME
 238
 239         my $path_type = $self->{path_type};
 240         my ($path, $err, $cur, $blob);
 241
 242         my ($r, $w) = $self->gfi_start;
 243         my $tip = $self->{tip};
 244         if ($path_type eq '2/38') {
 245                 $path = mid2path(v1_mid0($mime));
 246                 ($err, $cur) = check_remove_v1($r, $w, $tip, $path, $mime);
 247                 return ($err, $cur) if $err;
 248         } else {
 249                 my $sref;
 250                 if (ref($mime) eq 'SCALAR') { # optimization used by V2Writable
 251                         $sref = $mime;
 252                 } else { # XXX should not be necessary:
 253                         my $str = $mime->as_string;
 254                         $sref = \$str;
 255                 }
 256                 my $len = length($$sref);
 257                 $blob = $self->{mark}++;
 258                 print $w "blob\nmark :$blob\ndata $len\n",
 259                         $$sref, "\n" or wfail;
 260         }
 261
 262         my $ref = $self->{ref};
 263         my $commit = $self->{mark}++;
 264         my $parent = $tip =~ /\A:/ ? $tip : undef;
 265         unless ($parent) {
 266                 print $w "reset $ref\n" or wfail;
 267         }
 268         my $ident = $self->{ident};
 269         my $now = now_raw();
 270         $msg //= 'rm';
 271         my $len = length($msg) + 1;
 272         print $w "commit $ref\nmark :$commit\n",
 273                 "author $ident $now\n",
 274                 "committer $ident $now\n",
 275                 "data $len\n$msg\n\n",
 276                 'from ', ($parent ? $parent : $tip), "\n" or wfail;
 277         if (defined $path) {
 278                 print $w "D $path\n\n" or wfail;
 279         } else {
 280                 clean_tree_v2($self, $w, 'd');
 281                 print $w "M 100644 :$blob d\n\n" or wfail;
 282         }
 283         $self->{nchg}++;
 284         (($self->{tip} = ":$commit"), $cur);
 285 }
 286
 287 sub git_timestamp ($) {
 288         my ($ts, $zone) = @{$_[0]};
 289         $ts = 0 if $ts < 0; # git uses unsigned times
 290         "$ts $zone";
 291 }
 292
 293 sub extract_cmt_info ($;$) {
 294         my ($mime, $smsg) = @_;
 295         # $mime is PublicInbox::Eml, but remains Email::MIME-compatible
 296         $smsg //= bless {}, 'PublicInbox::Smsg';
 297
 298         $smsg->populate($mime);
 299
 300         my $sender = '';
 301         my $from = delete($smsg->{From}) // '';
 302         my ($email) = PublicInbox::Address::emails($from);
 303         my ($name) = PublicInbox::Address::names($from);
 304         if (!defined($name) || !defined($email)) {
 305                 $sender = $mime->header('Sender') // '';
 306                 $name //= (PublicInbox::Address::names($sender))[0];
 307                 $email //= (PublicInbox::Address::emails($sender))[0];
 308         }
 309         if (defined $email) {
 310                 # Email::Address::XS may leave quoted '<' in addresses,
 311                 # which git-fast-import doesn't like
 312                 $email =~ tr/<>//d;
 313
 314                 # quiet down wide character warnings with utf8::encode
 315                 utf8::encode($email);
 316         } else {
 317                 $email = '';
 318                 warn "no email in From: $from or Sender: $sender\n";
 319         }
 320
 321         # git gets confused with:
 322         #  "'A U Thor <u@example.com>' via foo" <foo@example.com>
 323         # ref:
 324         # <CAD0k6qSUYANxbjjbE4jTW4EeVwOYgBD=bXkSu=akiYC_CB7Ffw@mail.gmail.com>
 325         if (defined $name) {
 326                 $name =~ tr/<>//d;
 327                 utf8::encode($name);
 328         } else {
 329                 $name = '';
 330                 warn "no name in From: $from or Sender: $sender\n";
 331         }
 332
 333         my $subject = delete($smsg->{Subject}) // '(no subject)';
 334         utf8::encode($subject);
 335         my $at = git_timestamp(delete $smsg->{-ds});
 336         my $ct = git_timestamp(delete $smsg->{-ts});
 337         ("$name <$email>", $at, $ct, $subject);
 338 }
 339
 340 # kill potentially confusing/misleading headers
 341 our @UNWANTED_HEADERS = (qw(Bytes Lines Content-Length),
 342                         qw(Status X-Status));
 343 sub drop_unwanted_headers ($) {
 344         my ($eml) = @_;
 345         for (@UNWANTED_HEADERS, @PublicInbox::MDA::BAD_HEADERS) {
 346                 $eml->header_set($_);
 347         }
 348 }
 349
 350 # used by V2Writable, too
 351 sub append_mid ($$) {
 352         my ($hdr, $mid0) = @_;
 353         # @cur is likely empty if we need to call this sub, but it could
 354         # have random unparseable crap which we'll preserve, too.
 355         my @cur = $hdr->header_raw('Message-ID');
 356         $hdr->header_set('Message-ID', @cur, "<$mid0>");
 357 }
 358
 359 sub v1_mid0 ($) {
 360         my ($eml) = @_;
 361         my $mids = mids($eml);
 362
 363         if (!scalar(@$mids)) { # spam often has no Message-ID
 364                 my $mid0 = digest2mid(content_digest($eml), $eml);
 365                 append_mid($eml, $mid0);
 366                 return $mid0;
 367         }
 368         $mids->[0];
 369 }
 370 sub clean_tree_v2 ($$$) {
 371         my ($self, $w, $keep) = @_;
 372         my $tree = $self->{-tree} or return; #v2 only
 373         delete $tree->{$keep};
 374         foreach (keys %$tree) {
 375                 print $w "D $_\n" or wfail;
 376         }
 377         %$tree = ($keep => 1);
 378 }
 379
 380 # returns undef on duplicate
 381 # returns the :MARK of the most recent commit
 382 sub add {
 383         my ($self, $mime, $check_cb, $smsg) = @_;
 384
 385         my ($author, $at, $ct, $subject) = extract_cmt_info($mime, $smsg);
 386         my $path_type = $self->{path_type};
 387         my $path;
 388         if ($path_type eq '2/38') {
 389                 $path = mid2path(v1_mid0($mime));
 390         } else { # v2 layout, one file:
 391                 $path = 'm';
 392         }
 393
 394         my ($r, $w) = $self->gfi_start;
 395         my $tip = $self->{tip};
 396         if ($path_type eq '2/38') {
 397                 _check_path($r, $w, $tip, $path) and return;
 398         }
 399
 400         drop_unwanted_headers($mime);
 401
 402         # spam check:
 403         if ($check_cb) {
 404                 $mime = $check_cb->($mime, $self->{ibx}) or return;
 405         }
 406
 407         my $blob = $self->{mark}++;
 408         my $raw_email = $mime->{-public_inbox_raw} // $mime->as_string;
 409         my $n = length($raw_email);
 410         $self->{bytes_added} += $n;
 411         print $w "blob\nmark :$blob\ndata ", $n, "\n" or wfail;
 412         print $w $raw_email, "\n" or wfail;
 413
 414         # v2: we need this for Xapian
 415         if ($smsg) {
 416                 $smsg->{blob} = $self->get_mark(":$blob");
 417                 $smsg->{raw_bytes} = $n;
 418                 if (my $oidx = delete $smsg->{-oidx}) { # used by LeiStore
 419                         return if $oidx->blob_exists($smsg->{blob});
 420                 }
 421                 # XXX do we need this? it's in git at this point
 422                 $smsg->{-raw_email} = \$raw_email;
 423         }
 424         my $ref = $self->{ref};
 425         my $commit = $self->{mark}++;
 426         my $parent = $tip =~ /\A:/ ? $tip : undef;
 427
 428         unless ($parent) {
 429                 print $w "reset $ref\n" or wfail;
 430         }
 431
 432         print $w "commit $ref\nmark :$commit\n",
 433                 "author $author $at\n",
 434                 "committer $self->{ident} $ct\n" or wfail;
 435         print $w "data ", (length($subject) + 1), "\n",
 436                 $subject, "\n\n" or wfail;
 437         if ($tip ne '') {
 438                 print $w 'from ', ($parent ? $parent : $tip), "\n" or wfail;
 439         }
 440         clean_tree_v2($self, $w, $path);
 441         print $w "M 100644 :$blob $path\n\n" or wfail;
 442         $self->{nchg}++;
 443         $self->{tip} = ":$commit";
 444 }
 445
 446 my @INIT_FILES = ('HEAD' => undef, # filled in at runtime
 447                 'description' => <<EOD,
 448 Unnamed repository; edit this file 'description' to name the repository.
 449 EOD
 450                 'config' => <<EOC);
 451 [core]
 452         repositoryFormatVersion = 0
 453         filemode = true
 454         bare = true
 455 [repack]
 456         writeBitmaps = true
 457 EOC
 458
 459 sub init_bare {
 460         my ($dir, $head) = @_; # or self
 461         $dir = $dir->{git}->{git_dir} if ref($dir);
 462         require File::Path;
 463         File::Path::mkpath([ map { "$dir/$_" } qw(objects/info refs/heads) ]);
 464         $INIT_FILES[1] //= 'ref: '.default_branch."\n";
 465         my @fn_contents = @INIT_FILES;
 466         $fn_contents[1] = "ref: refs/heads/$head\n" if defined $head;
 467         while (my ($fn, $contents) = splice(@fn_contents, 0, 2)) {
 468                 my $f = $dir.'/'.$fn;
 469                 next if -f $f;
 470                 open my $fh, '>', $f or die "open $f: $!";
 471                 print $fh $contents or die "print $f: $!";
 472                 close $fh or die "close $f: $!";
 473         }
 474 }
 475
 476 # true if locked and active
 477 sub active { !!$_[0]->{out} }
 478
 479 sub done {
 480         my ($self) = @_;
 481         my $w = delete $self->{out} or return;
 482         eval {
 483                 my $r = delete $self->{in} or die 'BUG: missing {in} when done';
 484                 print $w "done\n" or wfail;
 485                 my $pid = delete $self->{pid} or
 486                                 die 'BUG: missing {pid} when done';
 487                 waitpid($pid, 0) == $pid or die 'fast-import did not finish';
 488                 $? == 0 or die "fast-import failed: $?";
 489         };
 490         my $wait_err = $@;
 491         my $nchg = delete $self->{nchg};
 492         if ($nchg && !$wait_err) {
 493                 eval { _update_git_info($self, 1) };
 494                 warn "E: $self->{git}->{git_dir} update info: $@\n" if $@;
 495         }
 496         $self->lock_release(!!$nchg);
 497         $self->{git}->cleanup;
 498         die $wait_err if $wait_err;
 499 }
 500
 501 sub atfork_child {
 502         my ($self) = @_;
 503         foreach my $f (qw(in out)) {
 504                 next unless defined($self->{$f});
 505                 close $self->{$f} or die "failed to close import[$f]: $!\n";
 506         }
 507 }
 508
 509 sub digest2mid ($$) {
 510         my ($dig, $hdr) = @_;
 511         my $b64 = $dig->clone->b64digest;
 512         # Make our own URLs nicer:
 513         # See "Base 64 Encoding with URL and Filename Safe Alphabet" in RFC4648
 514         $b64 =~ tr!+/=!-_!d;
 515
 516         # Add a date prefix to prevent a leading '-' in case that trips
 517         # up some tools (e.g. if a Message-ID were a expected as a
 518         # command-line arg)
 519         my $dt = msg_datestamp($hdr);
 520         $dt = POSIX::strftime('%Y%m%d%H%M%S', gmtime($dt));
 521         "$dt.$b64" . '@z';
 522 }
 523
 524 sub rewrite_commit ($$$$) {
 525         my ($self, $oids, $buf, $mime) = @_;
 526         my ($author, $at, $ct, $subject);
 527         if ($mime) {
 528                 ($author, $at, $ct, $subject) = extract_cmt_info($mime);
 529         } else {
 530                 $author = '<>';
 531                 $subject = 'purged '.join(' ', @$oids);
 532         }
 533         @$oids = ();
 534         $subject .= "\n";
 535         foreach my $i (0..$#$buf) {
 536                 my $l = $buf->[$i];
 537                 if ($l =~ /^author .* ([0-9]+ [\+-]?[0-9]+)$/) {
 538                         $at //= $1;
 539                         $buf->[$i] = "author $author $at\n";
 540                 } elsif ($l =~ /^committer .* ([0-9]+ [\+-]?[0-9]+)$/) {
 541                         $ct //= $1;
 542                         $buf->[$i] = "committer $self->{ident} $ct\n";
 543                 } elsif ($l =~ /^data ([0-9]+)/) {
 544                         $buf->[$i++] = "data " . length($subject) . "\n";
 545                         $buf->[$i] = $subject;
 546                         last;
 547                 }
 548         }
 549 }
 550
 551 # returns the new commit OID if a replacement was done
 552 # returns undef if nothing was done
 553 sub replace_oids {
 554         my ($self, $mime, $replace_map) = @_; # oid => raw string
 555         my $tmp = "refs/heads/replace-".((keys %$replace_map)[0]);
 556         my $old = $self->{'ref'};
 557         my $git = $self->{git};
 558         my @export = (qw(fast-export --no-data --use-done-feature), $old);
 559         my $rd = $git->popen(@export);
 560         my ($r, $w) = $self->gfi_start;
 561         my @buf;
 562         my $nreplace = 0;
 563         my @oids;
 564         my ($done, $mark);
 565         my $tree = $self->{-tree};
 566         while (<$rd>) {
 567                 if (/^reset (?:.+)/) {
 568                         push @buf, "reset $tmp\n";
 569                 } elsif (/^commit (?:.+)/) {
 570                         if (@buf) {
 571                                 print $w @buf or wfail;
 572                                 @buf = ();
 573                         }
 574                         push @buf, "commit $tmp\n";
 575                 } elsif (/^data ([0-9]+)/) {
 576                         # only commit message, so $len is small:
 577                         my $len = $1; # + 1 for trailing "\n"
 578                         push @buf, $_;
 579                         my $n = read($rd, my $buf, $len) or die "read: $!";
 580                         $len == $n or die "short read ($n < $len)";
 581                         push @buf, $buf;
 582                 } elsif (/^M 100644 ([a-f0-9]+) (\w+)/) {
 583                         my ($oid, $path) = ($1, $2);
 584                         $tree->{$path} = 1;
 585                         my $sref = $replace_map->{$oid};
 586                         if (defined $sref) {
 587                                 push @oids, $oid;
 588                                 my $n = length($$sref);
 589                                 push @buf, "M 100644 inline $path\ndata $n\n";
 590                                 push @buf, $$sref; # hope CoW works...
 591                                 push @buf, "\n";
 592                         } else {
 593                                 push @buf, $_;
 594                         }
 595                 } elsif (/^D (\w+)/) {
 596                         my $path = $1;
 597                         push @buf, $_ if $tree->{$path};
 598                 } elsif ($_ eq "\n") {
 599                         if (@oids) {
 600                                 if (!$mime) {
 601                                         my $out = join('', @buf);
 602                                         $out =~ s/^/# /sgm;
 603                                         warn "purge rewriting\n", $out, "\n";
 604                                 }
 605                                 rewrite_commit($self, \@oids, \@buf, $mime);
 606                                 $nreplace++;
 607                         }
 608                         print $w @buf, "\n" or wfail;
 609                         @buf = ();
 610                 } elsif ($_ eq "done\n") {
 611                         $done = 1;
 612                 } elsif (/^mark :([0-9]+)$/) {
 613                         push @buf, $_;
 614                         $mark = $1;
 615                 } else {
 616                         push @buf, $_;
 617                 }
 618         }
 619         close $rd or die "close fast-export failed: $?";
 620         if (@buf) {
 621                 print $w @buf or wfail;
 622         }
 623         die 'done\n not seen from fast-export' unless $done;
 624         chomp(my $cmt = $self->get_mark(":$mark")) if $nreplace;
 625         $self->{nchg} = 0; # prevent _update_git_info until update-ref:
 626         $self->done;
 627         my @git = ('git', "--git-dir=$git->{git_dir}");
 628
 629         run_die([@git, qw(update-ref), $old, $tmp]) if $nreplace;
 630
 631         run_die([@git, qw(update-ref -d), $tmp]);
 632
 633         return if $nreplace == 0;
 634
 635         run_die([@git, qw(-c gc.reflogExpire=now gc --prune=all --quiet)]);
 636
 637         # check that old OIDs are gone
 638         my $err = 0;
 639         foreach my $oid (keys %$replace_map) {
 640                 my @info = $git->check($oid);
 641                 if (@info) {
 642                         warn "$oid not replaced\n";
 643                         $err++;
 644                 }
 645         }
 646         _update_git_info($self, 0);
 647         die "Failed to replace $err object(s)\n" if $err;
 648         $cmt;
 649 }
 650
 651 1;
 652 __END__
 653 =pod
 654
 655 =head1 NAME
 656
 657 PublicInbox::Import - message importer for public-inbox v1 inboxes
 658
 659 =head1 VERSION
 660
 661 version 1.0
 662
 663 =head1 SYNOPSIS
 664
 665         use PublicInbox::Eml;
 666         # PublicInbox::Eml exists as of public-inbox 1.5.0,
 667         # Email::MIME was used in older versions
 668
 669         use PublicInbox::Git;
 670         use PublicInbox::Import;
 671
 672         chomp(my $git_dir = `git rev-parse --git-dir`);
 673         $git_dir or die "GIT_DIR= must be specified\n";
 674         my $git = PublicInbox::Git->new($git_dir);
 675         my @committer = ('inbox', 'inbox@example.org');
 676         my $im = PublicInbox::Import->new($git, @committer);
 677
 678         # to add a message:
 679         my $message = "From: <u\@example.org>\n".
 680                 "Subject: test message \n" .
 681                 "Date: Thu, 01 Jan 1970 00:00:00 +0000\n" .
 682                 "Message-ID: <m\@example.org>\n".
 683                 "\ntest message";
 684         my $parsed = PublicInbox::Eml->new($message);
 685         my $ret = $im->add($parsed);
 686         if (!defined $ret) {
 687                 warn "duplicate: ", $parsed->header_raw('Message-ID'), "\n";
 688         } else {
 689                 print "imported at mark $ret\n";
 690         }
 691         $im->done;
 692
 693         # to remove a message
 694         my $junk = PublicInbox::Eml->new($message);
 695         my ($mark, $orig) = $im->remove($junk);
 696         if ($mark eq 'MISSING') {
 697                 print "not found\n";
 698         } elsif ($mark eq 'MISMATCH') {
 699                 print "Message exists but does not match\n\n",
 700                         $orig->as_string, "\n",;
 701         } else {
 702                 print "removed at mark $mark\n\n",
 703                         $orig->as_string, "\n";
 704         }
 705         $im->done;
 706
 707 =head1 DESCRIPTION
 708
 709 An importer and remover for public-inboxes which takes C<PublicInbox::Eml>
 710 or L<Email::MIME> messages as input and stores them in a git repository as
 711 documented in L<https://public-inbox.org/public-inbox-v1-format.txt>,
 712 except it does not allow duplicate Message-IDs.
 713
 714 It requires L<git(1)> and L<git-fast-import(1)> to be installed.
 715
 716 =head1 METHODS
 717
 718 =cut
 719
 720 =head2 new
 721
 722         my $im = PublicInbox::Import->new($git, @committer);
 723
 724 Initialize a new PublicInbox::Import object.
 725
 726 =head2 add
 727
 728         my $parsed = PublicInbox::Eml->new($message);
 729         $im->add($parsed);
 730
 731 Adds a message to to the git repository.  This will acquire
 732 C<$GIT_DIR/ssoma.lock> and start L<git-fast-import(1)> if necessary.
 733
 734 Messages added will not be visible to other processes until L</done>
 735 is called, but L</remove> may be called on them.
 736
 737 =head2 remove
 738
 739         my $junk = PublicInbox::Eml->new($message);
 740         my ($code, $orig) = $im->remove($junk);
 741
 742 Removes a message from the repository.  On success, it returns
 743 a ':'-prefixed numeric code representing the git-fast-import
 744 mark and the original messages as a PublicInbox::Eml
 745 (or Email::MIME) object.
 746 If the message could not be found, the code is "MISSING"
 747 and the original message is undef.  If there is a mismatch where
 748 the "Message-ID" is matched but the subject and body do not match,
 749 the returned code is "MISMATCH" and the conflicting message
 750 is returned as orig.
 751
 752 =head2 done
 753
 754 Finalizes the L<git-fast-import(1)> and unlocks the repository.
 755 Calling this is required to finalize changes to a repository.
 756
 757 =head1 SEE ALSO
 758
 759 L<Email::MIME>
 760
 761 =head1 CONTACT
 762
 763 All feedback welcome via plain-text mail to L<mailto:meta@public-inbox.org>
 764
 765 The mail archives are hosted at L<https://public-inbox.org/meta/>
 766
 767 =head1 COPYRIGHT
 768
 769 Copyright (C) 2016-2020 all contributors L<mailto:meta@public-inbox.org>
 770
 771 License: AGPL-3.0+ L<http://www.gnu.org/licenses/agpl-3.0.txt>
 772
 773 =cut