Viewing file:  spamclear.pl (8.41 KB) -rwxrwxr-x
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
#!/usr/bin/perl
# Apply the spam cleanup and email retention polices for all virtual servers
# that have them enabled.
package virtual_server;
$main::no_acl_check++;
$no_virtualmin_plugins = 1;
require './virtual-server-lib.pl';
&foreign_require("mailboxes");
# Parse command-line args
while(@ARGV) {
$a = shift(@ARGV);
if ($a eq "--debug") {
$debug = 1;
}
elsif ($a eq "--dry-run") {
$dryrun = 1;
}
else {
$ucheck{$a}++;
}
}
# hack to force correct DBM mode
$temp = &transname();
&make_dir($temp, 0700);
&mailboxes::open_dbm_db(\%dummy, "$temp/dummy", 0700);
foreach $d (&list_domains()) {
# Is spam clearing enabled?
$auto = undef;
if ($d->{'spam'} && ($auto = &get_domain_spam_autoclear($d)) &&
%$auto) {
print STDERR "$d->{'dom'}: spam clearing is enabled\n"
if ($debug);
}
else {
$auto = { };
print STDERR "$d->{'dom'}: spam filtering is not enabled\n"
if ($debug);
}
print STDERR "$d->{'dom'}: finding mailboxes\n" if ($debug);
# Is email retention policy active?
$retention = undef;
if ($config{'retention_policy'}) {
%dids = map { $_, 1 } split(/\s+/, $config{'retention_doms'});
if ($config{'retention_mode'} == 0 ||
$config{'retention_mode'} == 1 && $dids{$d->{'id'}} ||
$config{'retention_mode'} == 2 && !$dids{$d->{'id'}}) {
# A policy exists, and is used for this domain
if ($config{'retention_policy'} == 1) {
$retention = {
'days' => $config{'retention_days'} };
}
elsif ($config{'retention_policy'} == 2) {
$retention = {
'size' => $config{'retention_size'} };
}
print STDERR "$d->{'dom'}: retention is enabled\n"
if ($debug);
}
else {
print STDERR "$d->{'dom'}: no retention for domain\n"
if ($debug);
$retention = { };
}
}
else {
print STDERR "$d->{'dom'}: no retention active\n"
if ($debug);
$retention = { };
}
# Check if there is anything to do
if (!%$auto && !%$retention) {
print STDERR "$d->{'dom'}: no cleanup is needed\n"
if ($debug);
next;
}
# Work out the spam, virus and trash folders for this domain
local $sfname = "spam";
local $vfname = "virus";
local $tfname = "trash";
local $fd = $mailboxes::config{'mail_usermin'};
local ($sdmode, $sdpath) = &get_domain_spam_delivery($d);
if ($sdmode == 1 && $sdpath =~ /^\Q$fd\E\/(.+)$/) {
$sfname = lc($1);
$sfname =~ s/^\.//;
$sfname =~ s/\/$//;
}
elsif ($sdmode == 4 || $sdmode == 6) {
$sfname = $sdpath;
}
local ($vdmode, $vdpath) = &get_domain_virus_delivery($d);
if ($vdmode == 1 && $vdpath =~ /^\Q$fd\E\/(.+)$/) {
$vfname = lc($1);
$vfname =~ s/^\.//;
$vfname =~ s/\/$//;
}
elsif ($vdmode == 4 || $vdmode == 6) {
$vfname = $vdpath;
}
print STDERR "$d->{'dom'}: spam=$sfname virus=$vfname trash=$tfname\n" if ($debug);
# Check all mailboxes
@users = &list_domain_users($d, 0, 1, 1, 1);
foreach $u (@users) {
next if (keys %ucheck && !$ucheck{$u->{'user'}});
# Find the folders to process
print STDERR " $u->{'user'}: finding folders\n" if ($debug);
@uinfo = ( $u->{'user'}, $u->{'pass'}, $u->{'uid'},
$u->{'gid'}, undef, undef, $u->{'real'},
$u->{'home'}, $u->{'shell'} );
@folders = &mailboxes::list_user_folders(@uinfo);
@process = ( );
# For spam clearing
if (%$auto) {
foreach $fn (&unique($sfname, $vfname, $tfname)) {
($folder) = grep {
$_->{'file'} =~ /\/(\.?)\Q$fn\E$/i &&
$_->{'index'} != 0
} @folders;
if (!$folder) {
print STDERR " $u->{'user'}: no $fn ".
"folder\n" if ($debug);
next;
}
print STDERR " $u->{'user'}: $fn folder is ".
"$folder->{'file'}\n" if ($debug);
$folder->{'fn'} = $fn;
push(@process, $folder);
if ($auto->{'subfolders'}) {
# Also add sub-folders
my @subfolders = grep {
$_->{'file'} =~ /\/(\.?)\Q$fn\E\./i &&
$_->{'index'} != 0
} @folders;
foreach my $subfolder (@subfolders) {
$subfolder->{'fn'} = $fn;
push(@process, $subfolder);
}
}
}
}
# For email retention policy
if (%$retention && $config{'retention_folders'} == 0) {
# All of the user's folders
push(@process, @folders);
}
elsif (%$retention && $config{'retention_folders'} == 1) {
# Just the inbox
push(@process, $folders[0]) if (@folders);
}
# Uniquify folders
my %donefolder;
@process = grep { !$donefolder{&mailboxes::folder_name($_)}++ }
@process;
print STDERR " $u->{'user'}: processing ".scalar(@process).
" folders\n" if ($debug);
foreach my $folder (@process) {
my $fn = $folder->{'fn'} || "other";
print STDERR " $u->{'user'}: processing folder ".
$folder->{'file'}."\n" if ($debug);
# Verify the index on the folder
if ($folder->{'type'} == 0) {
local $ifile = &mailboxes::user_index_file(
$folder->{'file'});
local %index;
eval {
&mailboxes::build_dbm_index(
$folder->{'file'}, \%index);
dbmclose(%index);
};
if ($@) {
# Bad .. need to clear
unlink($ifile.".dir",
$ifile.".pag",
$ifile.".db");
}
}
# Work out the threshold
local ($days, $size);
if ($fn eq $tfname) {
($days, $size) = ($auto->{'trashdays'},
$auto->{'trashsize'});
}
elsif ($fn eq $sfname || $fn eq $tfname) {
($days, $size) = ($auto->{'days'},
$auto->{'size'});
}
if ($days eq '' && $size eq '' && %$retention) {
# Fall back to retention policy
$days = $retention->{'days'};
$size = $retention->{'size'};
}
if ($days eq '' && $size eq '') {
print STDERR " $u->{'user'}: clearing ".
"disabled for $fn folder\n" if ($debug);
next;
}
# Get email in the folder, and check criteria.
# Messages are processed 1000 at a time, to avoid
# loading a huge amount into memory.
$count = &mailboxes::mailbox_folder_size($folder);
print STDERR " $u->{'user'}: mail count ",
$count,"\n" if ($debug);
print STDERR " $u->{'user'}: size cutoff ",
$size,"\n" if ($debug && $size);
print STDERR " $u->{'user'}: days cutoff ",
$days,"\n" if ($debug && $days);
if (!$days) {
$needsize = &mailboxes::folder_size($folder) -
$size;
$needsize = 0 if ($needsize < 0);
print STDERR " $u->{'user'}: need to delete ",
"$needsize bytes\n" if ($debug);
}
eval {
local $main::error_must_die = 1;
for($i=0; $i<$count; $i+=1000) {
last if (!$days && $needsize <= 0);
$endi = $i+1000-1;
$endi = $count-1 if ($endi >= $count);
my @mail = &mailboxes::mailbox_list_mails($i, $endi, $folder, 1);
@mail = @mail[$i .. $endi];
print STDERR " $u->{'user'}: ",
"processing range $i to $endi\n"
if ($debug);
($needsize, $delcount) =
&process_spam_mails(
\@mail, $days, $size,
$folder, $needsize);
$count -= $delcount;
if ($delcount) {
# Shift back pointer, as some
# new messages will be in the
# range now
$i -= 1000;
}
}
};
if ($@ && $debug) {
print STDERR " $u->{'user'}: exception: $@\n";
}
}
}
}
# process_spam_mails(&mail, days, size, &folder, needsize)
# Given a set of messages that are spam, delete them if they meet the criteria.
# Needsize is the amount of spam that needs to be deleted, and is returned
# after being reduced.
sub process_spam_mails
{
local ($mail, $days, $size, $folder, $needsize) = @_;
my @delmail;
if ($days) {
# Find mail older than some number of days
my $cutoff = time() - $days*24*60*60;
foreach my $m (@$mail) {
my $time = &mailboxes::parse_mail_date(
$m->{'header'}->{'date'});
$time ||= $m->{'time'};
if ($time && $time < $cutoff) {
#print STDERR "deleting $m->{'header'}->{'subject'} dated $time\n";
push(@delmail, $m);
}
}
}
else {
# Find oldest mail that is too large
print STDERR " $u->{'user'}: mail size ",
&mailboxes::folder_size($folder),"\n"
if ($debug);
foreach my $m (@$mail) {
last if ($needsize <= 0);
push(@delmail, $m);
#print STDERR "deleting $m->{'header'}->{'subject'} with size $m->{'size'}\n";
$needsize -= $m->{'size'};
}
}
if ($dryrun) {
if (@delmail) {
print STDERR " $u->{'user'}: would delete ",scalar(@delmail),
" messages\n" if ($debug);
}
return ($needsize, 0);
}
else {
# Delete any mail found
if (@delmail) {
print STDERR " $u->{'user'}: deleting ",scalar(@delmail),
" messages\n" if ($debug);
&mailboxes::mailbox_delete_mail(
$folder, reverse(@delmail));
}
return ($needsize, scalar(@delmail));
}
}
|