v2writable: support purging messages from git entirely

Purging existing messages is fairly straightforward since we can
take advantage of Xapian and lookup the git object_id with it.

Unfortunately, purging an already "removed" message (which is
no longer in Xapian) is not as easy and we'll need to expose
->purge_oids to purge by the git object_id (currently SHA-1).

Furthermore, we expire reflogs and prune in hopes a dumb HTTP
client won't get the object.

2 files changed, 124 insertions, 5 deletions

diff --git a/lib/PublicInbox/Import.pm b/lib/PublicInbox/Import.pm
index e07eddab..f00c260b 100644
--- a/lib/PublicInbox/Import.pm
+++ b/lib/PublicInbox/Import.pm
@@ -430,6 +430,96 @@ sub digest2mid ($) {
         $b64 . '@localhost';
 }
 
+sub clean_purge_buffer {
+        my ($oid, $buf) = @_;
+        my $cmt_msg = "purged $oid\n";
+
+        foreach my $i (0..$#$buf) {
+                my $l = $buf->[$i];
+                if ($l =~ /^author .* (\d+ [\+-]?\d+)$/) {
+                        $buf->[$i] = "author <> $1\n";
+                } elsif ($l =~ /^data (\d+)/) {
+                        $buf->[$i++] = "data " . length($cmt_msg) . "\n";
+                        $buf->[$i] = $cmt_msg;
+                        last;
+                }
+        }
+}
+
+sub purge_oids {
+        my ($self, $purge) = @_;
+        my $tmp = "refs/heads/purge-".((keys %$purge)[0]);
+        my $old = $self->{'ref'};
+        my $git = $self->{git};
+        my @export = (qw(fast-export --no-data --use-done-feature), $old);
+        my ($rd, $pid) = $git->popen(@export);
+        my ($r, $w) = $self->gfi_start;
+        my @buf;
+        my $npurge = 0;
+        while (<$rd>) {
+                if (/^reset (?:.+)/) {
+                        push @buf, "reset $tmp\n";
+                } elsif (/^commit (?:.+)/) {
+                        if (@buf) {
+                                $w->print(@buf) or wfail;
+                                @buf = ();
+                        }
+                        push @buf, "commit $tmp\n";
+                } elsif (/^data (\d+)/) {
+                        # only commit message, so $len is small:
+                        my $len = $1; # + 1 for trailing "\n"
+                        push @buf, $_;
+                        my $n = read($rd, my $buf, $len) or die "read: $!";
+                        $len == $n or die "short read ($n < $len)";
+                        push @buf, $buf;
+                } elsif (/^M 100644 ([a-f0-9]+) /) {
+                        my $oid = $1;
+                        if ($purge->{$oid}) {
+                                my $lf = <$rd>;
+                                if ($lf eq "\n") {
+                                        my $out = join('', @buf);
+                                        $out =~ s/^/# /sgm;
+                                        warn "purge rewriting\n", $out, "\n";
+                                        clean_purge_buffer($oid, \@buf);
+                                        $out = join('', @buf);
+                                        $w->print(@buf, "\n") or wfail;
+                                        @buf = ();
+                                        $npurge++;
+                                } else {
+                                        die "expected LF: $lf\n";
+                                }
+                        } else {
+                                push @buf, $_;
+                        }
+                } else {
+                        push @buf, $_;
+                }
+        }
+        if (@buf) {
+                $w->print(@buf) or wfail;
+        }
+        $w = $r = undef;
+        $self->done;
+        my @git = ('git', "--git-dir=$git->{git_dir}");
+
+        run_die([@git, qw(update-ref), $old, $tmp]) if $npurge;
+
+        run_die([@git, qw(update-ref -d), $tmp]);
+
+        return if $npurge == 0;
+
+        run_die([@git, qw(-c gc.reflogExpire=now gc --prune=all)]);
+        my $err = 0;
+        foreach my $oid (keys %$purge) {
+                my @info = $git->check($oid);
+                if (@info) {
+                        warn "$oid not purged\n";
+                        $err++;
+                }
+        }
+        die "Failed to purge $err object(s)\n" if $err;
+}
+
 1;
 __END__
 =pod
diff --git a/lib/PublicInbox/V2Writable.pm b/lib/PublicInbox/V2Writable.pm
index 9b280c68..ef9867de 100644
--- a/lib/PublicInbox/V2Writable.pm
+++ b/lib/PublicInbox/V2Writable.pm
@@ -209,11 +209,22 @@ sub idx_init {
         $skel->_msgmap_init->{dbh}->begin_work;
 }
 
-sub remove {
-        my ($self, $mime, $cmt_msg) = @_;
+sub purge_oids {
+        my ($self, $purge) = @_; # $purge = { $object_id => 1, ... }
+        $self->done;
+        my $pfx = "$self->{-inbox}->{mainrepo}/git";
+        foreach my $i (0..$self->{max_git}) {
+                my $git = PublicInbox::Git->new("$pfx/$i.git");
+                my $im = $self->import_init($git, 0);
+                $im->purge_oids($purge);
+        }
+}
+
+sub remove_internal {
+        my ($self, $mime, $cmt_msg, $purge) = @_;
         $self->barrier;
         $self->idx_init;
-        my $im = $self->importer;
+        my $im = $self->importer unless $purge;
         my $ibx = $self->{-inbox};
         my $srch = $ibx->search;
         my $cid = content_id($mime);
@@ -245,11 +256,15 @@ sub remove {
                                 # no bugs in our deduplication code:
                                 $removed = $smsg;
                                 $removed->{mime} = $cur;
-                                $im->remove(\$orig, $cmt_msg);
+                                my $oid = $smsg->{blob};
+                                if ($purge) {
+                                        $purge->{$oid} = 1;
+                                } else {
+                                        $im->remove(\$orig, $cmt_msg);
+                                }
                                 $orig = undef;
                                 $removed->num; # memoize this for callers
 
-                                my $oid = $smsg->{blob};
                                 foreach my $idx (@$parts, $skel) {
                                         $idx->remote_remove($oid, $mid);
                                 }
@@ -258,9 +273,23 @@ sub remove {
                 });
                 $self->barrier;
         }
+        if ($purge && scalar keys %$purge) {
+                purge_oids($self, $purge);
+        }
         $removed;
 }
 
+sub remove {
+        my ($self, $mime, $cmt_msg) = @_;
+        remove_internal($self, $mime, $cmt_msg);
+}
+
+sub purge {
+        my ($self, $mime) = @_;
+        remove_internal($self, $mime, undef, {});
+}
+
+
 sub done {
         my ($self) = @_;
         my $locked = defined $self->{idx_parts};