2 # Copyright (C) 2019 all contributors <meta@public-inbox.org>
3 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
5 # Used for purging messages entirely from a public-inbox. Currently
6 # supports v2 inboxes only, for now.
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;
17 { no warnings 'once'; *REJECT = *PublicInbox::Filter::Base::REJECT }
19 my $usage = "$0 [--all] [INBOX_DIRS] </path/to/message";
20 my $config = eval { PublicInbox::Config->new };
21 my $cfgfile = PublicInbox::Config::default_file();
27 'verbose|v!' => \$verbose,
29 GetOptions(%opts) or die "bad command-line args\n", $usage, "\n";
31 # TODO: clean this up and share code with -index via ::Admin
32 my %dir2ibx; # ( path => Inbox object )
34 $config and $config->each_inbox(sub {
36 push @inboxes, $ibx if $all && $ibx->{version} != 1;
37 $dir2ibx{$ibx->{mainrepo}} = $ibx;
41 $config or die "--all specified, but $cfgfile not readable\n";
42 @ARGV and die "--all specified, but directories specified\n";
45 my @dirs = scalar(@ARGV) ? @ARGV : ('.');
48 foreach my $dir (@dirs) {
50 my $dir = resolve_repo_dir($dir, \$v);
55 my $ibx = $dir2ibx{$dir} ||= do {
56 warn "$dir not configured in $cfgfile\n";
58 my $name = "unconfigured-$u";
59 PublicInbox::Inbox->new({
62 -primary_address => "$name\@example.com",
70 die "v1 inboxes currently not supported by -purge\n\t",
71 join("\n\t", @err), "\n";
75 foreach my $ibx (@inboxes) {
76 my $lvl = $ibx->{indexlevel};
78 PublicInbox::Admin::indexlevel_ok_or_die($lvl);
82 # Undefined indexlevel, so `full'...
83 # Search::Xapian exists and the DB can be read, at least, fine
84 $ibx->search and next;
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";
90 # $ibx->{search} is populated by $ibx->over call
91 my $xdir_ro = $ibx->{search}->xdir(1);
93 foreach my $part (<$xdir_ro/*>) {
94 if (-d $part && $part =~ m!/[0-9]+\z!) {
96 $bytes += -s $_ foreach glob("$part/*");
101 PublicInbox::Admin::require_or_die('-search');
103 # somebody could "rm -r" all the Xapian directories;
104 # let them purge the overview, at least
105 $ibx->{indexlevel} ||= 'basic';
109 my $data = do { local $/; scalar <STDIN> };
110 $data =~ s/\A[\r\n]*From [^\r\n]*\r?\n//s;
113 foreach my $ibx (@inboxes) {
114 my $mime = PublicInbox::MIME->new($data);
115 my $v2w = PublicInbox::V2Writable->new($ibx, 0);
117 my $commits = $v2w->purge($mime) || [];
119 if (my $scrub = $ibx->filter($v2w)) {
120 my $scrubbed = $scrub->scrub($mime, 1);
122 if ($scrubbed && $scrubbed != REJECT()) {
123 my $scrub_commits = $v2w->purge($scrubbed);
124 push @$commits, @$scrub_commits if $scrub_commits;
130 if ($verbose) { # should we consider this machine-parseable?
131 print "$ibx->{mainrepo}:";
132 if (scalar @$commits) {
133 print join("\n\t", '', @$commits), "\n";
138 $n_purged += scalar @$commits;
141 # behave like "rm -f"
142 exit(0) if ($force || $n_purged);
144 warn "Not found\n" if $verbose;