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::Config;
  11 use PublicInbox::MIME;
  12 use PublicInbox::Admin qw(resolve_repo_dir);
  13 use PublicInbox::Filter::Base;
  14 *REJECT = *PublicInbox::Filter::Base::REJECT;
  15
  16 my $usage = "$0 [--all] [INBOX_DIRS] </path/to/message";
  17
  18 eval { require PublicInbox::V2Writable } or die
  19         "DBI, DBD::SQLite and Search::Xapian required for purge\n";
  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
  67                 # somebody could "rm -r" all the Xapian directories;
  68                 # let them purge the overview, at least
  69                 $ibx->{indexlevel} ||= 'basic' unless $ibx->search;
  70
  71                 push @inboxes, $ibx;
  72         }
  73
  74         if (@err) {
  75                 die "v1 inboxes currently not supported by -purge\n\t",
  76                     join("\n\t", @err), "\n";
  77         }
  78 }
  79
  80 my $data = do { local $/; scalar <STDIN> };
  81 $data =~ s/\A[\r\n]*From [^\r\n]*\r?\n//s;
  82 my $n_purged = 0;
  83
  84 foreach my $ibx (@inboxes) {
  85         my $mime = PublicInbox::MIME->new($data);
  86         my $v2w = PublicInbox::V2Writable->new($ibx, 0);
  87
  88         my $commits = $v2w->purge($mime) || [];
  89
  90         if (my $scrub = $ibx->filter($v2w)) {
  91                 my $scrubbed = $scrub->scrub($mime, 1);
  92
  93                 if ($scrubbed && $scrubbed != REJECT()) {
  94                         my $scrub_commits = $v2w->purge($scrubbed);
  95                         push @$commits, @$scrub_commits if $scrub_commits;
  96                 }
  97         }
  98
  99         $v2w->done;
 100
 101         if ($verbose) { # should we consider this machine-parseable?
 102                 print "$ibx->{mainrepo}:";
 103                 if (scalar @$commits) {
 104                         print join("\n\t", '', @$commits), "\n";
 105                 } else {
 106                         print " NONE\n";
 107                 }
 108         }
 109         $n_purged += scalar @$commits;
 110 }
 111
 112 # behave like "rm -f"
 113 exit(0) if ($force || $n_purged);
 114
 115 warn "Not found\n" if $verbose;
 116 exit(1);