#!/usr/bin/perl 

# * WARNING *  This program can be very destructive!
# Beware that I accept no responsability about this program.
# Run it at your risk!

# This program checks in all the files in the spool directory
# for messages DELAGE days old and deletes them. The user is 
# also warned that he/she should retreive the messages WARNAGE
# days old, or they will be deleted when they reach DELAGE age.

# Detailed info is provided to the user about the messages deleted
# ant those that are older than WARNTIME. The admin is also informed
# about which users were warned and if they also had some mail 
# deleted.  

# Do not pay attention to warnings like "$foo used only once..."
#   as this is caused by the external variables of the messages files.

# Global variables. Overriden by the config file.
my (%confopt);

# Where to find the config file
$confopt{"CONFFILE"} = "/etc/barrendero/barrendero.conf";
# Debug level. The greater the noisier.
$confopt{"DEBUG"} = 0;
# WARNAGE: Maximum age a message can reach before warning.
$confopt{"WARNAGE"} = 15;
# DELAGE: messages older than this are deleted.
$confopt{"DELAGE"} = 90;
# USECONF: If this is 0, we dont process any config file.
$confopt{"USECONF"} = 1;
# MAILREPORTS. If this is 0, we do not send any mail *just a debug option*
$confopt{"MAILREPORTS"} = 0;
# ADMIN: The person who gets the global reports.
$confopt{"ADMIN"} = 'root@localhost';
# MAKEBACKUP: Should I make a backup of the mail folder (user.sav?)
# 0: No copy;
# 1: user.sav     -> Save the complete mail folder 
# 2: user.deleted -> Save only the deleted messages
$confopt{"MAKEBACKUP"} = 2;
# SAVEDIR: Directory in which we will make the .sav and .deleted files.
$confopt{"SAVEDIR"} = "/tmp";
# TRIGGERSIZE: Mail folders smaller than this will not be inspected. 
#             Size un bytes
$confopt{"TRIGGERSIZE"} = 300000;
# LANG: Language in which the users will receive the messages by default.
# en: english, es: espaol ... More to be contributed.
$confopt{"LANG"} = "en";

# DO NOT MODIFY ANYTHING BELOW THIS LINE UNLESS YOU KNOW WHAT YOU ARE DOING

use Mail::Util qw(read_mbox); 
use Mail::Header;
use Date::Manip;    # We will use these two modules to resolve dates,
use Date::Parse;    # both of them have their pros and cons.
use Fcntl ':flock'; # Import LOCK_* constants


# Operating mode: 1 is spool directory, 2 is single folder.
my $mode = 0;

