#!/usr/bin/perl

# SEE DEBIAN CHANGELOG FOR NEWER ENTRIES

# mail-expire, Version 0.2; Fri, 16 Aug 2002 11:39:10 +0200
# Copyright: Eduard Bloch <blade@debian.org>
#
# This file 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. The full text of GPL can be
# found on http://www.gnu.org or in /usr/share/common-licenses/GPL on
# modern Debian systems.
#
# ----------------------------------------------------------
# If you make changes to this script, please forward the new 
# version to <blade@debian.org> or <eduard@bloch.com>
# ----------------------------------------------------------
# 
# REQUIRED PACKAGES:
#
# libcompress-zlib-perl - Perl module for creation of gzip files 
# libdate-calc-perl - Perl library for accessing dates
# 
# Changes by Johannes Kolb:
#  * use Date::Calc instead of Date::Manip to increase performance
#  * no buffering of whole mailbox-files in memory
#
# Changes by Florian Krohs <krohs@uni.de>
#  * append old mails to mailbox.month_year.gz
#  * added zlib to free some space:]
#
# Changes by Eduard Bloch <blade@debian.org>
#  * small hack to vary the output filename to prevent overwritting
#  * some cosmetics, fixed typos
#  * dropped silly size comparison, trust return values of syswrite

$target="./";

SCANA:

while($#ARGV>=0) {
   $arg = $ARGV[$_];
   if($arg=~/^--?(\w+)/) {
      $uoption=($arg eq "-u");
      $deloption=($arg eq "--delete");
      if($toption=($arg eq "-t")) {
         $target = $ARGV[$_+1];
         shift(@ARGV);
      }
      shift(@ARGV);
   }
   elsif($arg=~/^(\d+)$/) {
      $days = $1;
      shift(@ARGV);
      last SCANA;
   }
   else
   {
      $tell_and_die=1;
      shift(@ARGV);
   }
}

#print "del: $deloption u: $uoption\n"; die;

die "Usage: $0 [ options ] DAYS FILES
where
DAYS is an integer specifying the maximum age of a mail in days and
FILES one or more mbox file(s).

Options:
  -u        choose different filenames if the target file already exists
  --delete  drops the old messages. Be warned, no backup will be made!
  -t DIR    new target directory DIR

" if ($tell_and_die || $#ARGV < 0 || (!defined($days)));
use Date::Calc qw(Parse_Date Today Delta_Days);
use Compress::Zlib ;
use Fcntl;

$c=-1;
@today = Today();
$old_all = localtime(time - $days * 86400);
$old_all =~ s/\ +/\ /g;
@splitdate=split(/\ /,$old_all);
$olddate=$splitdate[1] . "_" . $splitdate[4] . ".gz";

JOB: 
foreach $file (0..$#ARGV) {
   undef @st;
   undef @time;
   undef $c;

   $oldsize = (stat("$ARGV[$file]"))[7];
   if ($oldsize == 0) {
      syswrite(STDOUT,"Empty file $ARGV[$file], skipping.");
      next JOB;
   };

   if(-e "$file.tmp")
   { 
      syswrite(STDOUT,"Temporary file $file.tmp already exists, skipping $file.\n");
      next JOB;
   };

   if($file =~ /^-u$|^--delete$/)
   { # Option
      next JOB;
   };

   if(!open(fh,"<$ARGV[$file]")) {
      syswrite(STDOUT,"$ARGV[$file] could not be opened, skipping");
      next JOB;
   };
   if(flock(fh,2|4)){
      # lock when not locked already by another process
      flock(fh,2) || die "unexpected trouble on locking $file";
   } else {
      # skip file
      close(fh);
      syswrite(STDOUT,"$ARGV[$file] is locked by an other prozess, skipping.");
      next JOB;
   };

   sysopen(neu,"$ARGV[$file]".".tmp", O_RDWR|O_EXCL|O_CREAT) || die "Error creating temporary file, move $ARGV[$file].tmp out of the way";
   $gzfilename="$target/$ARGV[$file]".".$olddate";

   while(-s $gzfilename && $uoption)
   {
      $modnumber += 0; # to preset a value
      $gzfilename="$target/$ARGV[$file].".$splitdate[1] . "($modnumber)_" . $splitdate[4] . ".gz";;
      $modnumber++;
   }

   $gzfile_ist_neu=1 if(!-e $gzfilename);

   if(!$deloption) {
      $alt = gzopen($gzfilename, "ab") 
         or die "cannot open file: $gzerrno\n";
   }
   syswrite (STDOUT,"I: Reading and splitting $ARGV[$file] ($oldsize bytes)...\n");
   syswrite(STDOUT, "I: Analyzing ages (days before expiration): ");
   while(<fh>) {
      if(/^From \S/) {
         $c++;
         @maildate = Parse_Date($_);
         @maildate = (1970,1,1) if scalar @maildate ==0;
         $diff = Delta_Days(@maildate,@today);
         if ($#maildate != 2) {
            # mail header broken
            $isold = 0;
            $neue++;
            syswrite(STDOUT, "(new: date could not be parsed!), ");
         }
         else
         # mail okay
         {
            syswrite(STDOUT, $diff);
            if ($diff > $days) {
               $isold = 1;
               $alte++;
               syswrite(STDOUT, "(old), ");
            }
            else {
               $isold = 0;
               $neue++;
               syswrite(STDOUT, "(new), ");
            }
         }
      }
      if ($isold) {
         if(!$deloption) {
            $alt->gzwrite($_) 
               or die "error writing to gz buffer : $gzerror\n";
         }

      } else {
         defined(syswrite(neu, $_)) || die "Failure while writting - disc full?";
      }
   }

   $alte+=0; # preset value, cosmetics
   $alt->gzclose if(!$deloption);
   if($alte==0 && $gzfile_ist_neu==1 && !$deloption)
   {
      unlink($gzfilename)|| die "failed - removed gzip file [empty]\n";
   }

   # no longer interessting, beautify it
   $gzfilename=~s!^\.//?!!;

   syswrite (STDOUT,"\n\nI: Wrote $neue new entries to $ARGV[$file]".".tmp\n") if(!$deloption);
   syswrite (STDOUT,"\nI: Wrote $alte old entries to $gzfilename\n");

   $diff=$oldsize-$newsize;
   syswrite (STDOUT,"Deleting $ARGV[$file]... ");
   unlink("$ARGV[$file]") || die "failed";
   syswrite (STDOUT,"replacing with the new mailbox... ");
   rename("$ARGV[$file]".".tmp", "$ARGV[$file]") || die "failed";
   syswrite (STDOUT,"done");
   syswrite (STDOUT," (saved $diff bytes)") if(!$deloption);
   syswrite (STDOUT,".\n");
   if(-e "$ARGV[$file]".".tmp"){unlink("$ARGV[$file]".".tmp") || die "Could not remove temporary file... Odd things happen!";}
}
