OT: a perl script to remail mbox email

[Jeff A. Earickson]

Gang,

  I screwed up my procmail rules yesterday and had procmail deliver
all of my inbound email into a "trash" mbox file for a while.  Ouch.
I then had 1200+ messages that I had to get delivered to their proper
recipients somehow.  I googled for some kind of script that would
rip apart an mbox file and resend messages, but found zilch (I did
find a lot of queries for this kind of script though).

Keith McGlauflin (Colby's web guru) and I cooked up the attached
script to fix this problem.  It will remail the contents of an mbox
file to either the original recipients, or to another address (ie,
bulk forwarding of email after the fact).  I hope somebody else
out there finds it useful.

Jeff Earickson
Colby College

-------------------------- MailScanner list ----------------------
To leave, send    leave mailscanner    to jiscmail at jiscmail.ac.uk
Before posting, please see the Most Asked Questions at
http://www.mailscanner.biz/maq/     and the archives at
http://www.jiscmail.ac.uk/lists/mailscanner.html
-------------- next part --------------
#!/usr/bin/perl
#
#---script to rip apart an mbox format mailbox and resend the messages.
#
# Authors: Jeff Earickson (jaearick at colby.edu) 
#          Keith McGlauflin (kamcglau at colby.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.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 \"\@$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 =~ /\@$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 (',', at 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";
			}
		}
	}
}