#!/usr/bin/perl
#-----------------------------------------------------------------------------
#
#  POPular -- A POP3 server and proxy for large mail systems
#
#  $Id: pclean,v 1.4 2001/02/09 15:59:07 sqrt Exp $
#
#  http://www.remote.org/jochen/mail/popular/
#
#-----------------------------------------------------------------------------
#
#  pclean
#
#  This script does (nightly) mailbox cleanup, expire of mailboxes, etc.
#
#-----------------------------------------------------------------------------
#
#  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
#
#-----------------------------------------------------------------------------

#-----------------------------------------------------------------------------
#
#  TODO
#
#  - master check: file format, ownership, permissions
#  - Quota File should not count towards quota when delivering and checking
#  - expire time vars are a mess
#  - histgram for: mailsize, mailbox size
#
#-----------------------------------------------------------------------------

use strict;
use Getopt::Std;

my %opts;
getopts('Dtescmbnf:', \%opts);

$opts{'D'} = 1 if ($opts{'n'});	# -n implies -D
$opts{'s'} = 1 if ($opts{'m'});	# -m implies -s


#-----------------------------------------------------------------------------
#  START OF OPTIONS
#-----------------------------------------------------------------------------
my $POPDIR  = "/pop";
my $BOXLIST = "/etc/popular/mb";
my $LOGFILE = "/var/log/popular/pclean";

# number of days after which mails in the backup of a deleted mailbox are
# removed
my $EXPIRETIME_BACKUP = 30;

# maximum number of files in one mailbox
my $QUOTA_FILENUM = 1000;

my $WARN_FILENUM = 800;

my $QUOTA_WARNPERCENT = 90;

# hash with expire times in days for each namespace. 
#
my %EXPIRETIME = ("BACKUP",  { 'new' =>  30, 'cur' =>  30 },
		  "example", { 'new' => 360, 'cur' => 120 },
		  "noexp",   { 'new' =>   0, 'cur' =>   0 },
                 );

# Time in seconds after which a mail file in 'tmp' is considered stale and
# will be removed.
my $STALETIME = 60 * 60 * 24;


#-----------------------------------------------------------------------------
#  END OF OPTIONS
#-----------------------------------------------------------------------------

my $NOW = time();
my %EXP;
foreach (keys(%EXPIRETIME)) {
  if ($EXPIRETIME{$_}->{'new'}) {
    $EXP{$_}->{'new'} = $NOW - $EXPIRETIME{$_}->{'new'} * 60 * 60 * 24;
  }
  if ($EXPIRETIME{$_}->{'cur'}) {
    $EXP{$_}->{'cur'} = $NOW - $EXPIRETIME{$_}->{'cur'} * 60 * 60 * 24;
  }
}


my $DEBUG_INDENT_LEVEL = 0;
my $ERROR_COUNT = 0;

my $stat = {};

my $timestamp = timestamp();

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


my $boxhash = GetBoxHash();
my $dirlist = GetDirList();

foreach my $dir (@$dirlist) {
  if (! -d $dir) {
    Debug("No directory $dir");
    next;
  }
  Debug("Directory $dir {");
  my $mailboxes = ScanDir($dir);
  foreach my $mailbox (@$mailboxes) {
    my $x = "$dir/$mailbox";
    my $mb = new Mailbox $dir, $mailbox, $boxhash->{"$dir/$mailbox"};
    next unless ($mb);
    Debug("Mailbox $mailbox {");
    Debug("dir=$mb->{'dir'} mailbox=$mb->{'mailbox'} ns=$mb->{'namespace'} state=$mb->{'state'} quota=$mb->{'quota'}");
    if ($mb->{'state'} eq "BACKUP") {
      # this mailbox is a backup of a deleted box
      $mb->Expire() if ($opts{'e'});
      $mb->PurgeIfEmpty();
    } elsif ($mb->{'state'} eq "ACTIVE") {
      # this mailbox is active
      $mb->CheckTmp() if ($opts{'t'});
      $mb->Expire() if ($opts{'e'});
      $mb->CheckSize() if ($opts{'s'});
      $mb->QuotaMail() if ($opts{'m'});
      $mb->CheckAll() if ($opts{'c'});
    } elsif ($mb->{'state'} eq "OLD") {
      # this mailbox is deleted
      $mb->DeleteMailbox() if ($opts{'b'});
    } else {
      # should never be here
      Error("Unknown mailbox state. Should never be here.");
      exit(1);
    }
    $mb->UpdateStat();
    Debug("}");
  }
  Debug("}");
}

