]> Sergey Matveev's repositories - public-inbox.git/blob - lib/PublicInbox/V2Writable.pm
v2writable: do not modify DBs while iterating for ->remove
[public-inbox.git] / lib / PublicInbox / V2Writable.pm
1 # Copyright (C) 2018 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
3
4 # This interface wraps and mimics PublicInbox::Import
5 package PublicInbox::V2Writable;
6 use strict;
7 use warnings;
8 use base qw(PublicInbox::Lock);
9 use PublicInbox::SearchIdxPart;
10 use PublicInbox::MIME;
11 use PublicInbox::Git;
12 use PublicInbox::Import;
13 use PublicInbox::MID qw(mids);
14 use PublicInbox::ContentId qw(content_id content_digest);
15 use PublicInbox::Inbox;
16 use PublicInbox::OverIdxFork;
17 use PublicInbox::Msgmap;
18 use PublicInbox::Spawn;
19 use IO::Handle;
20
21 # an estimate of the post-packed size to the raw uncompressed size
22 my $PACKING_FACTOR = 0.4;
23
24 # assume 2 cores if GNU nproc(1) is not available
25 sub nproc () {
26         int($ENV{NPROC} || `nproc 2>/dev/null` || 2);
27 }
28
29 sub new {
30         my ($class, $v2ibx, $creat) = @_;
31         my $dir = $v2ibx->{mainrepo} or die "no mainrepo in inbox\n";
32         unless (-d $dir) {
33                 if ($creat) {
34                         require File::Path;
35                         File::Path::mkpath($dir);
36                 } else {
37                         die "$dir does not exist\n";
38                 }
39         }
40
41         my $nparts = 0;
42         my $xpfx = "$dir/xap" . PublicInbox::Search::SCHEMA_VERSION;
43
44         # always load existing partitions in case core count changes:
45         if (-d $xpfx) {
46                 foreach my $part (<$xpfx/*>) {
47                         -d $part && $part =~ m!/\d+\z! or next;
48                         eval {
49                                 Search::Xapian::Database->new($part)->close;
50                                 $nparts++;
51                         };
52                 }
53         }
54         $nparts = nproc() if ($nparts == 0);
55
56         $v2ibx = PublicInbox::InboxWritable->new($v2ibx);
57         my $self = {
58                 -inbox => $v2ibx,
59                 im => undef, #  PublicInbox::Import
60                 partitions => $nparts,
61                 parallel => 1,
62                 transact_bytes => 0,
63                 over => PublicInbox::OverIdxFork->new("$xpfx/over.sqlite3"),
64                 lock_path => "$dir/inbox.lock",
65                 # limit each repo to 1GB or so
66                 rotate_bytes => int((1024 * 1024 * 1024) / $PACKING_FACTOR),
67                 last_commit => [],
68         };
69         bless $self, $class;
70 }
71
72 sub init_inbox {
73         my ($self, $parallel) = @_;
74         $self->{parallel} = $parallel;
75         $self->idx_init;
76         my $max_git = -1;
77         git_dir_latest($self, \$max_git);
78         $self->git_init($max_git >= 0 ? $max_git : 0);
79         $self->done;
80 }
81
82 # returns undef on duplicate or spam
83 # mimics Import::add and wraps it for v2
84 sub add {
85         my ($self, $mime, $check_cb) = @_;
86
87         # spam check:
88         if ($check_cb) {
89                 $mime = $check_cb->($mime) or return;
90         }
91
92         # All pipes (> $^F) known to Perl 5.6+ have FD_CLOEXEC set,
93         # as does SQLite 3.4.1+ (released in 2007-07-20), and
94         # Xapian 1.3.2+ (released 2015-03-15).
95         # For the most part, we can spawn git-fast-import without
96         # leaking FDs to it...
97         $self->idx_init;
98
99         my $mid0;
100         my $num = num_for($self, $mime, \$mid0);
101         defined $num or return; # duplicate
102         defined $mid0 or die "BUG: $mid0 undefined\n";
103         my $im = $self->importer;
104         my $cmt = $im->add($mime);
105         $cmt = $im->get_mark($cmt);
106         my ($oid, $len, $msgref) = @{$im->{last_object}};
107
108         my $nparts = $self->{partitions};
109         my $part = $num % $nparts;
110         $self->{last_commit}->[$self->{max_git}] = $cmt;
111         my $idx = $self->idx_part($part);
112         $idx->index_raw($len, $msgref, $num, $oid, $mid0, $mime);
113         my $n = $self->{transact_bytes} += $len;
114         if ($n > (PublicInbox::SearchIdx::BATCH_BYTES * $nparts)) {
115                 $self->checkpoint;
116         }
117
118         $cmt;
119 }
120
121 sub num_for {
122         my ($self, $mime, $mid0) = @_;
123         my $mids = mids($mime->header_obj);
124         if (@$mids) {
125                 my $mid = $mids->[0];
126                 my $num = $self->{mm}->mid_insert($mid);
127                 if (defined $num) { # common case
128                         $$mid0 = $mid;
129                         return $num;
130                 };
131
132                 # crap, Message-ID is already known, hope somebody just resent:
133                 $self->barrier;
134                 foreach my $m (@$mids) {
135                         # read-only lookup now safe to do after above barrier
136                         my $existing = $self->lookup_content($mime, $m);
137                         # easy, don't store duplicates
138                         # note: do not add more diagnostic info here since
139                         # it gets noisy on public-inbox-watch restarts
140                         return if $existing;
141                 }
142
143                 # very unlikely:
144                 warn "<$mid> reused for mismatched content\n";
145
146                 # try the rest of the mids
147                 for(my $i = $#$mids; $i >= 1; $i--) {
148                         my $m = $mids->[$i];
149                         $num = $self->{mm}->mid_insert($m);
150                         if (defined $num) {
151                                 warn "alternative <$m> for <$mid> found\n";
152                                 $$mid0 = $m;
153                                 return $num;
154                         }
155                 }
156         }
157         # none of the existing Message-IDs are good, generate a new one:
158         num_for_harder($self, $mime, $mid0);
159 }
160
161 sub num_for_harder {
162         my ($self, $mime, $mid0) = @_;
163
164         my $hdr = $mime->header_obj;
165         my $dig = content_digest($mime);
166         $$mid0 = PublicInbox::Import::digest2mid($dig);
167         my $num = $self->{mm}->mid_insert($$mid0);
168         unless (defined $num) {
169                 # it's hard to spoof the last Received: header
170                 my @recvd = $hdr->header_raw('Received');
171                 $dig->add("Received: $_") foreach (@recvd);
172                 $$mid0 = PublicInbox::Import::digest2mid($dig);
173                 $num = $self->{mm}->mid_insert($$mid0);
174
175                 # fall back to a random Message-ID and give up determinism:
176                 until (defined($num)) {
177                         $dig->add(rand);
178                         $$mid0 = PublicInbox::Import::digest2mid($dig);
179                         warn "using random Message-ID <$$mid0> as fallback\n";
180                         $num = $self->{mm}->mid_insert($$mid0);
181                 }
182         }
183         PublicInbox::Import::append_mid($hdr, $$mid0);
184         $num;
185 }
186
187 sub idx_part {
188         my ($self, $part) = @_;
189         $self->{idx_parts}->[$part];
190 }
191
192 # idempotent
193 sub idx_init {
194         my ($self) = @_;
195         return if $self->{idx_parts};
196         my $ibx = $self->{-inbox};
197
198         # do not leak read-only FDs to child processes, we only have these
199         # FDs for duplicate detection so they should not be
200         # frequently activated.
201         delete $ibx->{$_} foreach (qw(git mm search));
202
203         my $over = $self->{over};
204         $ibx->umask_prepare;
205         $ibx->with_umask(sub {
206                 $self->lock_acquire;
207                 $over->create($self);
208
209                 # need to create all parts before initializing msgmap FD
210                 my $max = $self->{partitions} - 1;
211
212                 # idx_parts must be visible to all forked processes
213                 my $idx = $self->{idx_parts} = [];
214                 for my $i (0..$max) {
215                         push @$idx, PublicInbox::SearchIdxPart->new($self, $i);
216                 }
217
218                 # Now that all subprocesses are up, we can open the FDs
219                 # for SQLite:
220                 my $mm = $self->{mm} = PublicInbox::Msgmap->new_file(
221                         "$self->{-inbox}->{mainrepo}/msgmap.sqlite3", 1);
222                 $mm->{dbh}->begin_work;
223         });
224 }
225
226 sub purge_oids {
227         my ($self, $purge) = @_; # $purge = { $object_id => 1, ... }
228         $self->done;
229         my $pfx = "$self->{-inbox}->{mainrepo}/git";
230         my $purges = [];
231         foreach my $i (0..$self->{max_git}) {
232                 my $git = PublicInbox::Git->new("$pfx/$i.git");
233                 my $im = $self->import_init($git, 0, 1);
234                 $purges->[$i] = $im->purge_oids($purge);
235         }
236         $purges;
237 }
238
239 sub remove_internal {
240         my ($self, $mime, $cmt_msg, $purge) = @_;
241         $self->barrier;
242         $self->idx_init;
243         my $im = $self->importer unless $purge;
244         my $ibx = $self->{-inbox};
245         my $srch = $ibx->search;
246         my $cid = content_id($mime);
247         my $parts = $self->{idx_parts};
248         my $mm = $self->{mm};
249         my $removed;
250         my $mids = mids($mime->header_obj);
251
252         # We avoid introducing new blobs into git since the raw content
253         # can be slightly different, so we do not need the user-supplied
254         # message now that we have the mids and content_id
255         $mime = undef;
256         my $mark;
257
258         foreach my $mid (@$mids) {
259                 my %gone;
260                 $srch->reopen->each_smsg_by_mid($mid, sub {
261                         my ($smsg) = @_;
262                         $smsg->load_expand;
263                         my $msg = $ibx->msg_by_smsg($smsg);
264                         if (!defined($msg)) {
265                                 warn "broken smsg for $mid\n";
266                                 return 1; # continue
267                         }
268                         my $orig = $$msg;
269                         my $cur = PublicInbox::MIME->new($msg);
270                         if (content_id($cur) eq $cid) {
271                                 $smsg->{mime} = $cur;
272                                 $gone{$smsg->num} = [ $smsg, \$orig ];
273                         }
274                         1; # continue
275                 });
276                 my $n = scalar keys %gone;
277                 next unless $n;
278                 if ($n > 1) {
279                         warn "BUG: multiple articles linked to <$mid>\n",
280                                 join(',', sort keys %gone), "\n";
281                 }
282                 foreach my $num (keys %gone) {
283                         my ($smsg, $orig) = @{$gone{$num}};
284                         $mm->num_delete($num);
285                         # $removed should only be set once assuming
286                         # no bugs in our deduplication code:
287                         $removed = $smsg;
288                         my $oid = $smsg->{blob};
289                         if ($purge) {
290                                 $purge->{$oid} = 1;
291                         } else {
292                                 ($mark, undef) = $im->remove($orig, $cmt_msg);
293                         }
294                         $orig = undef;
295                         foreach my $idx (@$parts) {
296                                 $idx->remote_remove($oid, $mid);
297                         }
298                         $self->{over}->remove_oid($oid, $mid);
299                 }
300                 $self->barrier;
301         }
302
303         if (defined $mark) {
304                 my $cmt = $im->get_mark($mark);
305                 $self->{last_commit}->[$self->{max_git}] = $cmt;
306         }
307         if ($purge && scalar keys %$purge) {
308                 return purge_oids($self, $purge);
309         }
310         $removed;
311 }
312
313 sub remove {
314         my ($self, $mime, $cmt_msg) = @_;
315         remove_internal($self, $mime, $cmt_msg);
316 }
317
318 sub purge {
319         my ($self, $mime) = @_;
320         my $purges = remove_internal($self, $mime, undef, {});
321         $self->idx_init if @$purges; # ->done is called on purges
322         for my $i (0..$#$purges) {
323                 defined(my $cmt = $purges->[$i]) or next;
324                 $self->{last_commit}->[$i] = $cmt;
325         }
326         $purges;
327 }
328
329 sub set_last_commits ($) {
330         my ($self) = @_;
331         defined(my $max_git = $self->{max_git}) or return;
332         my $mm = $self->{mm};
333         my $last_commit = $self->{last_commit};
334         foreach my $i (0..$max_git) {
335                 defined(my $cmt = $last_commit->[$i]) or next;
336                 $last_commit->[$i] = undef;
337                 $mm->last_commit_n($i, $cmt);
338         }
339 }
340
341 sub done {
342         my ($self) = @_;
343         my $im = delete $self->{im};
344         $im->done if $im; # PublicInbox::Import::done
345
346         my $mm = $self->{mm};
347         $mm->{dbh}->commit if $mm;
348
349         # order matters, we can only close {over} after all partitions
350         # are done because the partitions also write to {over}
351         my $parts = delete $self->{idx_parts};
352         if ($parts) {
353                 $_->remote_commit for @$parts;
354                 $_->remote_close for @$parts;
355         }
356
357         my $over = $self->{over};
358         $over->remote_commit;
359         $over->remote_close;
360
361         if ($mm) {
362                 $mm->{dbh}->begin_work;
363                 set_last_commits($self);
364                 $mm->{dbh}->commit;
365                 delete $self->{mm};
366         }
367
368         $self->{transact_bytes} = 0;
369         $self->lock_release if $parts;
370 }
371
372 sub checkpoint {
373         my ($self) = @_;
374         my $im = $self->{im};
375         $im->checkpoint if $im; # PublicInbox::Import::checkpoint
376         $self->barrier(1);
377 }
378
379 # issue a write barrier to ensure all data is visible to other processes
380 # and read-only ops.  Order of data importance is: git > SQLite > Xapian
381 sub barrier {
382         my ($self, $fsync) = @_;
383
384         if (my $im = $self->{im}) {
385                 $im->barrier;
386         }
387         my $parts = $self->{idx_parts};
388         if ($parts) {
389                 my $dbh = $self->{mm}->{dbh};
390                 $dbh->commit; # SQLite msgmap data is second in importance
391
392                 my $over = $self->{over};
393
394                 # Now deal with Xapian and overview DB
395                 $over->barrier_init(scalar(@$parts));
396
397                 # each partition needs to issue a barrier command to over
398                 $_->remote_barrier foreach @$parts;
399
400                 $over->barrier_wait; # wait for each Xapian partition
401                 $over->commit_fsync if $fsync;
402
403                 # last_commit is special, don't commit these until
404                 # remote partitions are done:
405                 $dbh->begin_work;
406                 set_last_commits($self);
407                 $dbh->commit;
408
409                 $dbh->begin_work;
410         }
411         $self->{transact_bytes} = 0;
412 }
413
414 sub git_init {
415         my ($self, $new) = @_;
416         my $pfx = "$self->{-inbox}->{mainrepo}/git";
417         my $git_dir = "$pfx/$new.git";
418         my @cmd = (qw(git init --bare -q), $git_dir);
419         PublicInbox::Import::run_die(\@cmd);
420
421         my $all = "$self->{-inbox}->{mainrepo}/all.git";
422         unless (-d $all) {
423                 @cmd = (qw(git init --bare -q), $all);
424                 PublicInbox::Import::run_die(\@cmd);
425                 @cmd = (qw/git config/, "--file=$all/config",
426                                 'repack.writeBitmaps', 'true');
427                 PublicInbox::Import::run_die(\@cmd);
428         }
429
430         @cmd = (qw/git config/, "--file=$git_dir/config",
431                         'include.path', '../../all.git/config');
432         PublicInbox::Import::run_die(\@cmd);
433
434         my $alt = "$all/objects/info/alternates";
435         my $new_obj_dir = "../../git/$new.git/objects";
436         my %alts;
437         if (-e $alt) {
438                 open(my $fh, '<', $alt) or die "open < $alt: $!\n";
439                 %alts = map { chomp; $_ => 1 } (<$fh>);
440         }
441         return $git_dir if $alts{$new_obj_dir};
442         open my $fh, '>>', $alt or die "open >> $alt: $!\n";
443         print $fh "$new_obj_dir\n" or die "print >> $alt: $!\n";
444         close $fh or die "close $alt: $!\n";
445         $git_dir
446 }
447
448 sub git_dir_latest {
449         my ($self, $max) = @_;
450         $$max = -1;
451         my $pfx = "$self->{-inbox}->{mainrepo}/git";
452         return unless -d $pfx;
453         my $latest;
454         opendir my $dh, $pfx or die "opendir $pfx: $!\n";
455         while (defined(my $git_dir = readdir($dh))) {
456                 $git_dir =~ m!\A(\d+)\.git\z! or next;
457                 if ($1 > $$max) {
458                         $$max = $1;
459                         $latest = "$pfx/$git_dir";
460                 }
461         }
462         $latest;
463 }
464
465 sub importer {
466         my ($self) = @_;
467         my $im = $self->{im};
468         if ($im) {
469                 if ($im->{bytes_added} < $self->{rotate_bytes}) {
470                         return $im;
471                 } else {
472                         $self->{im} = undef;
473                         $im->done;
474                         $self->barrier(1);
475                         $im = undef;
476                         my $git_dir = $self->git_init(++$self->{max_git});
477                         my $git = PublicInbox::Git->new($git_dir);
478                         return $self->import_init($git, 0);
479                 }
480         }
481         my $new = 0;
482         my $max;
483         my $latest = git_dir_latest($self, \$max);
484         if (defined $latest) {
485                 my $git = PublicInbox::Git->new($latest);
486                 my $packed_bytes = $git->packed_bytes;
487                 if ($packed_bytes >= $self->{rotate_bytes}) {
488                         $new = $max + 1;
489                 } else {
490                         $self->{max_git} = $max;
491                         return $self->import_init($git, $packed_bytes);
492                 }
493         }
494         $self->{max_git} = $new;
495         $latest = $self->git_init($new);
496         $self->import_init(PublicInbox::Git->new($latest), 0);
497 }
498
499 sub import_init {
500         my ($self, $git, $packed_bytes, $tmp) = @_;
501         my $im = PublicInbox::Import->new($git, undef, undef, $self->{-inbox});
502         $im->{bytes_added} = int($packed_bytes / $PACKING_FACTOR);
503         $im->{want_object_info} = 1;
504         $im->{lock_path} = undef;
505         $im->{path_type} = 'v2';
506         $self->{im} = $im unless $tmp;
507         $im;
508 }
509
510 # XXX experimental
511 sub diff ($$$) {
512         my ($mid, $cur, $new) = @_;
513         use File::Temp qw(tempfile);
514         use PublicInbox::Spawn qw(spawn);
515
516         my ($ah, $an) = tempfile('email-cur-XXXXXXXX', TMPDIR => 1);
517         print $ah $cur->as_string or die "print: $!";
518         close $ah or die "close: $!";
519         my ($bh, $bn) = tempfile('email-new-XXXXXXXX', TMPDIR => 1);
520         PublicInbox::Import::drop_unwanted_headers($new);
521         print $bh $new->as_string or die "print: $!";
522         close $bh or die "close: $!";
523         my $cmd = [ qw(diff -u), $an, $bn ];
524         print STDERR "# MID conflict <$mid>\n";
525         my $pid = spawn($cmd, undef, { 1 => 2 });
526         defined $pid or die "diff failed to spawn $!";
527         waitpid($pid, 0) == $pid or die "diff did not finish";
528         unlink($an, $bn);
529 }
530
531 sub lookup_content {
532         my ($self, $mime, $mid) = @_;
533         my $ibx = $self->{-inbox};
534
535         my $srch = $ibx->search->reopen;
536         my $cid = content_id($mime);
537         my $found;
538         $srch->each_smsg_by_mid($mid, sub {
539                 my ($smsg) = @_;
540                 $smsg->load_expand;
541                 my $msg = $ibx->msg_by_smsg($smsg);
542                 if (!defined($msg)) {
543                         warn "broken smsg for $mid\n";
544                         return 1; # continue
545                 }
546                 my $cur = PublicInbox::MIME->new($msg);
547                 if (content_id($cur) eq $cid) {
548                         $smsg->{mime} = $cur;
549                         $found = $smsg;
550                         return 0; # break out of loop
551                 }
552
553                 # XXX DEBUG_DIFF is experimental and may be removed
554                 diff($mid, $cur, $mime) if $ENV{DEBUG_DIFF};
555
556                 1; # continue
557         });
558         $found;
559 }
560
561 sub atfork_child {
562         my ($self) = @_;
563         my $fh = delete $self->{reindex_pipe};
564         close $fh if $fh;
565         if (my $parts = $self->{idx_parts}) {
566                 $_->atfork_child foreach @$parts;
567         }
568         if (my $im = $self->{im}) {
569                 $im->atfork_child;
570         }
571         die "unexpected mm" if $self->{mm};
572 }
573
574 sub mark_deleted {
575         my ($self, $D, $git, $oid) = @_;
576         my $msgref = $git->cat_file($oid);
577         my $mime = PublicInbox::MIME->new($$msgref);
578         my $mids = mids($mime->header_obj);
579         my $cid = content_id($mime);
580         foreach my $mid (@$mids) {
581                 $D->{"$mid\0$cid"} = 1;
582         }
583 }
584
585 sub reindex_oid {
586         my ($self, $mm_tmp, $D, $git, $oid, $regen) = @_;
587         my $len;
588         my $msgref = $git->cat_file($oid, \$len);
589         my $mime = PublicInbox::MIME->new($$msgref);
590         my $mids = mids($mime->header_obj);
591         my $cid = content_id($mime);
592
593         # get the NNTP article number we used before, highest number wins
594         # and gets deleted from mm_tmp;
595         my $mid0;
596         my $num = -1;
597         my $del = 0;
598         foreach my $mid (@$mids) {
599                 $del += (delete $D->{"$mid\0$cid"} || 0);
600                 my $n = $mm_tmp->num_for($mid);
601                 if (defined $n && $n > $num) {
602                         $mid0 = $mid;
603                         $num = $n;
604                 }
605         }
606         if (!defined($mid0) && $regen && !$del) {
607                 $num = $$regen--;
608                 die "BUG: ran out of article numbers\n" if $num <= 0;
609                 my $mm = $self->{mm};
610                 foreach my $mid (reverse @$mids) {
611                         if ($mm->mid_set($num, $mid) == 1) {
612                                 $mid0 = $mid;
613                                 last;
614                         }
615                 }
616                 if (!defined($mid0)) {
617                         my $id = '<' . join('> <', @$mids) . '>';
618                         warn "Message-ID $id unusable for $num\n";
619                         foreach my $mid (@$mids) {
620                                 defined(my $n = $mm->num_for($mid)) or next;
621                                 warn "#$n previously mapped for <$mid>\n";
622                         }
623                 }
624         }
625
626         if (!defined($mid0) || $del) {
627                 if (!defined($mid0) && $del) { # expected for deletes
628                         $$regen--;
629                         return
630                 }
631
632                 my $id = '<' . join('> <', @$mids) . '>';
633                 defined($mid0) or
634                         warn "Skipping $id, no article number found\n";
635                 if ($del && defined($mid0)) {
636                         warn "$id was deleted $del " .
637                                 "time(s) but mapped to article #$num\n";
638                 }
639                 return;
640
641         }
642         $mm_tmp->mid_delete($mid0) or
643                 die "failed to delete <$mid0> for article #$num\n";
644
645         my $nparts = $self->{partitions};
646         my $part = $num % $nparts;
647         my $idx = $self->idx_part($part);
648         $idx->index_raw($len, $msgref, $num, $oid, $mid0, $mime);
649         my $n = $self->{transact_bytes} += $len;
650         if ($n > (PublicInbox::SearchIdx::BATCH_BYTES * $nparts)) {
651                 $git->cleanup;
652                 $mm_tmp->atfork_prepare;
653                 $self->done; # release lock
654                 # allow -watch or -mda to write...
655                 $self->idx_init; # reacquire lock
656                 $mm_tmp->atfork_parent;
657         }
658 }
659
660 # only update last_commit for $i on reindex iff newer than current
661 sub update_last_commit {
662         my ($self, $git, $i, $cmt) = @_;
663         my $last = $self->{mm}->last_commit_n($i);
664         if (defined $last && is_ancestor($git, $last, $cmt)) {
665                 my @cmd = (qw(rev-list --count), "$last..$cmt");
666                 chomp(my $n = $git->qx(@cmd));
667                 return if $n ne '' && $n == 0;
668         }
669         $self->{mm}->last_commit_n($i, $cmt);
670 }
671
672 sub git_dir_n ($$) { "$_[0]->{-inbox}->{mainrepo}/git/$_[1].git" }
673
674 sub last_commits {
675         my ($self, $max_git) = @_;
676         my $heads = [];
677         for (my $i = $max_git; $i >= 0; $i--) {
678                 $heads->[$i] = $self->{mm}->last_commit_n($i);
679         }
680         $heads;
681 }
682
683 sub is_ancestor ($$$) {
684         my ($git, $cur, $tip) = @_;
685         return 0 unless $git->check($cur);
686         my $cmd = [ 'git', "--git-dir=$git->{git_dir}",
687                 qw(merge-base --is-ancestor), $cur, $tip ];
688         my $pid = spawn($cmd);
689         defined $pid or die "spawning ".join(' ', @$cmd)." failed: $!";
690         waitpid($pid, 0) == $pid or die join(' ', @$cmd) .' did not finish';
691         $? == 0;
692 }
693
694 sub index_prepare {
695         my ($self, $opts, $max_git, $ranges) = @_;
696         my $regen_max = 0;
697         my $head = $self->{-inbox}->{ref_head} || 'refs/heads/master';
698         for (my $i = $max_git; $i >= 0; $i--) {
699                 die "already indexing!\n" if $self->{index_pipe};
700                 my $git_dir = git_dir_n($self, $i);
701                 -d $git_dir or next; # missing parts are fine
702                 my $git = PublicInbox::Git->new($git_dir);
703                 chomp(my $tip = $git->qx('rev-parse', $head));
704                 my $range;
705                 if (defined(my $cur = $ranges->[$i])) {
706                         $range = "$cur..$tip";
707                         if (is_ancestor($git, $cur, $tip)) { # common case
708                                 my $n = $git->qx(qw(rev-list --count), $range);
709                                 chomp($n);
710                                 if ($n == 0) {
711                                         $ranges->[$i] = undef;
712                                         next;
713                                 }
714                         } else {
715                                 warn <<"";
716 discontiguous range: $range
717 Rewritten history? (in $git_dir)
718
719                                 my $base = $git->qx('merge-base', $tip, $cur);
720                                 chomp $base;
721                                 if ($base) {
722                                         $range = "$base..$tip";
723                                         warn "found merge-base: $base\n"
724                                 } else {
725                                         $range = $tip;
726                                         warn <<"";
727 discarding history at $cur
728
729                                 }
730                                 warn <<"";
731 reindexing $git_dir starting at
732 $range
733
734                                 $self->{"unindex-range.$i"} = "$base..$cur";
735                         }
736                 } else {
737                         $range = $tip; # all of it
738                 }
739                 $ranges->[$i] = $range;
740
741                 # can't use 'rev-list --count' if we use --diff-filter
742                 my $fh = $git->popen(qw(log --pretty=tformat:%h
743                                 --no-notes --no-color --no-renames
744                                 --diff-filter=AM), $range, '--', 'm');
745                 ++$regen_max while <$fh>;
746         }
747         \$regen_max;
748 }
749
750 sub unindex_oid {
751         my ($self, $git, $oid) = @_;
752         my $msgref = $git->cat_file($oid);
753         my $mime = PublicInbox::MIME->new($msgref);
754         my $mids = mids($mime->header_obj);
755         $mime = $msgref = undef;
756
757         foreach my $mid (@$mids) {
758                 my %gone;
759                 $self->{-inbox}->search->reopen->each_smsg_by_mid($mid, sub {
760                         my ($smsg) = @_;
761                         $smsg->load_expand;
762                         $gone{$smsg->num} = 1 if $oid eq $smsg->{blob};
763                         1; # continue
764                 });
765                 my $n = scalar keys %gone;
766                 next unless $n;
767                 if ($n > 1) {
768                         warn "BUG: multiple articles linked to $oid\n",
769                                 join(',',sort keys %gone), "\n";
770                 }
771                 $self->{unindexed}->{$_}++ foreach keys %gone;
772                 $_->remote_remove($oid, $mid) foreach @{$self->{idx_parts}};
773                 $self->{over}->remove_oid($oid, $mid);
774                 $self->barrier;
775         }
776 }
777
778 my $x40 = qr/[a-f0-9]{40}/;
779 sub unindex {
780         my ($self, $opts, $git, $unindex_range) = @_;
781         my $un = $self->{unindexed} ||= {}; # num => removal count
782         $self->barrier;
783         my $before = scalar keys %$un;
784         my @cmd = qw(log --raw -r
785                         --no-notes --no-color --no-abbrev --no-renames);
786         my $fh = $self->{reindex_pipe} = $git->popen(@cmd, $unindex_range);
787         while (<$fh>) {
788                 /\A:\d{6} 100644 $x40 ($x40) [AM]\tm$/o or next;
789                 $self->unindex_oid($git, $1);
790         }
791         delete $self->{reindex_pipe};
792         $fh = undef;
793
794         return unless $opts->{prune};
795         my $after = scalar keys %$un;
796         return if $before == $after;
797
798         # ensure any blob can not longer be accessed via dumb HTTP
799         PublicInbox::Import::run_die(['git', "--git-dir=$git->{git_dir}",
800                 qw(-c gc.reflogExpire=now gc --prune=all)]);
801 }
802
803 sub index_sync {
804         my ($self, $opts) = @_;
805         $opts ||= {};
806         my $ibx = $self->{-inbox};
807         my $max_git;
808         my $latest = git_dir_latest($self, \$max_git);
809         return unless defined $latest;
810         $self->idx_init; # acquire lock
811         my $mm_tmp = $self->{mm}->tmp_clone;
812         my $ranges = $opts->{reindex} ? [] : $self->last_commits($max_git);
813
814         my ($min, $max) = $mm_tmp->minmax;
815         my $regen = $self->index_prepare($opts, $max_git, $ranges);
816         $$regen += $max if $max;
817         my $D = {};
818         my @cmd = qw(log --raw -r --pretty=tformat:%h
819                         --no-notes --no-color --no-abbrev --no-renames);
820
821         # work backwards through history
822         my $last_commit = [];
823         for (my $i = $max_git; $i >= 0; $i--) {
824                 my $git_dir = git_dir_n($self, $i);
825                 die "already reindexing!\n" if delete $self->{reindex_pipe};
826                 -d $git_dir or next; # missing parts are fine
827                 my $git = PublicInbox::Git->new($git_dir);
828                 my $unindex = delete $self->{"unindex-range.$i"};
829                 $self->unindex($opts, $git, $unindex) if $unindex;
830                 defined(my $range = $ranges->[$i]) or next;
831                 my $fh = $self->{reindex_pipe} = $git->popen(@cmd, $range);
832                 my $cmt;
833                 while (<$fh>) {
834                         if (/\A$x40$/o && !defined($cmt)) {
835                                 chomp($cmt = $_);
836                         } elsif (/\A:\d{6} 100644 $x40 ($x40) [AM]\tm$/o) {
837                                 $self->reindex_oid($mm_tmp, $D, $git, $1,
838                                                 $regen);
839                         } elsif (/\A:\d{6} 100644 $x40 ($x40) [AM]\td$/o) {
840                                 $self->mark_deleted($D, $git, $1);
841                         }
842                 }
843                 $fh = undef;
844                 delete $self->{reindex_pipe};
845                 $self->update_last_commit($git, $i, $cmt) if defined $cmt;
846         }
847         my @d = sort keys %$D;
848         if (@d) {
849                 warn "BUG: ", scalar(@d)," unseen deleted messages marked\n";
850                 foreach (@d) {
851                         my ($mid, undef) = split(/\0/, $_, 2);
852                         warn "<$mid>\n";
853                 }
854         }
855         $self->done;
856 }
857
858 1;