#!/usr/bin/perl
#-----------------------------------------------------------------------------
#
#  POPular -- A POP3 server and proxy for large mail systems
#
#  $Id: checksize,v 1.3 2001/02/09 15:59:07 sqrt Exp $
#
#  http://www.remote.org/jochen/mail/popular/
#
#-----------------------------------------------------------------------------
#
#  checksize
#
#  This script checks the size of all mailboxes. Mailboxes who are above
#  or near the quota are logged. Additionally a message is put into the
#  mailbox to notify the user about his full mailbox.
#
#-----------------------------------------------------------------------------
#
#  Copyright (C) 1999-2001  Jochen Topf <jochen@remote.org>
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
#
#-----------------------------------------------------------------------------

use strict;

my $POPDIR = "/pop";
my $MAXFILES = 2000;
my $WARNFILES = 1500;
my $MAXSIZE = 50_000_000;
my $WARNSIZE = 40_000_000;

my $DEFAULTQUOTA = 50;			# Default quota in MB.
my $WARNPERCENT = 90;			# Warn when X % of quota are reached
my $BOXLIST = "/etc/popular/mb";	# Directory with mailbox lists
my $FROM = "Mail Delivery System <Mailer-Daemon\@example.com>";
my $SUPPORTMAIL = "support\@example.com";

#-----------------------------------------------------------------------------

chdir($POPDIR) or die("Can't chdir to $POPDIR: $!\n");

my $all_number = 0;
my $all_size  = 0;
my %sumhist;
my ($num, $sum, %num, %sum);
my ($numflag, $sizeflag);
my $mailbox;

my @wday  = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
my @month = ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
             "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");

my $hostname = `hostname`;
chop $hostname;