Mailbox::PrintStat();

Debug("There were $ERROR_COUNT errors!") if ($ERROR_COUNT);

exit($ERROR_COUNT > 0);


#-----------------------------------------------------------------------------
#
#  Usage()
#
#  Print command line help
#
#-----------------------------------------------------------------------------
sub Usage {
  print <<"EOF";
pclean [OPTIONS]

  -D		Print debug messages (Be careful! This is really verbose)
  -t		Check tmp directories for old files
  -e		Expire mailbox contents
  -s		Check and report size of all mailboxes
  -c		Check names, ownership, and permissions of all dirs/files
  -m		Put mail in mailboxes that are over quota (implies -c)
  -b		Backup deleted mailboxes
  -f <file>	Read options from this file
  -n		Don't do anything, just print what you would do (implies -D)

EOF
}

#-----------------------------------------------------------------------------
sub timestamp {
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);

  return sprintf("%04d%02d%02d.%02d%02d%02d",
			$year+1900, $mon+1, $mday, $hour, $min, $sec);
}


#-----------------------------------------------------------------------------
#
#  Debug(), Warn(), Error()
#
#  Output functions.
#  
#-----------------------------------------------------------------------------
sub Debug {
  my ($text) = @_;

  return unless ($opts{'D'});
  $DEBUG_INDENT_LEVEL-- if ($text =~ /\}/);
  print "      ", "  " x $DEBUG_INDENT_LEVEL, "$text\n";
  $DEBUG_INDENT_LEVEL++ if ($text =~ /\{/);
}


sub Warn {
  my ($text) = @_;

  print "WARN  ", "  " x $DEBUG_INDENT_LEVEL, "$text\n";
}


sub Error {
  my ($text) = @_;

  print "ERROR ", "  " x $DEBUG_INDENT_LEVEL, "$text\n";
  $ERROR_COUNT++;
}


#-----------------------------------------------------------------------------
#
#  $files = ScanDir($dir)
#
#  Scans the given directory and returns reference to an array of file names.
#  Names starting with a dot are not included in the output.
#
#-----------------------------------------------------------------------------
sub ScanDir {
  my ($dir) = @_;

  if (! opendir(DIR, $dir)) {
    Error("Can't opendir '$dir': $!");
    return [];
  }
  my @files = grep(!/^\./, readdir(DIR));
  closedir(DIR);
  return \@files;
}


#-----------------------------------------------------------------------------
#
#  GetBoxHash
#
#  This function returns a reference to a hash containing a mapping between
#  mailbox name and quota for this mailbox. This hash can be huge, if you
#  have lots of mailboxes.
#
#-----------------------------------------------------------------------------
sub GetBoxHash {
  my %boxhash;

  foreach my $d (0..9, 'a', 'b', 'c', 'd', 'e', 'f') {
    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;
  }
  return \%boxhash;
}


#-----------------------------------------------------------------------------
#
#  GetDirList
#
#  This function returns a reference to an array containing all the
#  directories where mailboxes can be stored. All directories must be relative
#  to $POPDIR. You can return directories that don't exist, they will be
#  silently skipped.
#
#  You will have to change this function, if your mailbox directory layout
#  is different from the default layout.
#
#-----------------------------------------------------------------------------
sub GetDirList {
  my @dirs;

  foreach my $d (0x0..0xf) {
    foreach my $n (0x00..0xff) {
      my $dir = sprintf("%x/%02x", $d, $n);
      push(@dirs, $dir);
    }
  }

  return \@dirs;
}


