#!/usr/bin/perl -W
eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}'
	if $running_under_some_shell;
$running_under_some_shell="/dev/null";  # Shut up the -w option!

$DEBUG=0;

my $charset="US-ASCII";
my $newmessage;
my $sig;

use diagnostics;
use File::MkTemp;

=head1 NAME

B<replwrap>

=head1 SYNOPSIS

B<replwrap>

replwrap [--wrap--V|--wrap--L|--wrap--C|--wrap--D] [--wrap--d --wrap-level] [--wrap--q|--wrap--v] [--wrap--f --wrap-configfile]

=head2 Command Line Arguments

All command line arguments for the B<replwrap> program itself must be
preceeded with B<--wrap->. This ugly kludge is intended to distinguish
arguments for B<replwrap> itself from all other arguments, which are
passed to the [n]mh B<repl> program.

=head1 DESCRIPTION

B<replwrap> is a wrapper around the [n]mh B<repl> program. It's purpose
is to identify the recipient of the mail message being replied to, set
environment variables to produce the desired "From:" and "Fcc:" headers,
and then call the real B<repl> program.

=head1 Installation

B<replywrap> will typically be installed under the name "B<repl>",
and should appear in the PATH B<before> the [n]mh "B<repl>" executable.

Alternatively, B<replwrap> may be installed in place of the actual [n]mh
B<repl> binary. The binary must be moved to another name or location
(use the B<--wrap--C> option to see the default value for REAL_REPL). For
example:

	originalrepl=`which repl`
	mv $originalrepl $originalrepl.real
	cp replwrap $originalrepl

=head1 CONFIGURATION FILE

The B<replwrap> relies heavily upon a configuration file. By default,
this file is $HOME/.B<replwrap>.

=head2 Configuration File Format

The configuration file has lines in the form:

	VARIABLE=value

blank lines are ignored, and comments are preceeded with a pound (#)
sign, and spaces cannot be found within the "value" field.

=head2 Building the Configuration File

The B<--wrap--C> argument will print out the valid configuration variables and their defaults (if any). This can
be used as the basis for the configuration file with:

	repl --wrap--C > ~/.repl

=head2 Appended Variables

The keyword B<Append:> can preceed any variable name. This is used to
append multiple values to a single variable. For example:

	Append: VARIABLENAME=value1
	Append: VARIABLENAME=value2
	Append: VARIABLENAME=value3

Now, VARIABLENAME will contain "value1", "value2", and "value3".

=head2 Required Variables

The required variables are:

	NAME (giving the name of the program that corresponds to the
		configuration file, "replwrap")

	VERSION (the version of the configuration file)

	DEFAULTREPLMASQ (Default value of the repl masquerade variable
		in case the REPLMASQ cannot be determined from the
		message being replied to.)

	DEFAULTREPLMASQFCC (Value of the Fcc: masquerade variable in
		case the REPLMASQFCC cannot be determined from the message being
		replied to.)

	DEFAULTPRIORITY (Default priority for each header. Higher is
		better.)

	HEADER (List of header names to check for the address to use
		in the REPLMASQ. Use "Append:" to enter multiple values)

	REAL_REPL (Path to the real [n]mh binary.)

	MAPPING (List (use Append:) of mappings between e-mail
		addresses and masquerades. Use \"%1\" to indicate the
		same value on RHS. All addresses should be lower case.)

	MAPPINGFCC (List (use Append:) of mappings between e-mail
		addresses and Fcc lines. Use \"%1\" to indicate the same
		value on RHS.)

Please note that many of these required variables will B<not> appear in the
configuration file, as they have defaults set within the script. Any values
in the configuration file will take precedence over hard-coded variables.

=head2 Default Values
	
	Many variables have default values, set in the script.	Use the
	--wrap--C option.

=head2 Sample Configuration

The following is a sample configuration file:

---------------------------------------------------------------

    VERSION=1
    address@hidden
    DEFAULTREPLMASQFCC=outbox
    X-Envelope-To=2	# weight given to header in determining reply name
    X-Original-To=0.5 # weight given to header in determining reply name
    
    # If the mail is "To" my work address, use the same address in the 
    # reply and set the outbox
    Append: address@hidden address@hidden
    Append: address@hidden +Work/outbox
    
    # If I'm getting mail from anyone at my former workplace, reply from
    # my gmail account, and set the Fcc to the OldWork folder
    Append: address@hidden address@hidden
    Append: address@hidden +OldWork/outbox
    
    # Wildcard mapping... Since I own "my-own-domain.com", I receive mail
    # sent to any address @my-own-domain.com. In my reply, use the same
    # address as the From, and set the Fcc
    Append: address@hidden %1
    Append: address@hidden +Merctech/outbox
---------------------------------------------------------------

=head1 REQUIREMENTS

The script requires perl. :)

To actually change the "From:" and "Fcc:" headers, there must be
a B<replcomps> file that uses the environment variables set by the
B<replwrap> program.

An example of the format used in the B<replcomps> is:

	%(void(getenv REPLMASQ))From: %(putstr)
	%(void(getenv REPLMASQFCC))Fcc: %(putstr)

