#!/usr/bin/perl
# Script to expire trash folders.  Hardcoded to 7 days.
# Munged from mbox-expire.pl 08/15/2005 kdeugau@vianet

# Some filesystem modules:
use Fcntl qw(:DEFAULT :flock);

# Time
use Time::Local;

# First, we set some defaults.
#if ([0] eq "") {
#  die "No user specified!\n";
#} else {
#  if ($ARGV[1] == "") {
    $period = 7;
    $units = "d";
#  } else {
#    $period = $ARGV[1];
#    if ($ARGV[2] == "") {
#      $units = "d";
#    } else {
#      $units = $ARGV[2];
#    }
#  }
#}
$nmsgs=0;

# how many seconds in 30 days?
if ($units == "d") {
  $timediff = $period*24*60*60;
} elsif ($units == "m") {
# nominal 30 days in a month;
  $timediff = $period*30*24*60*60;
}

# some hashes for turning "Mon" or "Oct" into a number usable by timegm()
%months = ('Jan',0,'Feb',1,'Mar',2,'Apr',3,'May',4,'Jun',5,'Jul',6,'Aug',7,'Sep',8,'Oct',9,'Nov',10,'Dec',11);

@trashlist = `ls -l /home/*/mail/Trash`;
print "Emptied 'Trash' folders:\n";
foreach (@trashlist) {

  chomp;
# -rw-rw-rw-    1 nobody   mail_pop        0 Sep 30  2002 /home/leavey/mail/Trash
  @bits = split /\s+/;
  $folder = $bits[8];
#next if $folder ne '/home/saken/mail/Trash';
#print "$bits[4]\t$folder\n";

  $nmsgs = 0;
  $unexpired = 0;

  # Flow:
  # -> Open folder.  Lock it so procmail (or imapd) can't write new
  #    data while we're busy expiring old data.  This process
  #    *shouldn't* take long;  YMMV.

  sysopen(MAILBOX, "$folder", O_RDWR|O_CREAT)
    or warn "Can't open $folder: $!";
  flock(MAILBOX, LOCK_EX)
    or warn "Can't lock $folder: $!";

  # We don't really need to lock this file;
  open CURRENTMAIL, ">$folder.lock";

  # -> Start separating messages apart.  Be *very* careful about
  #    parsing the "From " semantics;  make sure the *entire* line
  #    is properly formed!  We're going to be a little more
  #    restrictive than the RFCs on email address formatting;
  #    while spaces are nominally technically *valid*, they're
  #    usually *ignored*.  Among other things.

  while (<MAILBOX>) {
  # read data
    if ($unexpired==1) {
  # -> Once we reach a message that's "OK", we start stuffing
  #    data into a temporary file (spam.lock, preferably).  Once
  #    finished, we can close and reopen that file (ugh) and move
  #    the data back to the original file.
      print CURRENTMAIL;
    } else {
      if (/^From /) {
        $nmsgs++;
        $fromline = $_;
  # -> Compare the received date (on Filtermail) for each message
  #    to the current date.  If the listed date is beyond the
  #    boundary, drop the message and continue on to the next.
  # We can do this quite neatly with the "From " line, as it's
  # generated locally.  Heheheh.  :)

  # A bunch of things have broken my parsing of "From " lines.  So we do this the hard way by
  # splitting the whole thing, then counting from the end.  Ick.
        @frombits = split /\s+/;
        $fromnum = @frombits;
	# Another hack for f#$^#$%#'ed up "From " lines.  GRRR.
	if ($frombits[$fromnum-1] =~ /-/) { $offset=1; } else { $offset=0; }
        $wday = $frombits[$fromnum-5-$offset];
        $month = $frombits[$fromnum-4-$offset];
        $mday = $frombits[$fromnum-3-$offset];
        $dtime = $frombits[$fromnum-2-$offset];
        $year = $frombits[$fromnum-1-$offset];
        @daybits = split /:/, $dtime;
        $msgtstamp = timegm($daybits[2], $daybits[1], $daybits[0], $mday, $months{$month}, $year-1900);
        $msgtstamp += $timediff;
        if ($msgtstamp > time()) {
          # Set a flag!  We've got unexpired spam.
          $unexpired = 1;
          $nmsgs--;
          print CURRENTMAIL $fromline;
        }
      }
    }
  }

  # Reopen the "unexpired" spam for reading...
  close CURRENTMAIL;
  open CURRENTMAIL, "<$folder.lock";

  # ... rewind to the beginning of the original file and truncate...
  seek(MAILBOX, 0, 0);
  truncate(MAILBOX,0)
    or die "Can't truncate original folder: $!";

  # ... and stream data from CURRENTMAIL
  while (<CURRENTMAIL>) {
    print MAILBOX;
  }

  close CURRENTMAIL;

  # Remove the .lock file, as it's no longer needed.  We *might* be
  # able to remove it while it's open... but I wouldn't count on
  # being able to do so.
  unlink "$folder.lock";

  print "Expired $nmsgs messages from $folder.\n" if $nmsgs > 0;

  # Let this happen implicitly, to force proper buffer flushes *before* unlocking files.
  #close MAILBOX;

}
