| #!/usr/bin/perl -w |
| # Copyright (C) all contributors <meta@public-inbox.org> |
| # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> |
| # |
| # Used for purging messages entirely from a public-inbox. Currently |
| # supports v2 inboxes only, for now. |
| use strict; |
| use warnings; |
| use Getopt::Long qw(:config gnu_getopt no_ignore_case auto_abbrev); |
| use PublicInbox::AdminEdit; |
| PublicInbox::Admin::check_require('-index'); |
| use PublicInbox::Filter::Base qw(REJECT); |
| use PublicInbox::Eml; |
| require PublicInbox::V2Writable; |
| |
| my $help = <<EOF; |
| usage: public-inbox-purge [--all] [INBOX_DIRS] </path/to/message |
| |
| erase message entirely from an inbox (including history) |
| |
| options: |
| |
| --all purge from all configured inboxes |
| |
| See public-inbox-purge(1) man page for full documentation. |
| EOF |
| |
| my $opt = { verbose => 1, all => 0, -min_inbox_version => 2 }; |
| GetOptions($opt, @PublicInbox::AdminEdit::OPT, 'C=s@') or die $help; |
| if ($opt->{help}) { print $help; exit 0 }; |
| |
| PublicInbox::Admin::do_chdir(delete $opt->{C}); |
| my @ibxs = PublicInbox::Admin::resolve_inboxes(\@ARGV, $opt); |
| PublicInbox::AdminEdit::check_editable(\@ibxs); |
| |
| my $data = PublicInbox::IO::read_all \*STDIN; |
| PublicInbox::Eml::strip_from($data); |
| my $n_purged = 0; |
| |
| foreach my $ibx (@ibxs) { |
| my $mime = PublicInbox::Eml->new($data); |
| my $v2w = PublicInbox::V2Writable->new($ibx, 0); |
| |
| my $commits = $v2w->purge($mime) || []; |
| |
| if (my $scrub = $ibx->filter($v2w)) { |
| my $scrubbed = $scrub->scrub($mime, 1); |
| |
| if ($scrubbed && $scrubbed != REJECT()) { |
| my $scrub_commits = $v2w->purge($scrubbed); |
| push @$commits, @$scrub_commits if $scrub_commits; |
| } |
| } |
| |
| $v2w->done; |
| |
| if ($opt->{verbose}) { # should we consider this machine-parseable? |
| PublicInbox::AdminEdit::show_rewrites(\*STDOUT, $ibx, $commits); |
| } |
| $n_purged += scalar @$commits; |
| } |
| |
| # behave like "rm -f" |
| exit(0) if ($opt->{force} || $n_purged); |
| |
| warn "Not found\n" if $opt->{verbose}; |
| exit(1); |