=head1 FILES

Configuration file: $HOME/.B<replwrap>.

[n]mh B<replcomps>.

=head1 AUTHOR

Mark Bergman <address@hidden>

=head1 RIGHTS

(c) 2005, Mark Bergman

May be distributed under the terms of the GNU GENERAL PUBLIC LICENSE.

First distribtion: 2003.

=cut

#  
#  
#  Functions:
#  	version 	display the version of the script, from the RCS tag
#  
#  	limits 		display any limits known to the script
#  
#  	configvars 	display all the vars that can be set in the config file,
#  				with explanations and defaults
#  
#  	usage 		usage statement
#  
#  	debug		print debugging statements
#  
#  	myGetopts	local version of Getopts
#  
#  	parse		parse the command-line variables
#  
#  	readconfig 	read the config file
#  
#  	clearconfigvars		clean the config variables of the comments and
#						set	default values
#  
########### CONFIG FILE STUFF ###################################
#  Config File Handlers:
#  	The command-line option "-C" will display all the values that
#  	can be set in the config file. Doing
#  		check4stream -C > newconfig.cfg
#  	is an easy way to create a new config file.
#  
#  	Comments (signified with "#") are ignored in the config file
#  
#  	Variables are set in the form:
#  		VARIABLENAME=VALUE
#  	where "VALUE" can contain spaces, but must be a single line.
# 	The keyword "Append:" can preceed the VARIABLENAME=VALUE assignment, which will
# 	cause the value to appended to any array assigned to the VARIABLENAME
#  
#  	There are some basic sanity checks in the config file:
#  		the NAME variable must match the name of this script
#  
#  		the VERSION number must be between the hard-coded $VERSIONMIN
#  		and $VERSIONMAX found in the script
#
#
#	$CONFIG{NAME}="Required name of the program.";
#	$CONFIG{SIZE}="Required size specification. Default=32";
#	$CONFIG{MAXFILES}="Maximum number of files. Default: 128";
#	$CONFIG{COLOR}="Desired color";
#
#		The $NAME value is required, but has no default.
#		The $SIZE value is required, and defaults to 32.
#		The $MAXFILES value is not required, and defaults to 128.
#		The $COLOR value is not required, and has no default.
#
#################################################################
##########
# Variables
# 
########
$|=1;	# Flush output
$RCSversion='$Header: /home/bergman/Bin/RCS/repl,v 1.2 2014/07/09 15:25:58 bergman Exp bergman $';
($NAME=$0)=~s#^.*/##;

if ( -l $0 )
{
	# the called program is a symlink...find the real thing
	$REALNAME=readlink($0);
	$REALNAME=~s#^.*/##;
}
else
{
	# It's not a link...
	$REALNAME=$0;
}

$VERSIONMIN=1;
$VERSIONMAX=100;
$CONFIGFILE="";	# Must be supplied as an argument
@REQUIREDVARS=();	# Array of required variables. Will be populated
					# by clearconfigvars()

######################## Variables set in the config file ##############
$CONFIG{NAME}="Required name of the program that will use the config file.";
$CONFIG{VERSION}="Required version of the config file.";

####################   START OF STANDARD SUBROUTINES
sub version {
# Display the version number and date of modification extracted from
# the RCS header.
	my ($exitval)address@hidden;
	$RCSversion=~s/\S+\s\S+\s(\S+\s\S+).*/$1/;
	print $REALNAME . ": " . $RCSversion . "\n";
	exit $exitval;
}
sub usage {
	print "$REALNAME [--wrap--V|--wrap--L|--wrap--C|--wrap--D] [--wrap--d --wrap-level] [--wrap--q|--wrap--v] [--wrap--f --wrap-configfile]\n";
	print "\t--wrap--V	atomic	report program version\n";
	print "\t--wrap--L	atomic	report program limits\n";
	print "\t--wrap--C	atomic	report valid config file variables\n";
	print "\t--wrap--D	atomic	view embedded documentation\n";
	print "\t--wrap--q	quiet\n";
	print "\t--wrap--v	verbose\n";
	print "\t--wrap--d --wrap-level\tspecify debug level\n";
	print "\t--wrap--f --wrap-configfile\tspecify config file (default: $ENV{HOME}/.$NAME)\n";
	print "\n";
	print "All command line arguments for the $REALNAME program itself must be preceeded\n";
	print "with \"--wrap-\". This ugly kludge is intended to distinguish arguments\n";
	print "for $REALNAME itself from all other arguments, which are passed to the\n";
	print "[n]mh $NAME program.\n";
	print "\n";
	print "address@hidden";
	exit 0;
}
sub debug
{
	# Handle debugging. The debug routine depends on the presence of
	# the variable "DEBUG", which should be set as follows:
	#	=\d			only print debug statements that exactly match
	#				the specified level
	#
	#	\d			print debug statements at or less than the level

    local($level,$statement)address@hidden;
	my $debug=$DEBUG;

	if ( $DEBUG !~ /=\d+/ )
	{
		if ( $debug >= $level )
		{
			print STDERR $statement;
		}
	}
	else
	{
		$debug=~s/=//;
		if ( $debug == $level )
		{
			print STDERR $statement;
		}
	}
}
sub configvars {
	# step through the %CONFIG{} hash, printing the names of the
	# config variables
	print "# $NAME: valid config file variables are:\n\n";
	foreach $var ( sort( keys %CONFIG) )
	{
		print "$var=$CONFIG{$var}\n";
	}
	exit(0);
}