#-----------------------------------------------------------------------------
#
#  GetSize()
#
#  Gets size of a mailbox file. If the mailbox name is in the right format,
#  the size is taken from the name, otherwise a stat() is performed.
#
#-----------------------------------------------------------------------------
sub GetSize {
  my ($filename) = @_;

  if ($filename =~ /_(\d+)$/) {
    return($1);
  } else {
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
	$ctime,$blksize,$blocks) = stat($filename);
    return 0 unless (defined $dev);
    return $size;
  }
}


#-----------------------------------------------------------------------------
#-----------------------------------------------------------------------------
#
#  Mailbox Package
#
#-----------------------------------------------------------------------------
#-----------------------------------------------------------------------------
package Mailbox;

sub new {
  my ($class, $dir, $mailbox, $quota) = @_;

  my($self) = {
    'dir'      => $dir,
    'filename' => $mailbox,
    'path'     => "$dir/$mailbox",
    'quota'    => $quota * 1024 * 1024,
    'size'     => { 'new' => 0, 'cur' => 0 },
    'count'    => { 'new' => undef, 'cur' => undef },
    'mails'    => { 'new' => undef, 'cur' => undef, 'tmp' => undef },
  };
  
  if ($mailbox =~ /^([-a-z0-9._]+)=([-a-z0-9._]+)_(\d{8}\.\d{6})$/) {
    $self->{'mailbox'}   = $1;
    $self->{'namespace'} = $2;
    $self->{'deltime'}   = $3;
    $self->{'state'}     = "BACKUP";
    $self->{'expire'}    = $EXPIRETIME{'BACKUP'};
  } elsif ($mailbox =~ /^([-a-z0-9._]+)=([-a-z0-9._]+)$/) {
    $self->{'mailbox'}   = $1;
    $self->{'namespace'} = $2;
    $self->{'expire'}    = $EXPIRETIME{$self->{'namespace'}};
    if ($quota) {
      $self->{'state'}   = "ACTIVE";
    } else {
      $self->{'state'}   = "OLD";
    }
  } else {
    ::Error("Wrong format for mailbox name: '$dir/$mailbox'");
    return undef;
  }

  bless($self, (ref($class) || $class));
}


#-----------------------------------------------------------------------------
#
#  $mailbox->ListMails($dir);
#
#  Returns a reference to a list of all mails in the named subdirectory
#  ('new', 'cur' or 'tmp'). The first time this function is called for a
#  given subdirectory the directory is scanned and the content cached. Any
#  subsequent call to this function will return the cached info.
#
#-----------------------------------------------------------------------------
sub ListMails {
  my ($self, $dir) = @_;

  if (! $self->{'mails'}->{$dir}) {
    $self->{'mails'}->{$dir} =
	::ScanDir("$self->{'path'}/$dir") unless ($self->{$dir});
  }

  return $self->{'mails'}->{$dir};
}


#-----------------------------------------------------------------------------
#
#  $mailbox->CountMails($dir);
#
#  Returns the number of mails in the subdirectory $dir ('new', 'cur' or
#  'tmp'). The first time this function is called, it will actually look
#  at the directories and cache the results in case this function is called
#  again.
#
#-----------------------------------------------------------------------------
sub CountMails {
  my ($self, $dir) = @_;

  if (! defined $self->{'count'}->{$dir}) {
    $self->{'count'}->{$dir} = $#{$self->ListMails($dir)} + 1;
  }

  return $self->{'count'}->{$dir};
}


#-----------------------------------------------------------------------------
#
#  $mailbox->CheckAll();
#
#-----------------------------------------------------------------------------
sub CheckAll {
  my $self = shift;
}


