script/public-inbox-purge

   1 #!/usr/bin/perl -w
   2 # Copyright (C) 2019 all contributors <meta@public-inbox.org>
   3 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   4 #
   5 # Used for purging messages entirely from a public-inbox.  Currently
   6 # supports v2 inboxes only, for now.
   7 use strict;
   8 use warnings;
   9 use Getopt::Long qw(:config gnu_getopt no_ignore_case auto_abbrev);
  10 use PublicInbox::Admin qw(resolve_repo_dir);
  11 PublicInbox::Admin::check_require('-index');
  12 require PublicInbox::Filter::Base;
  13 require PublicInbox::Config;
  14 require PublicInbox::MIME;
  15 require PublicInbox::V2Writable;
  16
  17 { no warnings 'once'; *REJECT = *PublicInbox::Filter::Base::REJECT }
  18
  19 my $usage = "$0 [--all] [INBOX_DIRS] </path/to/message";
  20 my $config = eval { PublicInbox::Config->new };
  21 my $cfgfile = PublicInbox::Config::default_file();
  22 my ($all, $force);
  23 my $verbose = 1;
  24 my %opts = (
  25         'all' => \$all,
  26         'force|f' => \$force,
  27         'verbose|v!' => \$verbose,
  28 );
  29 GetOptions(%opts) or die "bad command-line args\n", $usage, "\n";
  30
  31 # TODO: clean this up and share code with -index via ::Admin
  32 my %dir2ibx; # ( path => Inbox object )
  33 my @inboxes;
  34 $config and $config->each_inbox(sub {
  35         my ($ibx) = @_;
  36         push @inboxes, $ibx if $all && $ibx->{version} != 1;
  37         $dir2ibx{$ibx->{mainrepo}} = $ibx;
  38 });
  39
  40 if ($all) {
  41         $config or die "--all specified, but $cfgfile not readable\n";
  42         @ARGV and die "--all specified, but directories specified\n";
  43 } else {
  44         my @err;
  45         my @dirs = scalar(@ARGV) ? @ARGV : ('.');
  46         my $u = 0;
  47
  48         foreach my $dir (@dirs) {
  49                 my $v;
  50                 my $dir = resolve_repo_dir($dir, \$v);
  51                 if ($v == 1) {
  52                         push @err, $dir;
  53                         next;
  54                 }
  55                 my $ibx = $dir2ibx{$dir} ||= do {
  56                         warn "$dir not configured in $cfgfile\n";
  57                         $u++;
  58                         my $name = "unconfigured-$u";
  59                         PublicInbox::Inbox->new({
  60                                 version => 2,
  61                                 name => $name,
  62                                 -primary_address => "$name\@example.com",
  63                                 mainrepo => $dir,
  64                         });
  65                 };
  66                 push @inboxes, $ibx;
  67         }
  68
  69         if (@err) {
  70                 die "v1 inboxes currently not supported by -purge\n\t",
  71                     join("\n\t", @err), "\n";
  72         }
  73 }
  74
  75 foreach my $ibx (@inboxes) {
  76         my $lvl = $ibx->{indexlevel};
  77         if (defined $lvl) {
  78                 PublicInbox::Admin::indexlevel_ok_or_die($lvl);
  79                 next;
  80         }
  81
  82         # Undefined indexlevel, so `full'...
  83         # Search::Xapian exists and the DB can be read, at least, fine
  84         $ibx->search and next;
  85
  86         # it's possible for a Xapian directory to exist, but Search::Xapian
  87         # to go missing/broken.  Make sure it's purged in that case:
  88         $ibx->over or die "no over.sqlite3 in $ibx->{mainrepo}\n";
  89
  90         # $ibx->{search} is populated by $ibx->over call
  91         my $xdir_ro = $ibx->{search}->xdir(1);
  92         my $npart = 0;
  93         foreach my $part (<$xdir_ro/*>) {
  94                 if (-d $part && $part =~ m!/[0-9]+\z!) {
  95                         my $bytes = 0;
  96                         $bytes += -s $_ foreach glob("$part/*");
  97                         $npart++ if $bytes;
  98                 }
  99         }
 100         if ($npart) {
 101                 PublicInbox::Admin::require_or_die('-search');
 102         } else {
 103                 # somebody could "rm -r" all the Xapian directories;
 104                 # let them purge the overview, at least
 105                 $ibx->{indexlevel} ||= 'basic';
 106         }
 107 }
 108
 109 my $data = do { local $/; scalar <STDIN> };
 110 $data =~ s/\A[\r\n]*From [^\r\n]*\r?\n//s;
 111 my $n_purged = 0;
 112
 113 foreach my $ibx (@inboxes) {
 114         my $mime = PublicInbox::MIME->new($data);
 115         my $v2w = PublicInbox::V2Writable->new($ibx, 0);
 116
 117         my $commits = $v2w->purge($mime) || [];
 118
 119         if (my $scrub = $ibx->filter($v2w)) {
 120                 my $scrubbed = $scrub->scrub($mime, 1);
 121
 122                 if ($scrubbed && $scrubbed != REJECT()) {
 123                         my $scrub_commits = $v2w->purge($scrubbed);
 124                         push @$commits, @$scrub_commits if $scrub_commits;
 125                 }
 126         }
 127
 128         $v2w->done;
 129
 130         if ($verbose) { # should we consider this machine-parseable?
 131                 print "$ibx->{mainrepo}:";
 132                 if (scalar @$commits) {
 133                         print join("\n\t", '', @$commits), "\n";
 134                 } else {
 135                         print " NONE\n";
 136                 }
 137         }
 138         $n_purged += scalar @$commits;
 139 }
 140
 141 # behave like "rm -f"
 142 exit(0) if ($force || $n_purged);
 143
 144 warn "Not found\n" if $verbose;
 145 exit(1);