sub readconfig {
	# Read a config file.
	#
	#		NOTE! The values as found in the config
	#			file cannot have spaces
	#

	local($configfile)address@hidden;

	if ( ! -f $configfile)
	{
		usage("No config file: \"$configfile\". Use:\n\t\t$NAME --wrap--C > $configfile\n\tto create.");
	}

	if ( !(open(CONFIGFILE,"$configfile")))
	{
		usage("Could not open configuration file $configfile for reading: $!");
	}

	while(<CONFIGFILE>)
	{
		# skip comments
		next if (/^\s*#/);

		# strip comments
		$_=~s/#.*//;

		chomp;                  # strip newline
    	$_=~s/^\s+//;           # strip leading whitespace
    	$_=~s/\s+$//;           # strip trailing whitespace
    	next unless length;     # anything left?
			
		if ( $_ !~ /=/ )
		{
			usage("Error in config file $CONFIGFILE at line $.\n");
		}

		if ( $_ !~ /^Append:\s/i )
		{
			# The line does not begin with the keyword "Append:", so replace
			# the config variable with the value on the current line.
			my ($var, $value) = split(/\s*=\s*/, $_, 2);
			next if ($value =~ /^\s*$/ );
			$CONFIG{$var} = $value;
		}
		else
		{
			# The line begins with the keyword "Append:". Strip off that
			# keyword, split the variable and value, and append the value to the
			# the config variable.
			$_=~s/^Append:\s*//;
			my ($var, $value) = split(/\s*=\s*/, $_, 2);
			next if ($value =~ /^\s*$/ );
			if (defined($CONFIG{$var}))
			{
				$CONFIG{$var}=$CONFIG{$var} . " " . $value;
			}
			else
    		{
				$CONFIG{$var} = $value;
			}
			$CONFIG{$var}=~s/^\s*//;
			$CONFIG{$var}=~s/\s*$//;
		}
	}
	close(CONFIGFILE) or die "Could not close $CONFIGFILE: $!";

	if ( $CONFIG{NAME} !~ /$NAME/ )
	{
		usage("Configuration file is for program \"$CONFIG{NAME}\", this is $NAME.");
	}
	if ( $CONFIG{VERSION} lt $VERSIONMIN )
	{
		usage("Configuration file version $CONFIG{VERSION} is less than the minimum ($VERSIONMIN)");
	}
	if ( $CONFIG{VERSION} gt $VERSIONMAX )
	{
		usage("Configuration file version $CONFIG{VERSION} is more than the maximum ($VERSIONMAX)");
	}
}

sub clearconfigvars {
	# Clear the comments out of the config vars, leave any default
	# values.
	#
	# Also set push the names of all the required variables into the
	# REQUIREDVARS array.
	foreach $var ( sort( keys %CONFIG) )
	{
		if ( $CONFIG{$var} =~ /^Required/ )
		{
			push(@REQUIREDVARS,$var);
		}

		if ( $CONFIG{$var} =~ / Default: / )
		{
			$CONFIG{$var} =~s/^.*Default:\s*//;
			
			if ( $CONFIG{$var} =~ /Append:\s/i )
			{
				# The line has the keyword "Append:". Strip off that
				# keyword, split the variable and value, and append the value to the
				# the config variable.

				foreach $configline (split(/\n/,$CONFIG{$var}))
				{
					$configline =~ s/^\s*Append:\s*//;
					$configline =~ s/^\s*//;
					$configline =~ s/\s*$//;
					next if ( $configline =~ /^\s*$/ );

					$configline=~s/^$var=//;
					if (defined($tempCONFIG))
					{
						$tempCONFIG=$tempCONFIG . " " . $configline;
					}
					else
    				{
						$tempCONFIG = $configline;
					}
					$tempCONFIG=~s/^\s*//;
					$tempCONFIG=~s/\s*$//;
				}
				$CONFIG{$var}=$tempCONFIG;
			}
		}
		else
		{
			$CONFIG{$var}="";
		}
	}
}

sub myGetopts
{
# Usage:
#      do Getopts('a:bc');  # -a takes arg. -b & -c not. Sets opt_* as a
#                           #  side effect.
    local($argumentative) = @_;
    local(@args,$_,$first,$rest);
    local($errs) = 0;

    @args = split( / */, $argumentative );
    while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
	($first,$rest) = ($1,$2);
	$pos = index($argumentative,$first);
	if($pos >= 0) {
	    if($pos < $#args && $args[$pos+1] eq ':') {
		shift(@ARGV);
		if($rest eq '') {
		    ++$errs unless @ARGV;
		    $rest = shift(@ARGV);
		}
		${"opt_$first"} = $rest;
	    }
	    else {
		${"opt_$first"} = 1;
		if($rest eq '') {
		    shift(@ARGV);
		}
		else {
		    $ARGV[0] = "-$rest";
		}
	    }
	}
	else {
	    return(1);
	    ++$errs;
	    if($rest ne '') {
		$ARGV[0] = "-$rest";
	    }
	    else {
		shift(@ARGV);
	    }
	}
    }
	return(0);
}

