#!/usr/local/bin/perl

# Copyright (c) 2003-2004 by Jeremy Kister
# Author: Jeremy Kister <devel8 at jeremykister /dot/ com>
# Date: 20031030 03:48 (EDT)
# Function: run a manual check on [vpopmail] mail quotas
# version 1.42

# may specify -e <email address> for an email report
# may specify -f <filename> to save a csv file
# may specify -v for verbose
# may specify -q <quota_bytes> for static bytes quota (dont listen to quota in vpasswd files) 
# may specify -n <number_of_files> for static number of files quota
# may sepcify -m <mx regex> to check that the mx record(s) match this regex - will be case insensitive
#   ie: [abcd]\.mx\.example\.net  
#   doesnt work very well yet -- this feature is in development

# example syntax: mailquota.pl -e user@example.com -f /tmp/mailquota.csv -v -q 104857600 -n 2000
#  will:
#   send report to user@example.com
#   save report in /tmp/mailquota.csv
#   be more verbose
#   report users who's Maildir's are over 100MB
#   report users who have more than 2000 messages in their new/ or cur/ directory

# :set tabstop=3 makes me pretty

# take a look at http://jeremy.kister.net/

# NOTE: THERE ARE FUNNY CHARACTERS BELOW: COPY-AND-PASTE PROLLY WONT WORK (think wget)
#  this script could take quite some time --  use verbose for [some] reassurance
#  the more over quota mailboxes you have, the more memory this script will use

use Getopt::Std;
use Sys::Hostname;
use Date::Manip;

my $gzip = '/usr/local/bin/gzip';
my $uuencode = '/usr/bin/uuencode';
my $du = '/usr/bin/du -s -k'; # look in subdirs, and output in KBytes
my $sendmail = '/usr/lib/sendmail';

getopts('f:ve:q:n:d:');

die "cannot execute $du for disk usage (path/argument problem?)\n" if(`$du /dev/null 2>&1 >/dev/null`);

if(defined($opt_e)){
	if($opt_e !~ /^([a-z0-9_\.\+\-\?\^])+\@(([a-z0-9\-])+\.)+([a-z0-9]{2,4})+$/i){
		die "you specified -e, but $opt_e doesnt look like an email address\n";
	}
	die "cannot execute $gzip for compression\n" unless(-x $gzip);
	die "cannot execute $uuencode for encoding\n" unless(-x $uuencode);
	die "cannot execute $sendmail for sending mail\n" unless(-x $sendmail);
}
if(defined($opt_f)){
	open(N,">$opt_f") || die "cannot write to $opt_f: $!\n";
}
if(defined($opt_q) && ($opt_q < 1024)){
	die "you specified -q, but $opt_q isnt even 1 KB... (this value should be bytes - (1048576 = 1MB)) \n";
}

if(defined($opt_m)){
	# we only prefer dig because it has built-in timeouts for when an
	# authoritative server doesnt talk back to us
	if(-x "/usr/local/bin/dig"){
		$lookup="/usr/local/bin/dig mx";
	}elsif(-x "/usr/local/bin/dnsmx"){
		$lookup="/usr/local/bin/dnsmx";
	}else{
		die "i cant find either dnsmx (from djbdns) or dig (from bind).\n";
	}
}

if($opt_v){
	$| = 1; #flush
	@chars = ( "|", "/", "-", "\\" );
}

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

while(my($domain,$dir) = each %paths){
	print "working on $domain [  " if($opt_v);
	open(V, "$dir/vpasswd") || warn "cannot open $dir/vpasswd: $!\n"; # prolly permission prob
	while(<V>){
		if($opt_v){
			if($i >= 3){ $i = 0;
			}else{ $i++; }
			print "" . $chars[$i] . "]"; # will stutter because its not inside du
		}
		if(/^([^:]+):[^:]+:\d+:\d+:[^:]*:([^:]+):([a-zA-Z0-9]+)/){
			my $mailbox = $1;
			my $maildir = $2;
			my $quota = $3;

			my $quotakbytes = ($opt_q) ? ($opt_q/1024) : undef;
			my $quotanum = ($opt_n) ? $opt_n : undef;

			unless(defined($quotakbytes)){
				if($quota eq 'NOQUOTA'){
					print STDERR "WARNING: $mailbox\@$domain has no quota!!\n";
					next unless(defined($opt_n));
				}elsif($quota =~ /(\d+)S?/){ # dont want C
					my $quotabytes = $1;
					if($quotabytes < 1024){
						print STDERR "ERROR: $mailbox\@$domain has an unusable quota (less than 1KB) ($quota)\n";
						next;
					}else{
						$quotakbytes = ($1/1024);
					}
				}else{
					print STDERR "ERROR:  $mailbox\@$domain has a quota that I dont comprehend(1) ($quota)\n";
					next;
				}
			}
			unless(defined($quotanum)){
				if($quota eq 'NOQUOTA'){
					print STDERR "WARNING: $mailbox\@$domain has no quota!!\n";
					next unless(defined($quotakbytes));
				}elsif($quota =~ /(\d+)C/){ # number of files
					$quotanum = $1;
				}else{
					print STDERR "ERROR:  $mailbox\@$domain has a quota that I dont comprehend(2) ($quota) (perhaps you should specify -n N)\n";
					next;
				}
			}
				
			my ($usedkbytes) = split /\s+/, `$du $maildir`;
			my $total=0;
			foreach my $stat ('new','cur'){
				my $num=0;
				if(opendir(D, "$maildir/Maildir/$stat")){
					foreach(grep {!/^\./} readdir D){
						$num++;
					}
					closedir D;

					$$stat{"$mailbox\@$domain"} = $num;
					$total += $num;
				}else{
 				warn "couldnt open $maildir/Maildir/$stat: $!\n";
				}
			}
			if(($usedkbytes > $quotakbytes) || ($total > $quotanum)){
				$abusers{"$mailbox\@$domain"} = "${usedkbytes}/${quotakbytes}/${quotanum}";
				my $secondsago = ($^T - (stat("$maildir/lastauth"))[9]);
				my $parseddate = ParseDate("$secondsago seconds ago");
				$parseddate =~ s/(\d{2}:\d{2}\:\d{2})$/ $1/g; # no y10k bug ;)
				$lastauth{"$mailbox\@$domain"} = $parseddate;
			}else{
				undef $new{$email};
				undef $cur{$email};
			}
		}
	}
	close V;
	print "\n" if($opt_v);
}