if ($#ARGV >= 0 )
{
    $NUM = $#ARGV+1;
    dprint(5, "** Processing $NUM arguments...\n");
    $INDEX = 1;
    while( $INDEX <= $NUM )
    {
	$OPTION = $ARGV[$INDEX-1];
	if ($OPTION eq "-c" || $OPTION eq "--config") 
	{
	    if( $INDEX == $NUM ) {
		print "$0: option requires an argument -- $OPTION\n";
		print "Try `$0 --help' for more information.\n";
		exit 1;
	    }
	    $confopt{"CONFFILE"} = $ARGV[$INDEX++]; 
	    dprint(5, "CONFFILE=$confopt{'CONFFILE'}\n");
	}
	elsif ($OPTION eq "-d" || $OPTION eq "--spool") 
	{
	    $mode = 1;
	    if( $INDEX == $NUM ) {
		print "$0: option requires an argument -- $OPTION\n";
		print "Try `$0 --help' for more information.\n";
		exit 1;
	    }
	    $confopt{"SPOOLDIR"} = $ARGV[$INDEX++];
	    dprint(5, "SPOOLDIR=$confopt{'SPOOLDIR'}\n");
	}
	elsif ($OPTION eq "-f" || $OPTION eq "--folder") 
	{
	    $mode = 2;
	    if( $INDEX == $NUM ) {
		print "$0: option requires an argument -- $OPTION\n";
		print "Try `$0 --help' for more information.\n";
		exit 1;
	    }
	    $confopt{"FOLDER"} = $ARGV[$INDEX++];
	    dprint(5, "FOLDER=$confopt{'FOLDER'}\n");
	}
	elsif ($OPTION eq "-n" || $OPTION eq "--noconfig")
	{
	    $confopt{"USECONF"} = 0;
	}
	elsif ($OPTION eq "-u" || $OPTION eq "--process-non-users")
	{
	    $confopt{"PROCESS_NON_USER"} = 1;
	}
	elsif (($OPTION eq "-h") || ($OPTION eq "--help"))
	{
	    print "Usage: $0 [options...]\n";
	    print "Options:\n";
	    print "  -d, --spool <spooldir>      Specify the spool directory to process\n";
	    print "  -u, --process-non-users     Force processing folders that are not users'\n";
	    print "                              mailbox names\n";
	    print "  -f, --folder <folder>       Process a single mail folder\n";
	    print "  -c, --config <config_file>  Use an alternate configuration file\n";
	    print "  -n, --noconfig              Do not read any configuration file\n";
	    print "\n";
	    print "  -h, --help                  Print help information and exit\n";
	    print "  -V, --version               Print version and copyright information and exit\n";
	    print "\n";
	    print "Report bugs to <ediaz\@tsc.uvigo.es>\n";

	    exit 0;
	}
	elsif (($OPTION eq "-V") || ($OPTION eq "--version"))
	{
	    $VERSION='$Id: barrendero,v 1.0 1999/08/13 20:15:41 miedu Exp miedu $ ';
	    @VERSION_CADS = split /\s/,$VERSION;
	    print "Barrendero v. $VERSION_CADS[2] $VERSION_CADS[3]".' by Eduardo Diaz Comellas (ediaz@tsc.uvigo.es)'."\n";
	    print "This program is distributed under the GNU General Public License\n";
	    exit 0;
	}
	else
	{
	    print "$0: unknown option -- $OPTION\n";
	    print "Try `$0 --help' for more information.\n";
	    exit 1;
	}
	$INDEX++;
    }
}

# If neither a spool directory nor a folder were specified, do nothing.
if($mode==0) {
    print "$0: you must specify one of `-d' or `-f'.\n";
    print "Try `$0 --help' for more information.\n";
    exit 1;
}

# Now, if USECONF=True, we have to process the config file. Beware that the 
# parameters given in the command line have preference over those in the 
# config file.

if($confopt{"USECONF"})
{
    print "Reading configuration from $confopt{'CONFFILE'}.\n";
    open (CONFFILE,$confopt{'CONFFILE'})
     or die "Unable to open $confopt{'CONFFILE'} : $! \n";
    $DEBUG = $confopt{'DEBUG'}; # Use this temporary $DEBUG while parsing 
                                # the config file. Not doing so is annoying, 
                                # as the debug messages behave abnormally.
    while(defined($line=<CONFFILE>))
    {
	if ($line=~/^[\s\t]*\#(.*)$/)  # Lines begining with # are comments
	{
	    dprint(6, "Comment: $1 \n");
	}
	elsif($line=~/(\w+)[\s\t]*=[\s\t]*([^\s\t;]+)[\s\t]*;[\s\t]*$/i)
	{
	    dprint(6, "Variable: $line\n");
	    $confopt{"$1"} = $2;
	    dprint (4, $1."=".$confopt{"$1"}."\n");
	}
	# Account number number : For exceptions
	elsif($line=~/(\w+)[\s\t]+(\d+)[\s\t]+(\d+)[\s\t]+(\w+)[\s\t]+(\d+)/i)
	{
	    $NAME = $1;
	    $exceptions{"$1"}->{"warnage"} = $2;
	    $exceptions{"$1"}->{"delage"} = $3;
	    $exceptions{"$1"}->{"lang"} = $4;
	    $exceptions{"$1"}->{"triggersize"} = $5;
	    dprint(3, "$NAME: warntime=".$exceptions{"$1"}->{"warnage"}.
	              " deltime=".$exceptions{"$1"}->{"delage"}.
	              " language=".$exceptions{"$1"}->{"lang"}.
	              " triggersize=".$exceptions{"$1"}->{"triggersize"}."\n");
	}
    }
    close CONFFILE;
}


$totalsaved = 0;
# Ok. Now we have to begin the real work!. 

# What time is it?
$now = gmtime;
dprint(5, "Today is ".$now."\n");
$datetoday = &getsecs($now);

# If we can't save the mail (and saving is activated...) we refuse to go on.
die "Cannot write to SAVEDIR directory: $confopt{'SAVEDIR'}\n"
 if ($confopt{"MAKEBACKUP"} && ! -w $confopt{'SAVEDIR'});

# Initialize the messages variables
$root_messages_file = "/etc/barrendero/messages.root.$confopt{'LANG'}";
dprint(5, "* Root's messages file $root_messages_file\n");
$report_root_body = "";

# Check we are running this in the correct directory.
die "Cannot open $root_messages_file\n"
 if (! -r $root_messages_file ); 

# Some checks about what can be done, permisions, etc.
if($confopt{'MAKEBACKUP'})
{
    die "$confopt{'SAVEDIR'} is not a directory\n"
     if(! -d $confopt{'SAVEDIR'});

    die "Cannot write to directory $confopt{'SAVEDIR'}\n"
     if(! -w $confopt{'SAVEDIR'});
}

# file after file, the hard work has to be done.
if( $mode == 1 ) {
    # Opening the spool directory
    opendir(MAILDIR,$confopt{'SPOOLDIR'})
     || die "Cannot access the spool directory $confopt{'SPOOLDIR'}: $!\n"; 

    # Directory mode
    while(defined($folder=readdir(MAILDIR)))
    {
	process_folder($folder);
    }
} else {
    # Single folder mode
    process_folder($confopt{'FOLDER'});
}

# Now we have to send the report to the root.
if ($confopt{'MAILREPORTS'}) {
    print "Sending report to $confopt{'ADMIN'}\n";
    do($root_messages_file);
    $mailtoroot = "$report_root_heading"."$report_root_body"."$report_root_tail";
    $mailcommand = "mail -s \"$mailsubject_root\" $confopt{'ADMIN'}";
    open(MAIL,"|$mailcommand");
    print MAIL $mailtoroot;
    close MAIL;
}

# Sacab!! (It's finished!). Now just exit :-)
print "Finished.\n";
exit 0;



sub process_folder
{
    my($mailfolder) = @_;

    # Check if it is hidden or the '.' '..' directories
    return if $mailfolder=~/^\./; 

    if ($mode == 1) {
	$smfolder = "$confopt{'SPOOLDIR'}/$mailfolder"; 
	$user = getpwuid((stat($smfolder))[4]);
	# Check that the folder is a users folder, or if '-u' was used.
	if (! $confopt{'PROCESS_NON_USER'}) {
	    if (! getpwnam($mailfolder)) {
		print "Skipping `$smfolder': not a username.\n";
		return;
	    }
	    if ($user ne $mailfolder) {
		print "Skipping `$smfolder': owner is $user (expected $mailfolder).\n";
		return;
	    }
	}
    } else {
	$smfolder = $mailfolder; 
	$user = getpwuid((stat($smfolder))[4]);
    }

    # Initialize the WARNAGE, DELAGE, TRIGGER, etc. vars.
    if (defined($exceptions{"$mailfolder"}->{"warnage"}))
    {
	$WARNAGE = $exceptions{"$mailfolder"}->{"warnage"};
	$DELAGE = $exceptions{"$mailfolder"}->{"delage"};
	$LANG = $exceptions{"$mailfolder"}->{"lang"};
	$TRIGGERSIZE = $exceptions{"$mailfolder"}->{"triggersize"};
	dprint(5, "*** Individual configuration for $mailfolder $WARNAGE $DELAGE $LANG $TRIGGERSIZE\n");
    }
    else
    {
	$WARNAGE = $confopt{"WARNAGE"};
	$DELAGE = $confopt{"DELAGE"};
	$LANG = $confopt{"LANG"};
	$TRIGGERSIZE = $confopt{"TRIGGERSIZE"};
    }

    # Check the triggersize
    if ( $TRIGGERSIZE > -s $smfolder )
    {
	print "Skipping `$smfolder': size limit not reached.\n";
	$report_root_body .= $report_root_line_user_skiped;
	return;
    }

    # OK. If we are here, we know that whe have to work.
    dprint(5, "*** Calling check_mailfolder($user,$smfolder)\n");
    
    print "Processing `$smfolder' for user $user.\n";
    $savedperuser = &check_mailfolder($user,$smfolder);
    $totalsaved += $savedperuser;
}

### The real work subroutine! This will process the user folder in this way:
#
# Lock mailfolder (with the lock system call and with the procmail semaphore).
# Copy the folder to the savedir if makebackups is activated, with a name
# that will save time later (when leaving a backup). If makebackups is not
# active, make it in the SPOOLDIR directory, with a hidden name.
# Truncate the mailfolder. This remakes the folder and saves the permisions and 
# the owner of the folder!
# Dump the < DELAGE messages into the new mailfolder.
# Unlock the new mailfolder and close it.
# If a hidden folder was created, delete it. If Makebackup=2, delete the
# saved mailfolder and leave just the deleted messages. If Makebackup=1
# the saved mailfolder is already there! ;-) 
# Create the user report and mail it.
# Update the root report.
# Return.
sub check_mailfolder
{
    my ($user,$file) = @_;
    my ($lockfile,$touchtime,$backupfolder,$line,@msgreferences,$msgref,@msgcontents,$msgheaders,@headertags,$report_user_body,$deletedfolder,$size1,$size2);

    $totaldel = 0;
    $totalold = 0;
    # Check if we can write in that file.
    if(! -w $file)
    {
	print "***** Cannot write to $file. Please check permisions\n";
	sleep 5; # Make sure that the operator running this program 
	         # interactively can  read the message.
	return 0;# Continue.
    }

    dprint(5, "**** Trying to get $file locked\n");
    $lockfile = "${file}.lock";
    open (MBOX,"+<$file");      # Requesting to read/write the file
    seek(MBOX,0,0);
    
    if (( -e  $lockfile ) || (! flock(MBOX,LOCK_EX|LOCK_NB))) 
    {
	# It is locked with mailfolder.lock semaphore or the EXCLUSIVE lock
	# can't be granted.
	dprint(4, "**** $file  is already locked\nWaiting a moment...\n");
	sleep 3;
	if (( -e  $lockfile ) || (! flock(MBOX,LOCK_EX|LOCK_NB)))
	{
	    dprint(4, "**** $file still locked after 2 tries. Giving up.\n");
	    do($root_messages_file); # Update the messages
	    $report_root_body .= "$report_root_line_user_skiped_locked"; 
	    # Add line to root report
	    return 0;
	}
    }
    # OK. We now have the control over the mail folder.
    # An exclusive lock is doing its job. Lets make the procmail lock.
    $touchtime = time;
    utime $touchtime,$touchtime,$lockfile;

    # Where to move the original folder? Use the backup destination if possible.
    if($confopt{'MAKEBACKUP'} == 1) # Save the whole folder?
    {
	dprint(5, "***** Saving $user in $confopt{'SAVEDIR'}\/${user}.sav\n");
	$backupfolder = "$confopt{'SAVEDIR'}\/${user}.sav";
    }
    elsif ($confopt{'MAKEBACKUP'} == 2) 
    {
	dprint(5, "***** Saving $user in $confopt{'SAVEDIR'}\/.${user}.sav\n");
	dprint(5, "***** Deleted messages into $confopt{'SAVEDIR'}\/${user}.del\n");
	$backupfolder = "$confopt{'SAVEDIR'}\/.${user}.sav";
	$deletedfolder = "$confopt{'SAVEDIR'}\/${user}.del";
    }
    else
    {
	dprint(5, "***** Saving $user in $confopt{'SPOOLDIR'}\/.${user}.sav\n");
	$backupfolder = "$confopt{'SPOOLDIR'}\/.${user}.sav";
    }
    
    # Now we have to move it....
    open(MBOXBACKUP,">$backupfolder") || die ("Couldn't open $backupfolder for writing: $!\n");
    chmod 0750 $backupfolder;
    # Hey, we should have control over this file, shouldn't we? This lock 
    # should work without a flaw.
    flock(MBOXBACKUP,LOCK_EX); 
    seek(MBOX,0,0);
    $linea = <MBOX>;
    while (defined($linea))
    {
	print MBOXBACKUP $linea;
	$linea = <MBOX>;
    }
    flock(MBOXBACKUP,LOCK_UN);
    close MBOXBACKUP;
    seek(MBOX,0,0);
    truncate(MBOX,0); # And truncate it to 0 length! 
                      # note that we didn't lose the lock.
    
    # Now the real work... discriminate and generate reports.
    $user_messages_file = "/etc/barrendero/messages.user.$LANG";

    @msgreferences = read_mbox($backupfolder);    
    foreach $msgref  (@msgreferences)
    {
	@msgcontents = @{$msgref};
	dprint(7, "This is the message:\n @msgcontents\n");
	$msgheaders = new Mail::Header($msgref);
	@headertags = $msgheaders->tags();
	dprint(6, "These are the tags of the message: @headertags\n");
	$msgdate = $msgheaders->get('Date');
	$from = $msgheaders->get('From');
	$subj = $msgheaders->get('Subject');
	$msgage = &getage($msgdate);
	dprint(5, " ***> From: $from ***> Subject: $subj ***> Date:$msgdate ***> Days old: $msgage\n\n");
	if ($msgage>=$WARNAGE)
	{
	    $totalold += 1;
	    do($user_messages_file);
	    if ($msgage>=$DELAGE)
	    {
		$totaldel += 1;
		$report_user_body .= "$report_user_line_deleted";
		# Put it in the deleted messages folder if MAKEBACKUP=2
		if ($confopt{'MAKEBACKUP'}==2)
		{
		    open (DELFOLDER,">>$deletedfolder")
		     || die("Couldn't append to $deletedfolder: $!\n");
		    chmod 0750 $deletedfolder;
		    print DELFOLDER @msgcontents;
		    close DELFOLDER;
		}
	    }
	    else
	    {
		$report_user_body .= "$report_user_line_warn";
		# Put it back in the ordinary mail folder
		print MBOX @msgcontents;
	    }
	}
	else
	{
	    # Just put it in the mail folder.
	    print MBOX @msgcontents;
	}	 
    }
    close MBOXBACKUP;
    flock (MBOX,LOCK_UN);
    close MBOX;
    # Calculate the total saved space.
    $size1 = -s $backupfolder;
    $size2 = -s $file;
    $savedperuser = $size1-$size2;
    do($user_messages_file);
    # Messages ready to mail the user report.
    if(($totalold >= 1) && ($confopt{'MAILREPORTS'})) # Only send message if there is somethin to say.
    {
	print "Sending report to ${user}: $totalold , $totaldel\n";
	$mailcommand = "mail -s \"$mailsubject_user\" $user";
	open(MAIL,"|$mailcommand");
	print MAIL $report_user_heading;
	print MAIL $report_user_body;
	print MAIL $report_user_tail;
	close MAIL;
    }
    if($totalold >= 1) # Do we have to inform about this user?.
    {
	# Prepare root messages
	do($root_messages_file);
	$report_root_body .= $report_root_line_deleted_per_user;
	$report_root_body .= $report_root_line_savedspace_per_user;
    }
    

    # Unlink the backup folder unless the admin wants it to be saved.
    unlink $backupfolder unless($confopt{'MAKEBACKUP'}==1);
    
    return $savedperuser;    
}

sub getage
{
    my($datestring) = @_;
    my ($result);
    $result = &getsecs($datestring);
    $result = $result-$datetoday;
    $result = &secs2days($result);
    return $result;
}
   

# Returns the number of days  between two dates given in seconds
sub secs2days
{
    my($date1,$date2) = @_;
    my($datediff,$days);
    $datediff = $date2 - $date1; # It doesn't matter the order. 
    $days = $datediff/86400;
    $days = int(abs($days)) ;
    return $days;
}


# Well... this is delicated... It seems that Date::Manip is not as
# strong as it should be ;). There are so weird mailers out there :(
#
# Several languages are tried. This should be modified as Date::Manip
# knows about more languages. If this languages are not enought for you
# try to modify Date::Manip. It is *VERY* easy to add a new language.
#
# If we can't resolve the date, we return $datetoday, and the mail will
# not be deleted. 
sub getsecs
{
    my ($date) = @_;
    my ($datetest);

    $datetest = str2time($date); # Simple parse....
    return $datetest if (defined($datetest)); # Return if it worked

    $date = ~s/\(.*\)//g; # Take out the zone info. It confuses Date::Manip
    $date = ~s/\+\-*\d+//g;  # This erases +002 like constructions

    dprint(5, $date."\n");
    &Date_Init("Language=English");
    $datetest = &UnixDate($date,"%s");
    if (!defined($datetest)) 
    {
	&Date_Init("Language=Spanish","DateFormat=non-US");
	$datetest = &UnixDate($date,"%s");
    }
    if (!defined($datetest))
    {
	&Date_Init("Language=French","DateFormat=non-US");
	$datetest = &UnixDate($date,"%s");
    }
    if (!defined($datetest))
    {
	&Date_Init("Language=German","DateFormat=non-US");
	$datetest = &UnixDate($date,"%s");
    }
    if (!defined($datetest))
    {
	$datetest = $datetoday;
    }

    return $datetest;
}

# Debug output routine
sub dprint
{
    my($level,$message) = @_;
    print $message if($confopt{'DEBUG'}>=$level);
}