sub parse
{
	if ( myGetopts("VLCDf:s:qvd:") != 0 )
	{
		usage("Invalid option");
	}

	if ( defined($opt_V) && $opt_V == 1 )
	{
		&version();
	}
	if ( defined($opt_L) && $opt_L == 1 )
	{
		&limits();
	}
	if ( defined($opt_C) && $opt_C == 1 )
	{
		&configvars();
	}
	if ( defined($opt_D) && $opt_D == 1 )
	{
		exec("perldoc -t $0");
	}
	if ( defined($opt_d) && $opt_d ne "1" )
	{
		$DEBUG=$opt_d;
	}
	if ( defined($opt_q) && $opt_q == 1 )
	{
		$volume="quiet";
	}
	if ( defined($opt_v) && $opt_v == 1 )
	{
		$volume="loud";
	}
	if ( defined($opt_f) && "$opt_f" ne "1" )
	{
		$CONFIGFILE=$opt_f;
	}
}

#
# Wrapper to repl...
# The wrapper will:
#
#	get the "To:" address (or "CC:")
#
#	check if the address matches a known address that we want to 
#	masquerade as
#
#	if so, it will set the environment variable REPLMASQ appropriately
#
#	it will then call the real "repl" command
#
# This scheme depends upon a "replcomps" file with lines something like:
#	%(void(getenv REPLMASQ))From: %(putstr)
#	%(void(getenv REPLMASQFCC))Fccc: %(putstr)
#  
#################################################################

sub tros {
	# Reverse sort
	return $b cmp $a;
    #if ($a > $b) {
        #return -1;
    #} elsif ($a == $b) {
        #return 0;
    #} elsif ($a < $b) {
        #return 1;
    #}
}

$CONFIG{DEFAULTREPLMASQ}="Required value of the repl masquerade value cannot be determined.";
$CONFIG{DEFAULTREPLMASQFCC}="Required value of the repl Fcc: masquerade value cannot be determined.";
$CONFIG{DEFAULTPRIORITY}="Required default priority for each header. Higher is better. Default: 1";
$CONFIG{HEADER}="Required list of header names. Default: Append: HEADER=Bcc:\
Append: HEADER=CC:\
Append: HEADER=Dcc:\
Append: HEADER=Delivered-to:\
Append: HEADER=Resent-Bcc:\
Append: HEADER=Resent-CC:\
Append: HEADER=Resent-To:\
Append: HEADER=To:\
Append: HEADER=X-Apparently-To:\
Append: HEADER=X-Envelope-To:\
Append: HEADER=X-Original-To:";

$CONFIG{PATH}="Optional path statement to append to \$PATH to ensure that mh components can be found. Default:/usr/lib/nmh";
$CONFIG{REAL_REPL}="Required path to the real [n]mh binary. Default: /usr/bin/repl";
$CONFIG{MAPPING}="Required list (use Append:) of mappings between e-mail addresses and masquerades. Use \"%1\" to indicate the same value on RHS.";
$CONFIG{MAPPINGFCC}="Required list (use Append:) of mappings between e-mail addresses and Fcc lines. Use \"%1\" to indicate the same value on RHS.";
$CONFIG{MAPPINGSIG}="Optional list (use Append:) of mappings between e-mail addresses signature file. Use \"%1\" to indicate the same value on RHS.";
$CONFIG{ADDITIONALENVIRONVARS}="Optional list of additional environment variables to set. The variables named must also appear as mappings (use Append: if needed).";

$REAL_ARGS=`mhparam repl`;	# Initialize the argument list for the
				# repl command as it was called, with the options
		 		# specified in the ~/.mh_profile
chop($REAL_ARGS);
clearconfigvars();

# Hackage!
# Split up the options before calling parse() so that any options to $NAME can be dealt with
# separately. Those options must be in the form:
#	-wrap-{OPTION}
# for example:
#	-wrap--f -wrap-myconfig.rc
# would result in:
#	-f myconfig.rc
# being dealt with internally

@address@hidden;
@replopts=();
@ARGV=();