while(my ($email,$quotainfo) = each %abusers){
	my ($usedkb,$quotakb,$msgsquota) = split (/\//, $quotainfo);
	my $usedbytes = ($usedkb * 1024);
	if($usedkb >= 1048576){
		$storage = sprintf("%.2f",($usedkb/1048576)) . " GB";
	}elsif($usedkb >= 1024){
		$storage = sprintf("%.2f",($usedkb/1024)) . " MB";
	}else{
		$storage = $usedkb . " KB";
	}
	if($quotakb >= 1048576){
		$quota = sprintf("%.2f",($quotakb/1048576)) . " GB";
	}elsif($quotakb >= 1024){
		$quota = sprintf("%.2f",($quotakb/1024)) . " MB";
	}else{
		$quota = $quotakb . " KB";
	}

	# find out if the abusive domain has MX to us (non-abusers dont get MX checked)
	if(defined($opt_m)){
		my $sawourmx = undef;
		($nul,$domain) = split(/\@/, $email);
		unless(exists($notourmx{$domain})){
			foreach(`$lookup $domain`){
				if(/$opt_m/i){
					$sawourmx=1;
					last;
				}
			}
			unless(defined($sawourmx)){
				$notourmx{$domain} = 1; # mx lookups are more expensive than memory
			}
		}
	}
	if($opt_e || $opt_f){
		my $string = "$email,$usedbytes,$storage,$quota,$new{$email},$cur{$email},$msgsquota,$lastauth{$email}";
		if(defined($opt_m) && (exists($notourmx{$domain}))){
			$string .= ",*NotOurMX*";
		}
		push @array, "$string\n";
	}else{
		print "$email is using $storage/$quota (last auth: $lastauth{$email} - $new{$email} unread, $cur{$email} read)";
		if(defined($opt_m) && (exists($notourmx{$domain}))){
			print " *NotOurMX*";
		}
		print "\n";
	}
}
if($opt_e){
	open(T, ">/tmp/mailquotas.$$.csv") || die "cannot open /tmp/mailquotas.$$.csv: $!\n";
	print T "email address,used bytes,maildir size,size quota,unread msgs,read msgs,msgs quota,last auth";
	if(defined($opt_m)){
		print T ",MX Status";
	}
	print T "\n";
	foreach(@array){
		print T;
	}
	close T;
	# may clear memory as long as we're not saving to a file via $opt_f
	@array = undef unless(defined($opt_f));

	system("$gzip -9 /tmp/mailquotas.$$.csv");
	$boundary="___JK.RIAA_SUCKS&FUCK_VERISIGN.JK___";
	$hostname=hostname();
	if(open(S, "| $sendmail -t")){
		print S "From: $hostname MailServer <mailserver\@$hostname>\n",
			"To: SysOp <$opt_e>\n",
			"Subject: Mail Quotas on $hostname\n",
			"Mime-Version: 1.0\n",
			"Content-Type: multipart/mixed;\n",
		        "\tboundary=\"$boundary\"\n",
			"\n",
			"This is a multi-part message in MIME format.\n",
			"\n",
			"--$boundary\n",
			"Content-Type: text/plain;\n",
		        "\tcharset=\"iso-8859-1\"\n",
		        "Content-Transfer-Encoding: 7bit\n",
			"\n",
			"Enclosed is mailquotas.csv.gz - open and extract attachment to view utilizations in Excel.\n",
			"\n",
			"--$boundary\n",
			"Content-Type: application/x-gzip;\n",
		        "\tname=\"mailquotas.csv.gz\"\n",
		        "Content-Transfer-Encoding: uuencode\n",
			"Content-Disposition: attachment;\n",
		        "\tfilename=\"mailquotas.csv.gz\"\n",
			"\n";
			open(C,"$uuencode /tmp/mailquotas.$$.csv.gz mailquotas.csv.gz |") || die "cannot fork uuencode: $!\n";
			while(<C>){
				print S;
			}
			print S "\n",
			        "--$boundary--\n";
		close S;
		unlink("/tmp/mailquotas.$$.csv.gz") || warn "couldnt delete /tmp/mailquotas.$$.csv.gz: $!\n";
	}else{
		warn "cannot fork sendmail: $!\n";
	}
}
if($opt_f){
	print N "email address,used bytes,maildir size,size quota,unread msgs,read msgs,msgs quota,last auth";
	if(defined($opt_m)){
		print N ",MX Status";
	}
	print N "\n";
	foreach(@array){
		print N;
	}
	close N;
}
