#!/usr/bin/perl -w

use strict;
use IO::File;
use File::Find;
use Getopt::Std;

my %opts;
my %q;
my @total;
my $now = time;
my $bnum = 9;

getopts("c:",  \%opts);
$ENV{q{MAIL_CONFIG}} = $opts{q{c}} if (exists $opts{q{c}});
chomp(my $qdir = qx{/usr/sbin/postconf -h queue_directory});
chdir($qdir) || die "chdir($qdir): $!\n";

sub rec_get {
    my ($h) = @_;
    my $r = getc($h) || return;
    my $l = 0;
    my $shift = 0;
    while (defined(my $lb = getc($h))) {
	my $o = ord($lb);
	$l |= ($o & 0x7f) << $shift ;
	last if (($o & 0x80) == 0);
	$shift += 7;
	return if ($shift > 7);	# XXX: max rec len of 4096
    }
    my $d;
    return unless ($l == 0 || read($h,$d,$l) == $l);
    ($r, $l, $d);
}

sub qenv {
    my ($qfile) = @_;
    my $h = new IO::File($qfile, "r") || return;
    my ($t, $s, @r, $dlen);
    while (my ($r, $l, $d) = rec_get($h)) {
	if ($r eq "C") { $dlen = $1 if $d =~ /^\s*(\d+)\s+\d+\s+\d+/; }
	elsif ($r eq "T") { $t = $d; }
	elsif ($r eq "S") { $s = $d; }
	elsif ($r eq "R") { push(@r, $d); }
	elsif ($r eq "M") { last unless defined $dlen; seek($h, $dlen, 1); }
	elsif ($r eq "E") { last; }
    }
    close($h);
    ($t, $s, @r);
}

sub bucket {
    my ($qt, $now) = @_;
    my $m = ($now - $qt) / 300;
    return 2 if ($m < 1);
    my $b = 3 + int(log($m) / log(2));
    $b < $bnum ? $b : $bnum;
}

sub qfile {
    my ($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_[0]) or return;
    -f _ && (($mode & 07777) == 0700);
}

sub pdom {
    my ($dom, @count) = @_;
    print((length($dom) > 38) ? substr($dom, 0, 38) :
	  ((" " x (38 - length($dom))) . $dom));
    printf(" %4s", shift(@count));
    printf(" %3s", $_) for splice(@count, 0, $#count);
    printf(" %4s", shift(@count));
    print "\n";
}

# Count complete messages in "active" queues.
#
my $w = sub {
	my %dup = ();
	if (qfile($_) && (my ($t, $s, @r) = qenv($_))) {
	    ++$total[0];
	    ++$total[1];
	    foreach my $r (map {lc($_)} @r) {
		$r =~ s/.*\@//;
		$r =~ s/\.$//;
		$r =~ s/\.\.+$/./;
		if (++$dup{$r} == 1) {
		    ++$q{$r}->[1];
		    ++$q{$r}->[0];
		}
	    }
	}
    };
find($w, qw(incoming maildrop active));

# Collate by age of message in deferred queue
#
$w = sub {
	my %dup;
	if (qfile($_) && (my ($t, $s, @r) = qenv($_))) {
	    my $b = bucket($t, $now);
	    ++$total[0];
	    ++$total[$b];
	    foreach my $r (map {lc($_)} @r) {
		$r =~ s/.*\@//;
		$r =~ s/\.$//;
		$r =~ s/\.\.+$/./;
		if (++$dup{$r} == 1) {
		    ++$q{$r}->[$b];
		    ++$q{$r}->[0];
		}
	    }
	}
    };
find($w, "deferred");

for my $dom (keys %q) {
    my $buckets = $q{$dom};
    $#$buckets = $bnum;
    $_ ||= 0 for (@$buckets);
}
$#total = $bnum; $_ ||= 0 for(@total);

pdom("", "T", "A", "5", "10", "20", "40", "80", "160", "320", "320+");
pdom("TOTAL", @total);
for my $dom (sort {$q{$b}->[0] <=> $q{$a}->[0]} keys %q) {
    pdom($dom, @{$q{$dom}});
}