foreach $arg (@options)
{
	if ( $arg =~ /^--wrap-/ )
	{
		$arg=~s/^--wrap-//;
		push(@ARGV,$arg);
	}
	else
	{
		# I hate special cases...but...
		# if the @replopts contains "-help" or "-version", these
		# are atomic (ie, they don't take a message number and
		# they don't actually deal with messages) so just call
		# the real repl
		#
		# then call the appropriate replwrap optionto give some info about the
		# wrapper itself
		#
		# Muck with the value returned by the version command to ensure that the 
		# command name is the same as the wrapper (ie., "repl", not "repl.real" or "repl.binary"
		# or something...this is to keep the exmh installation program happy...it does a test for
		# repl and expects an answer in the form "repl ......"

		if ( $arg =~ /^-version$/ )
		{
			$realrepl=$CONFIG{REAL_REPL};
			$realrepl=~s#.*/##;
			$version=`$CONFIG{REAL_REPL} $arg`;
			$version=~s/$realrepl/$NAME/g;
			print $version;
			version(1);
		}

		if ( $arg =~ /^-help$/ )
		{
			$realrepl=$CONFIG{REAL_REPL};
			$realrepl=~s#.*/##;
			$realrepl=~s#.*/##;
			$help=`$CONFIG{REAL_REPL} $arg`;
			$help=~s/$realrepl/$NAME/g;
			print $help;
			usage();
		}
		push(@replopts,$arg);
	}
}

parse();

debug(1,"\$DEBUG=\"$DEBUG\"\n");
debug(3,"address@hidden"@ARGV\"\n");
debug(3,"address@hidden"@replopts\"\n");

$CONFIGFILE="$ENV{HOME}/.$NAME";


readconfig($CONFIGFILE); 

# Check for all the required variables
for $var ( @REQUIREDVARS )
{
        if ( $CONFIG{$var} eq "" )
        {
                usage("Variable $var is required but not set in the config file or command line");
        }
}

# Now, deal with the $CONFIG{MAPPING} var. This will have data like:
#	address@hidden address@hidden address@hidden address@hidden
# where the mappings are as follows:
#		mail sent to: address@hidden		reply masquerade of address@hidden
#		mail sent to: address@hidden	reply masquerade of address@hidden
@data=split(/\s/,$CONFIG{MAPPING});
@datafcc=split(/\s/,$CONFIG{MAPPINGFCC});
@datasig=split(/\s/,$CONFIG{MAPPINGSIG});