#-----------------------------------------------------------------------------
#
#  $mailbox->CheckTmp();
#
#  This function checks the tmp directory of this mailbox for stale files.
#  Anything older than $STALETIME seconds is deleted.
#
#-----------------------------------------------------------------------------
sub CheckTmp {
  my $self = shift;

  ::Debug("Checking tmp directory {");
  foreach my $file (@{$self->ListMails('tmp')}) {
    if ($file =~ /^([0-9]*)\./) {
      if ($NOW - $1 > $STALETIME) {
        ::Debug("File '$file' is stale. Deleting...");
        next if ($opts{'n'});
        if (! unlink("$self->{'path'}/tmp/$file")) {
          ::Error("Can't unlink file: $!");
        }
      } else {
        ::Debug("File '$file' is ok.");
      }
    } else {
      ::Error("Name of file '$file' has wrong format.");
    }
  }
  ::Debug("}");
}


#-----------------------------------------------------------------------------
#
#  $mailbox->DeleteMailbox();
#
#  Deletes a mailbox by renaming the mailbox directory to another name.
#
#-----------------------------------------------------------------------------
sub DeleteMailbox {
  my $self = shift;

  ::Debug("Deleting mailbox... (Backup in '$self->{'path'}_$timestamp')");

  return if ($opts{'n'});

  # We have to count the number of mails in the mailbox in case we need it
  # later. After the rename we won't find the mailbox anymore...
  $self->CountMails('new');
  $self->CountMails('cur');

  rename($self->{'path'}, "$self->{'path'}_$timestamp") or
    ::Error("Can't rename '$self->{'path'}' to '$self->{'path'}_$timestamp': $!");
}


#-----------------------------------------------------------------------------
#
#  $mailbo->CheckSize()
#
#  Checks the size of the mailbox, by counting the mails in the 'new' and
#  'cur' directories, getting their sizes ans summing it all up. Compares
#  this to the quota defined for this mailbox.
#
#-----------------------------------------------------------------------------
sub CheckSize {
  my $self = shift;

  foreach ('new', 'cur') {
    foreach my $file (@{$self->ListMails($_)}) {
      $self->{'size'}->{$_} += ::GetSize("$self->{'path'}/$_/$file");
    }
  }

  my $ssum = $self->{'size'}->{'new'} + $self->{'size'}->{'cur'};
  my $csum = $self->CountMails('new') + $self->CountMails('cur');

  if ($ssum >= $self->{'quota'}) {
    $self->{'sizeflag'} = 'S';
  } elsif ($ssum >= $self->{'quota'} * $QUOTA_WARNPERCENT / 100) {
    $self->{'sizeflag'} = 's';
  } else {
    $self->{'sizeflag'} = ' ';
  }

  if ($csum >= $QUOTA_FILENUM) {
    $self->{'countflag'} = 'N';
  } elsif ($csum >= $WARN_FILENUM) {
    $self->{'countflag'} = 'n';
  } else {
    $self->{'countflag'} = ' ';
  }

  ::Debug(sprintf("CheckSize: %s%s new=%d/%d cur=%d/%d sum=%d/%d", $self->{'sizeflag'}, $self->{'countflag'}, $self->{'size'}->{'new'}, $self->CountMails('new'), $self->{'size'}->{'cur'}, $self->CountMails('cur'), $ssum, $csum));
}


#-----------------------------------------------------------------------------
#
#  $mailbox->QuotaMail()
#
#  Puts a warning mail into mailboxes, which are over or near the quota limits.
#
#-----------------------------------------------------------------------------
sub QuotaMail {
  my $self = shift;
}