my %boxhash;
foreach my $d (0x0..0xf) {
  open(LIST, "$BOXLIST/$d") or die("Can't open $BOXLIST/%d: $!\n");
  while(<LIST>) {
    next if (/^$/);
    next if (/^#/);
    chomp;
    my ($box, $quota) = split(/:/, $_, 2);
    $boxhash{$box} = $quota;
  }
  close LIST;
}


print <<"EOF";
Fl NSum NNew NCur  SizeSum  SizeNew  SizeCur Mailbox
------------------------------------------------------------------------------
EOF

foreach my $h (0x0 .. 0xf) {
  foreach my $d (0x00 .. 0xff) {
    my $dir = sprintf("%x/%02x", $h, $d);
    opendir(DIR, $dir) or die("Can't opendir $dir: $!\n");
    my @boxes = grep(!/\d$/, grep(!/^\./, readdir(DIR)));
    closedir(DIR);
    foreach my $box (@boxes) {
      CheckBox("$dir/$box",
	($boxhash{$box} ? $boxhash{$box} : $DEFAULTQUOTA) * 1024 * 1024);
    }
  }
}

print <<"EOF";
------------------------------------------------------------------------------

Number of Mailfiles: $all_number
 Bytes in Mailfiles: $all_size

EOF

print "Mailbox histogram:\n";
foreach my $c ("Empty",
               "< 10 kBytes",
               "< 100 kBytes",
               "< 1 MByte",
               ">= 1 MByte") {
  print "$c\t$sumhist{$c}\n";
}


exit 0;

#-----------------------------------------------------------------------------
sub CheckBox {
  my($dir, $quota) = @_;

  $mailbox = $dir;

  $num = 0;
  $sum = 0;
  $num{new} = 0;
  $num{cur} = 0;
  $sum{new} = 0;
  $sum{cur} = 0;

  foreach my $sd ("new", "cur") {
    opendir(DIR, "$dir/$sd") or die("Can't opendir $dir/$sd: $!\n");
    my @files = grep(!/^\./, readdir(DIR));
    closedir(DIR);
    $num += ($#files + 1);
    $num{$sd} += ($#files + 1);
    foreach my $file (@files) {
      if ($file =~ /_(\d+)$/) {
        $sum += $1;
        $sum{$sd} += $1;
      } else {
        my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
 		$ctime,$blksize,$blocks) = stat("$dir/$sd/$file");
        die("Can't stat $dir/$sd/$file: $!\n") unless (defined $dev);
        $sum += $size;
        $sum{$sd} += $size;
      }
    }
  }

  $sizeflag = ($sum >= $quota)                     ? "S" :
              ($sum >= $quota * $WARNPERCENT / 100 ? "s" : " ");
  $numflag  = ($num >= $MAXFILES)                  ? "N" :
              ($num >= $WARNFILES                  ? "n" : " ");

  $all_number += $num;
  $all_size   += $sum;

  if ($sum == 0) {
    $sumhist{"Empty"}++;
  } elsif ($sum < 10240) {
    $sumhist{"< 10 kBytes"}++;
  } elsif ($sum < 102400) {
    $sumhist{"< 100 kBytes"}++;
  } elsif ($sum < 1024 * 1024) {
    $sumhist{"< 1 MByte"}++;
  } else {
    $sumhist{">= 1 MByte"}++;
  }

  if (($sizeflag ne " ") || ($numflag ne " ")) {
    write;
    quotamail($dir, $sizeflag, $numflag, $quota);
  }
}


sub quotamail {
  my ($maildir, $sizeflag, $numflag, $quota) = @_;
 
  my $time = time();
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time);

  # BUG: this only works for the MET timezone
  my $timestring = sprintf("%s, %d %s %4d %02d:%02d:%02d %s", $wday[$wday],
	$mday, $month[$mon], $year+1900, $hour, $min, $sec,
	$isdst ? "+0200" : "+0100");

  my $mailbox = $maildir;
  $mailbox =~ s|=.*||;
  $mailbox =~ s|.*/||;

  my $subject = ($sizeflag eq "S") || ($numflag eq "N") ?
                "Mailbox-Quota ueberschritten" : "Mailbox-Quota Warnung";

  my $summb    = int($sum / 1024);
  my $sumcurmb = int($sum{cur} / 1024);

  my $text = <<"EOF";
Return-path: <>
Delivery-date: $timestring
Message-Id: <0QUOTA.$time\@$hostname>
From: $FROM
To: Mailbox $mailbox
Subject: $subject
Date: $timestring
X-Quotainfo: $numflag$sizeflag $num $num{new} $num{cur} $sum $sum{new} $sum{cur}
Mime-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Content-Transfer-Encoding: 8bit

Diese Nachricht wird automatisch einmal pro Nacht erzeugt bzw. aktualisiert.

In Ihrer Mailbox können bis zu $MAXFILES Mails mit ingesamt bis zu $quota MByte liegen.
Wenn Ihre Mailbox voll ist, dann können Sie keine weiteren Mails empfangen.
Weitere Mails, die für Sie ankommen, werden dann an den Absender
zurückgeschickt.

In Ihrer Mailbox '$mailbox' haben Sie zur Zeit $num Mails mit
ingesamt $summb kBytes.

EOF

  if ($num{cur} > 0) {
    $text .= <<"EOF";
Von diesen Mails haben Sie schon $num{cur} (mit insgesamt $sumcurmb KBytes)
gelesen.

EOF
  }

  if (($numflag eq "N") || ($sizeflag eq "S")) {
    $text .= <<"EOF";
Sie haben damit die Maximalgröße Ihrer Mailbox erreicht bzw. überschritten.
Es werden keine weiteren Mails für Sie angenommen.
EOF
  } else {
    $text .= <<"EOF";
Sie haben damit $WARNPERCENT% der Maximalgröße Ihrer Mailbox erreicht bzw.
überschritten. Diese Mail ist nur eine Hinweis, daß Sie Ihre Mails möglichst
bald lesen und löschen sollten.
EOF
  }

  $text .= <<"EOF";

Bitte lesen und löschen Sie Ihre Mails regelmäßig, dann gehen Sie sicher, daß
alle Mails Sie erreichen. Überprüfen Sie bitte, ob Sie Ihr Mailprogramm so
eingestellt haben, daß es Mails nach dem Herunterladen vom Server löscht.

Diese Mail wird automatisch erzeugt. Bei Fragen wenden Sie sich bitte an
$SUPPORTMAIL.

Mit freundlichen Grüßen

Ihr Mailsystem
EOF

  $text =~ s|\n|\r\n|g;

  open(QUOTA, ">$maildir/tmp/0QUOTA.$time") or return;
  print QUOTA $text;
  close QUOTA;
}


format =
@@ @>>> @>>> @>>> @>>>>>>> @>>>>>>> @>>>>>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$numflag, $sizeflag, $num, $num{new}, $num{cur}, $sum, $sum{new}, $sum{cur}, $mailbox
.