for($index=0; $index < $#data; ++$index)
{
	$mappedvalue=$index+1;
	$MAPPING{$data[$index]}=$data[$mappedvalue];
	push(@MyAddrs,$data[$index]);
	$index=$mappedvalue;
}

for($index=0; $index<$#datafcc; ++$index)
{
	$mappedvalue=$index+1;
	$MAPPINGFCC{$datafcc[$index]}=$datafcc[$mappedvalue];
	$index=$mappedvalue;
}

for($index=0; $index<$#datasig; ++$index)
{
	$mappedvalue=$index+1;
	$MAPPINGSIG{$datasig[$index]}=$datasig[$mappedvalue];
	debug(3,"Assigned \$MAPPINGSIG{$datasig[$index]}=\"$datasig[$mappedvalue]\"\n");
	$index=$mappedvalue;
}

$priority=0;

my $message="";

# Now, deal with the @replopts in an attempt to discern the name of the 
# mail message being replied-to

foreach $argnum (0..$#replopts)
{
		if ( $replopts[$argnum] =~ /^(\+|\d+$|cur$|next$|last$|prev$)/ )
		{
			# These arguments to repl don't take options.
			# However, the argument does let us determine what message
			# we are replying to.
			#
			# Thanks to Fred Douglis <address@hidden>
			# for "cur | last | prev"
			$findmsg.=" $replopts[$argnum]";
			$replopts[$argnum]="";
		}

  		if ( $replopts[$argnum] =~/^-file$/ )
		{
			# This option, and it's argument, specifies the file that's
			# used as the message-to-reply-to
			$message=$replopts[$argnum + 1];
			$replopts[$argnum]="";
			$replopts[$argnum + 1]="";
		}

  		if ( $replopts[$argnum] =~ /^(-draftfolder|-draftmessage)$/)
		{
			# These options to repl take arguments. The argument will
			# tell us what message we are repl'ing to.
			$findmsg.=" $replopts[$argnum]";
			$replopts[$argnum]="";
		}
}

# There are 3 possible cases: 
#	$message is set to an actual file name
#
#	there's an mh specification for a message (ie., "next", or a number)
#
#	there's no specification, implying the current message

if ( $message =~ /^\s*$/ )
{
	if ( !defined($findmsg))
	{
		# There were no arguments...
		# the message is the current message...
		$message=`mhpath cur 2> /dev/null`;
		chomp($message);
	}
	else
	{
		$message=`mhpath $findmsg 2> /dev/null`;
		chomp($message);
	}
}

# There's the possibility that $message is a directory, not a file, and that the
# directories specifies the mh folder...
if ( -d $message)
{
	# We got a directory, not a message...try again
	$message=`mhpath $findmsg cur 2> /dev/null`;
	chomp($message);
}


# OK, now $message has the path to the message file itself...or is NULL
# if no message file could be determined.
#
if ( $message =~ /^\s*$/ )
{
	usage("Could not determine the current message.");
}


# Now we want to get all the addresses from the
#
#			To:
#			CC:
#			X-Envelope-To:
#			X-Original-To:
#			X-Apparently-To:
#			Resent-To:
#			Bcc:
#			Resent-To:
#			Resent-CC:
#			Resent-Bcc:
#			Delivered-to:
#
# fields of the message...without any of the cruft (real names, focus
# punctuation, etc.) We are ASSUMING that a "good" address has an "@" sign.
# This will NOT work for unqualified, local addresses or UUCP addresses.
#
#
	
$MyAddrs_regex = '(' . join('|', @MyAddrs) . ')';
$adjustment=0.25;
#	%Adjusted{}	# hash of adjusted headers...if we see the same header multiple times, give it
				# a higher priority each time...this is because headers appear in a message from
				# the bottom up (ie., the lowest "Delivered-To" header was created first), and lower
				# headers are more likely to reflect the true address to which the mail was sent
#	$priority 	the high water mark
#	$mypriority	the priority of the current header line

my @headers=`formail -c -X X-Apparently-To -X Resent-CC -X Resent-BCC  -X Resent-To -X To -X X-envelope-To -X X-Envelope-To -X X-original-To -X X-Original-To -X From -X CC -X Bcc -X Dcc -X Delivered-To < $message`;

my $header;

foreach $header ( @headers )
{
	($field,$addresses)=split(/:\s*/,$header,2);

	$addresses=~s/[<>'",;]/ /g;	# Leave in spaces as separator between addrs
	$addresses=~s/\s+/ /g;
	$addresses=~tr/A-Z/a-z/;	# Make lower case

	@chunks=split(/\s/,$addresses);

	@addrs=();
	foreach $chunk (@chunks)
	{
		if ( $chunk =~ /address@hidden/ )
		{
			# Hey, it looks like an address to me
			push(@addrs,$chunk);
		}
	}
	# Get a unique (and sorted) list of addresses
	$addrprev="";
	@uniqaddrs=();
	@addrs=sort(@addrs);
	foreach $addr ( @addrs )
	{
      			if ( $addrprev ne $addr )
      			{
              			push(@uniqaddrs,$addr);
              			$addrprev=$addr;
      			}
	}

	if ( defined($CONFIG{$field}) )
	{
		$mypriority=$CONFIG{$field};
	}
	else
	{
		$mypriority=$CONFIG{DEFAULTPRIORITY};
	}

	if ( defined($Adjusted{$field} ) )
	{
		$mypriority = $mypriority + $Adjusted{$field};
		debug(3,"Adjusting the priority of field \"$field\" by $Adjusted{$field} to $mypriority\n");
		$Adjusted{$field} = $Adjusted{$field} + $adjustment;
	}
	else
	{
		$Adjusted{$field} = $adjustment;
	}
	debug(3,"The highest priority address found is \$priority=\"$priority\"\n");
	debug(3,"The priority of the current header ($field) is \"$mypriority\"\n");
	# if ( $priority > $CONFIG{$field} ) ... then do nothing...higher is better
	if ( $priority lt $mypriority )
	{
		$newrepladdr="";
		foreach $addr (@uniqaddrs)
		{
			if ( $addr =~ /$MyAddrs_regex/i )
			{
				debug(3,"Found the address \"$addr\" in \"$MyAddrs_regex\"\n");
				# The previously discovered addresses are of a lower priority
				# than the current field. Discard them
				debug(2,"The new priority is higher... erasing the current \$repladdr\n");
				$priority=$mypriority;

				debug(3,"Adding address \"$addr\" to \$repladdr\n");
				$newrepladdr.=" $addr";
				$newrepladdr=~s/^\s*//;
			}
		}
		if ( $newrepladdr =~ /@/ )
		{
			$repladdr=$newrepladdr;
		}
		if (defined($repladdr))
		{
			debug(3,"\$repladdr=\"$repladdr\"\n");
		}
	}
	else
	{
		if ( $priority == $mypriority)
		{
			debug(2,"The new priority is equal...");
			if ( !defined($repladdr) )
			{
				debug(3,"\$repladdr is not defined, inserting new addresses to \$repladdr\n");
				foreach $addr (@uniqaddrs)
				{
					if ( $addr =~ /$MyAddrs_regex/i )
					{
						debug(3,"Found the address \"$addr\" in \"$MyAddrs_regex\"\n");
						$repladdr.=" $addr";
					}
				}
				$repladdr=~s/^\s*//;
				debug(3,"\$repladdr=\"$repladdr\"\n");
			}
			else
			{
				debug(3,"\$repladdr exists, appending to current \$repladdr\n");
				foreach $addr (@uniqaddrs)
				{
					if ( $repladdr !~ /$addr/i )
					{
						debug(3,"The address \"$addr\" is not already in \$repladdr\n");
						# The current address isn't the same as what's in the $repladdr var
						# add the address to the var
						if ( $addr =~ /$MyAddrs_regex/i )
						{
							debug(3,"Found the address \"$addr\" in \"$MyAddrs_regex\"\n");
							$repladdr.=" $addr";
						}
					}
				}
				debug(3,"\$repladdr=\"$repladdr\"\n");
			}
		}
	}
}

# Now, the $repladdr var has the list of all addresses at the highest priority value

if ( ! defined ($repladdr) )
{
	debug(1,"Couldn't determine any addresses...use the default\n");
	# Couldn't determine any addresses...use the default
	$REPLMASQ=$CONFIG{DEFAULTREPLMASQ};
	$REPLMASQFCC=$CONFIG{DEFAULTREPLMASQFCC};
	if ( defined($CONFIG{DEFAULTREPLSIG} ) )
	{
			$REPLSIG=$CONFIG{DEFAULTREPLSIG};
	}
}
else
{
	if ( $repladdr !~ /@/ )
	{
		debug(1,"The \$repladdr=\"$repladdr\"...using the default\n");
		# Couldn't determine any addresses, or they are all local...use the default
		$REPLMASQ=$CONFIG{DEFAULTREPLMASQ};
		$REPLMASQFCC=$CONFIG{DEFAULTREPLMASQFCC};
		if ( defined($CONFIG{DEFAULTREPLSIG} ) )
		{
				$REPLSIG=$CONFIG{DEFAULTREPLSIG};
		}
	}


	if ( $repladdr =~ /@.*\s.*@/ )
	{

		# There are multiple addresses in the reply...
		# check to see if they're all in the same domain...
		debug(3,"The \$repladdr=\"$repladdr\" has multiple addresses...checking for a single domain...\n");
		$prevaddr="";

		foreach $addr (split(/\s+/,$repladdr))
		{
			$address=$addr;
			$addr=~s/.*@//;
			debug(3,"In foreach(), checking \$addr ($addr) against \$prevaddr ($prevaddr)\n");
			if  ( $prevaddr =~ /^$/ )
			{
				$prevaddr = $addr;
			}
			else
			{
				# There's a previous domain...
				if ( $prevaddr !~ $addr )
				{
					# the two domains differ...

					# Next, check to see if either domain matches an address in the reply mapping config.
					# If only one matches, then use that address.
					
					$addrmatch=0;
					$prevaddrmatch=0;
					foreach $map (sort tros (keys %MAPPING))
					{
						# I do a reverse sort of the keys before doing the comparisions. This is so that regexs in the
						# keys will come after alphanumeric chars. This is so that we can have several masqerades in the
						# config file and they will be matched with preference given to an exact (ie, non-regex) match.
						# For example:
						#	Append: address@hidden	address@hidden
						#	Append: address@hidden	address@hidden
						# Because the keys are sorted, the lizards entry will preceed the liza regex, even they
						# they are in the opposite order in the config file. In fact, since hashes are involved, there's
						# no way to ensure the order without doing a sort.
						#
								
						debug(2,"Comparing \$addr=\"$addr\" to \"$map\"\n");
						if ( $map =~ /$addr/ )
						{
								# We have a match...take note of it
								$addrmapsto=$MAPPING{$map};
								debug(2,"Matched \"$addr\", \$addrmatch=$addrmatch, \$addrmapsto=\"$addrmapsto\"\n");
								$addrmatch++;
						}

						debug(2,"Comparing \$prevaddr=\"$prevaddr\" to \"$map\"\n");
						if ( $map =~ /$prevaddr/ )
						{
								# We have a match...take note of it
								$prevaddrmapsto=$MAPPING{$map};
								debug(2,"Matched \"$prevaddr\", \$prevaddrmatch=$prevaddrmatch, \$prevaddrmapsto=\"$prevaddrmapsto\"\n");
								$prevaddrmatch++;
						}
					}
								
					# Now, compare the number of matches... if they are equal, there is
					# no way to know whether to use the $prevaddr or $addr in producing the masquerade
					if ( $prevaddrmatch == $addrmatch )
					{
						if ( $addrmapsto ne $prevaddrmapsto )
						{
							debug(1,"The \$repladdr=\"$repladdr\" has multiple addresses of priority ($addrmatch)...no way to \n");
							debug(1,"determine which one should produce the reply masquearade\n");
							# The $repladdr var has multiple addresses of the same priority...no way to 
							# determine which one should produce the reply masquearade
							$REPLMASQ=$CONFIG{DEFAULTREPLMASQ};
							$REPLMASQFCC=$CONFIG{DEFAULTREPLMASQFCC};
							if ( defined($CONFIG{DEFAULTREPLSIG} ) )
							{
									$REPLSIG=$CONFIG{DEFAULTREPLSIG};
							}
							last;
						}
						else
						{
							# The $prevaddr and $addr both map to the same reply address from the config file. Use either one...
							debug(2,"\$prevaddr and \$addr both map to the same reply address ($addrmapsto) from the config file.\n");
							$repladdr=$addr;
						}
					}
					else
					{
							if ($prevaddrmatch > $addrmatch)
							{
								# The $prevaddr matched at least one of the addresses in the mapping config, so keep that
								# address
								debug(1,"\$prevaddr=\"$prevaddr\" matched $prevaddrmatch entries in \%MAPPING, setting \$repladdr=\$prevaddr\n");
								$repladdr=$prevaddr;
							}
							else
							{
								# The $addr matched at least one of the addresses in the mapping config, so keep that
								# address
								debug(1,"\$addr=\"$addr\" matched $addrmatch entries in \%MAPPING, setting \$repladdr=\$addr\n");
								$repladdr=$addr;
							}
					}
				}
			}
		}

		# If we get to here, then all the addresses were from the same domain. Collapse them into one address ($addr) in order
		# to determine the reply masquerade later
		$repladdr=$address;
		debug(1,"All domains in \$repladdr were the same, set \$repladdr=\$address ($address)\n");
	}
}

if ( !defined($REPLMASQ) )
{
	foreach $map (sort tros (keys %MAPPING))
	{
		# I do a reverse sort of the keys before doing the comparisions. This is so that regexs in the
		# keys will come after alphanumeric chars. This is so that we can have several masqerades in the
		# config file and they will be matched with preference given to an exact (ie, non-regex) match.
		# For example:
		#	Append: address@hidden	address@hidden
		#	Append: address@hidden	address@hidden
		# Because the keys are sorted, the lizards entry will preceed the liza regex, even they
		# they are in the opposite order in the config file. In fact, since hashes are involved, there's
		# no way to ensure the order without doing a sort.
		#

		debug(2,"Comparing \$repladdr=\"$repladdr\" to \$MAPPING{$map}=\"$MAPPING{$map}\"\n");
		if ( $repladdr =~ /$map/ )
		{
			if ( $MAPPING{$map}=~/%1/ )
			{
				$MAPPING{$map}=$repladdr;
			}
	
			$REPLMASQ=$MAPPING{$map};
			debug(2,"Match! Assigning \$REPLMASQ=\$MAPPING{$map}=\"$MAPPING{$map}\"\n");

			if (defined($MAPPINGFCC{$map}))
			{
				$REPLMASQFCC=$MAPPINGFCC{$map};
				debug(2,"FCC Match! Assigning \$REPLMASQFCC=\$MAPPINGFCC{$map}=\"$MAPPINGFCC{$map}\"\n");
			}
			if (defined($MAPPINGSIG{$map}))
			{
				$REPLSIG=$MAPPINGSIG{$map};
				debug(2,"SIG Match! Assigning \$REPLSIG=\$MAPPINGSIG{$map}=\"$MAPPINGSIG{$map}\"\n");
			}
			last;
		}
	}
}

if ( !defined($REPLMASQFCC) )
{
	debug(2,"\$REPLMASQFCC undefined...using default\n");
	$REPLMASQFCC=$CONFIG{DEFAULTREPLMASQFCC};
}
if ( !(defined($REPLSIG)) )
{
	debug(3,"\$REPLSIG not defined ");
	if (defined($CONFIG{DEFAULTREPLSIG}) )
	{
		debug(3,"but \$DEFAULTREPLSIG defined in the config file...using default\n");
		$REPLSIG=$CONFIG{DEFAULTREPLSIG};
	}
	else
	{
		debug(3,"and no \$DEFAULTREPLSIG defined in the config file...using /dev/null\n");
		$REPLSIG="/dev/null";
	}
}

# OK... if there are ADDITIONALENVIRONVARS defined, then...
if ( defined($CONFIG{ADDITIONALENVIRONVARS}) && $CONFIG{ADDITIONALENVIRONVARS} !~ /^\s*$/ )
{
	# For each term defined in the ADDITIONALENVINRONVARS setting
	foreach $var (split($CONFIG{ADDITIONALENVIRONVARS}))
	{
		# If there's a config file with the same name as the entry in the
		# ADDITIONALENVIRONVARS
		if ( defined($CONFIG{$var}))
		{
			@mapping=split($CONFIG{$var});
			# Split up the mapping, which should contain something like:
			#	address value_to_set_in_environ_variable

			for($index=0; $index < $#mapping; ++$index)
			{
				# Now, walk through the list of pairs of (address,envvar) 
				# contained in the variable.

				$match=$mapping[$index];
				$envvar=$index+1;
				if ( $repladdr =~ /$match/ )
				{
					# OK, the reply address matches the pair within the variable
					#
					# Set an environ variable with the name of the existing $var,
					# with a value of the second part of the current pair

					$ENV{$var}=$envvar;
					last;
				}
			}
		}
	}
}
$ENV{REPLMASQ}=$REPLMASQ;
$ENV{REPLMASQFCC}=$REPLMASQFCC;
debug(3,"\$REPLSIG=\"$REPLSIG\"\n");
open(SIG,"$REPLSIG") or die "Could not open signature file \"$REPLSIG\": $!";
# Slurp up the file contents with embedded \n
$sig = do { local $/; <SIG> };
close(SIG) or die "Could not close signature file \"$REPLSIG\": $!";
$ENV{SIGNATURE}="$sig";
debug(3,"Set \$SIGNATURE=\"$sig\"\n");

$newmessage=$message;

debug(2,"About to run system($CONFIG{REAL_REPL} $REAL_ARGS @replopts -file $newmessage)\n");
system("$CONFIG{REAL_REPL} $REAL_ARGS @replopts -file $newmessage");