#-----------------------------------------------------------------------------
#
#  $mailbox->PurgeIfEmpty();
#
#  This will delete a mailbox if it is empty.
#
#-----------------------------------------------------------------------------
sub PurgeIfEmpty {
  my $self = shift;

  return if ($#{$self->ListMails('cur')} + $#{$self->ListMails('new')} > 0);
  ::Debug("Purging mailbox because it is empty");
  if (! $opts{'n'}) {
# XXX return code
#    rmdir("$self->{'path'}/new");
#    rmdir("$self->{'path'}/cur");
#    rmdir("$self->{'path'}/tmp");
#    rmdir("$self->{'path'}");
  }
}


#-----------------------------------------------------------------------------
#
#  $mailbox->ExpireMailbox();
#
#  Expires content of the given mailbox. Unread mails older then $newtime
#  are deleted and read mails older then $curtime are deleted. Both times
#  can be 0, in which case no mails will be expired.
#
#-----------------------------------------------------------------------------
sub ExpireMailbox {
  my $self = shift;

  my $exnew = $self->{'expire'}->{'new'};
  my $excur = $self->{'expire'}->{'cur'};

  foreach my $d ("cur", "new") {
    next unless ($self->{'expire'}->{$d});
    ::Debug("Expiring $d... {");
    foreach my $file (@{$self->ListMails($d)}) {
      if ($file =~ /^([0-9]+)\./ && $EXP{$self->{'namespace'}}->{$d} < $1) {
        ::Debug("loeschen");
# XXX
      }
    }
    ::Debug("}");
  }
}


#-----------------------------------------------------------------------------
#
#  $mailbox->UpdateStat();
#
#  Update statistics.
#
#-----------------------------------------------------------------------------
sub UpdateStat {
  my $self = shift;

  my $ns = $self->{'namespace'};
  foreach ('new', 'cur') {
    $stat->{$ns}->{'mails'}->{$_} += $self->CountMails($_);
    $stat->{$ns}->{'size'}->{$_}  += $self->{'size'}->{$_};
  }
  $stat->{$ns}->{'sumquota'}    += $self->{'quota'} / 1024 / 1024;
  $stat->{$ns}->{'overquota'}++ if (($self->{'countflag'} eq 'N') ||
				    ($self->{'sizeflag'} eq 'S'));
  $stat->{$ns}->{'active'}++    if ($self->{'state'} eq 'ACTIVE');
  $stat->{$ns}->{'old'}++       if ($self->{'state'} eq 'OLD');
  $stat->{$ns}->{'backup'}++    if ($self->{'state'} eq 'BACKUP');
}


#-----------------------------------------------------------------------------
#
#  Mailbox::PrintStat();
#
#  Print statistics.
#
#-----------------------------------------------------------------------------
sub PrintStat {
  print "------------------------------------------------------------------------------\n";
  print "Statistics:\n";
  foreach my $ns ('surf1') {		# XXX ns
    print "------------------------------------------------------------------------------\n";
    print "  Namespace: $ns\n\n";
    printf "  Mailboxes (ACTIVE): %8d\n", $stat->{$ns}->{'active'};
    printf "  Mailboxes (BACKUP): %8d\n", $stat->{$ns}->{'backup'};
    printf "  Mailboxes (OLD)   : %8d\n", $stat->{$ns}->{'old'};
    printf "  Mailboxes (Total) : %8d\n\n", ($stat->{$ns}->{'active'} + $stat->{$ns}->{'backup'} + $stat->{$ns}->{'old'});
    print "  Total quota of of all mailboxes: $stat->{$ns}->{'sumquota'} MBytes\n\n";
    print "  Number of mailboxes above quota: $stat->{$ns}->{'overquota'}\n\n" if (defined $stat->{$ns}->{'overquota'});
    printf "  Number of mails (new) : %12d\n", $stat->{$ns}->{'mails'}->{'new'};
    printf "  Number of mails (read): %12d\n", $stat->{$ns}->{'mails'}->{'cur'};
    printf "  Size of all mails (new) : %12d\n", $stat->{$ns}->{'size'}->{'new'} if ($stat->{$ns}->{'size'}->{'new'});
    printf "  Size of all mails (read): %12d\n", $stat->{$ns}->{'size'}->{'cur'} if ($stat->{$ns}->{'size'}->{'cur'});
    print "------------------------------------------------------------------------------\n";
  }
}


#-- THE END ------------------------------------------------------------------