qmail_remove-old-mailboxes

#!/usr/local/bin/perl
#
# remove mailboxes that havent been pop'd in 3 months, 
# or that have never been pop'd, but created a month ago
# except if there is a .qmail inside the mailbox (we
# previously moved the .qmail to ../.qmail-user, but dont
# do that anymore for the per-user spam preferences)
# Copyright 2008 Jeremy Kister.  

use Getopt::Std;

my ($y,$m,$d) = (localtime())[5,4,3];
$y += 1900;
$m++;
my $mon = sprintf('%.2d', $m);
my $day = sprintf('%.2d', $d);

my $date = $y . $mon . $day;

my(%dir,%nuked);

opendir(D, '/var/qmail/queue/mess/') || die "cannot opendir queue/mess: $!\n";
my @subdirs = (grep {!/^\./} readdir D); # conf-split
closedir D;

# trim log,
my @log;
if(open(LOG, "/export/home/misc_logs/nukedboxes")){
   while(){
      push @log, $_;
   }
   close LOG;
   my $i=1;
   open(LOG, ">/export/home/misc_logs/nukedboxes.tmp") || die "cannot write to nukedboxes.tmp: $!\n";
   foreach my $line (reverse @log){
      print LOG $line;
      last if($i == 10000);
      $i++;
   }
   close LOG;

   rename("/export/home/misc_logs/nukedboxes.tmp","/export/home/misc_logs/nukedboxes")
     || die "cannot rename tmp: $!\n";
}
## end trim log


open(LOG, ">>/export/home/misc_logs/nukedboxes") || die "cannot open nukedboxes for append: $!\n";


getopts('v');

my $monthago = ($^T - 2592000);
my $threemonthago = ($^T - 7776000);

my ($vuid,$vgid,$vpopdir) = (getpwnam('vpopmail'))[2,3,7];

die "could not get properties of vpopmail user\n" unless(($vuid =~ /^\d+$/) && ($vgid =~ /^\d+$/));

print "building domains list...\n";
open(A, '/var/qmail/users/assign') || die "cannot open assign file: $!\n";
while(){
   if(/^\+[^:]+-:([^:]+):\d+:\d+:([^:]+):-::/){
		next if($1 eq 'graves.com' || $1 eq 'lists.broadviewnet.net');
      if((-f "$2/vpasswd") && (! -l $2)){
         $paths{$1} = $2;
      }
   }
}
close A;

while(my($domain,$dir) = each %paths){
   print "working on $domain\n";
   open(V, "$dir/vpasswd") || warn "cannot open $dir/vpasswd: $!\n"; # prolly permission prob
   while(){
      if(/^([^:]+):[^:]*:\d+:\d+:[^:]*:([^:]+):/){ # crypt may be empty for auto-fill passwd
         $mailbox = $1;
         $maildir = $2;
		
			next if((stat(${maildir}))[9] > $monthago); # if mailbox is newly created

			my $secondsago = (stat("$maildir/lastauth"))[9];
			if($threemonthago > $secondsago){
				print "removing mail for ${mailbox}\@${domain} ($secondsago)\n" if($opt_v);
				print LOG "[${date}]: removing mail for ${mailbox}\@${domain} ($secondsago)\n";
				if($mailbox eq 'postmaster'){
					unless(-f "${dir}/.qmail-postmaster"){
						if(open(Q, ">${dir}/.qmail-postmaster")){
							print Q "#\n";
							close Q;
						}else{
							warn "could not open $dir/.qmail-postmaster for writing: $!\n";
						}
					}
					my $n=0;
					foreach my $place ('new','cur'){
						if(opendir(D, "${maildir}/Maildir/${place}/")){
							foreach my $file (grep {!/^\./} readdir D){
								unlink("${maildir}/Maildir/${place}/${file}") || warn "cant unlink $file: $!\n";
								$n++;
							}
							closedir D;
						}
					}
					if($n > 0){
						print "removed $n messages from postmaster\@${domain}\n" if($opt_v);
						print LOG "[${date}]: removed $n messages from postmaster\@${domain}\n";
					}
				}else{
					if(-f "${maildir}/.qmail"){
						# forward exists - just nuke Maildir, and re-create
						print "forward found, nuking Maildir..\n" if($opt_v);
						print LOG "[${date}]: forward found, nuking Maildir..\n";
						die "will not remove ${maildir}\n" if(($maildir =~ /\.\./) || ($maildir =~ /\.\//) || ($maildir =~ /\;/));
						die "will not remove ${maildir}\n" unless($maildir =~ /\/vpopmail\/domains\//);
						system("rm -rf ${maildir}/Maildir/"); # gulp
						mkdir("${maildir}/Maildir/",0700) || die "could not create $maildir/Maildir/: $!\n";
						chown(${vuid},${vgid},"${maildir}/Maildir") || warn "could not chown $maildir/Maildir: $!\n";
						foreach my $newdir ('tmp','new','cur'){
							mkdir("${maildir}/Maildir/${newdir}",0700) || warn "could not create $maildir/Maildir/$newdir: $!\n";
							chown(${vuid},${vgid},"${maildir}/Maildir/${newdir}") || warn "could not chown $maildir/Maildir/$newdir: $!\n";
						}
					}else{
						print "vdeluser ${mailbox}\@${domain}..\n" if($opt_v);
						print LOG "[${date}]: vdeluser ${mailbox}\@${domain}..\n";
						system("${vpopdir}/bin/vdeluser ${mailbox}\@${domain}");
					}
				}
			}
		}
	}
	close V;
}