#!/usr/bin/perl
#
#---script to rip apart an mbox format mailbox and resend the messages.
#
# Authors: Jeff Earickson (jaearick(_at_)colby(_dot_)edu) 
#          Keith McGlauflin (kamcglau(_at_)colby(_dot_)edu)
# We would like to hear about bugs or improvements.
#
# Last Update: 6/10/2004
#
# Purposes/Possible Uses:
#
# (1) You use procmail and you screwed up your procmail rules, thereby
# dumping all emails into a "trash" mailbox instead of delivering the
# messages properly.  Now you have a big mess and want to get the 
# messages redelivered to the correct recipients.  This script will
# (mostly) do this for you.  Example usage:
#
#     remail.pl trash.mailbox
#
# If you only want to remail to addresses in your local domain, use the
# "-l" argument.
#
# (2) Somebody has left your domain, you closed their account, and
# they had leftover email on your server.  The person wants this email
# sent on to their new email address.  Example usage:
#
#     remail.pl -r user(_at_)newaddress(_dot_)com user_mbox
#
# Warning!!  You are well advised to run this script in debug mode
# (-d) and look at the output before running it for real and actually
# sending out tons of email.
#
# Bugs: Each message is expected to have a "From:" and a "To:" in
# the mail header.  Messages with no "To:" line will be skipped.
# This means that spam/bulk/mail-list emails and Bcc emails will
# not be remailed by this script.  But it will warn you about skipped
# messages.

use Getopt::Std;		# for command line parsing   
use Mail::MboxParser;   # parses the mailbox
use Mail::Sender;       # SMTP connectivity to resend email

###################
###--- subroutines
###################

sub usage
{
	print STDERR "Usage: remail.pl [-d] [-l localdomain] \n";
	print STDERR "       [-r recipient ] mailbox\n";
	print STDERR "\t-d\tdebug mode (no email is sent)\n";
	print STDERR "\t-l\tdeliver only to those recipients in your local\n";
	print STDERR "\t\tdomain, eg any recipient in \"mydomain.com\"\n";
	print STDERR "\t-r\tmail to specified recipient instead of\n";
	print STDERR "\t\toriginal recipient, eg, forwarding.\n";
	exit 1;
}

###################
###--- main routine
###################

#---parse the command-line
getopts('dl:r:') || &usage;
if($opt_d) { print "DEBUG ON: no email will actually be sent.\n"; }
if($opt_l) { print "Only deliver to recipients in \"\(_at_)$opt_l\" domain\n"; }
if($opt_r) { print "Alternate recipient is $opt_r\n"; }

#---options set for Mail::MboxParser
#---cache to /tmp
my $parseropts = {
	enable_cache    => 1,
	enable_grep     => 1,
	cache_file_name => '/tmp/remail.cache-file',
};

#---the command-line arg after getopts should be the mailbox to process
my $mb = Mail::MboxParser->new($ARGV[0], 
                                decode     => 'ALL',
                                parseropts => $parseropts);

#---for every message in the mailbox, counting messages
$count = 0;
for my $msg ($mb->get_messages) 
{
	$count++;

	#---if the message-id matches the previous one, then we
	#---had multiple recipients of the previous message in our
	#---mailbox.  We dealt with the message in the previous loop.
	if($msg->header->{'message-id'} eq $lastmsg) 
	{
		print "\nMessage $count skipped, duplicate of $lastmsg\n";
	}
	else
	{
		$lastmsg = $msg->header->{'message-id'};

		#---if local recipients only, parse recipients list
		#---building array of local recipient that match domain
		if($opt_l)
		{
			@myto=split /,/, $msg->header->{to};
			@local_recipients = "";
			foreach $myto (@myto) 
			{
				if($myto =~ /\(_at_)$opt_l/) { push @local_recipients, $myto; }
			}
		}

		#---who is the message going to?
		#---alternate recipient, eg forwarding
		if($opt_r)
		{
			$tolist = $opt_r;
		}
		#---only recipients in local domain
		elsif($opt_l)
		{
			$tolist = join (',',@local_recipients);
		}
		#---everybody in original recipients list
		else
		{
			$tolist = $msg->header->{to};
		}

		#---if the "To:" list is empty then skip this message
		#---possible reasons for empty list: no local recipients if
		#--- "-l" option used, bulk/spam mail, bcc mail
		if($tolist eq "") 
		{ 
			print "\nMessage $count SKIPPED because of empty to list: ID = $lastmsg\n";
			print "\tFrom: ",$msg->header->{from},"\n";
			print "\tTo: $tolist\n";
			print "\tSubject: ",$msg->header->{subject},"\n";
			next;
		}

		#---debug mode: tell what would happen but don't do it
		if($opt_d)
		{
			print "\nMessage $count: ID = $lastmsg\n";
			print "\tFrom: ",$msg->header->{from},"\n";
			print "\tTo: $tolist\n";
			print "\tSubject: ",$msg->header->{subject},"\n";
		}
		#---actually send the message
		else
		{
			if(ref((new Mail::Sender)->MailMsg( {
				to => $tolist,
				from => $msg->header->{from},
				subject => $msg->header->{subject},
				msg => $msg->body } ) ) )
			{
				print "\nMessage $count sent to $tolist\n";
			}
			else
			{
				print "\nMessage $count ($lastmsg) NOT SENT: problems\n";
			}
		}
	}
}