In the message dated: Tue, 20 Oct 2015 13:56:32 -0400,
The pithy ruminations from Ken Hornstein on
<[Nmh-workers] (n)mh tip of the day> were:
=> I just came up with this, and I thought it might be useful to people.
=>
=> I put in my components file the following line:
=>
=> %<{from}%?(getenv MH_FROM)%|%(void(localmbox))%>%(void(width))%(putaddr
From: )
=>
=> That lets me, in priority order, set my From: header as the following:
=>
=> - The -from switch to comp(1)
=> - The value of the MH_FROM environment variable
=> - Nmh's idea of my local mailbox (configured via Local-Mailbox, or if
=> that's missing taking a guess based on the local username and hostname).
=>
=> I have a few shell aliases which set MH_FROM to useful values. I find
=> myself juggling multiple identities more and more, and I finally got tired
=> of editing my From: header by hand. That's not the only piece of the
=> puzzle, though ... I have a postproc which submits the email to the
=> 'correct' SMTP server and my replcomps has a number of contortions to
I use sendmail's "smarttable" to choose the SMTP server based on recipient
domain (really just $WORK or non-work).
=> choose the correct From: header (that works actually surprisingly well
=> in practice).
=>
=> As a question to everyone else: how do others who juggle multiple email
=> identities make it work?
For sending mail, I usually compose messages via claws-mail, for which
I've got several pre-configured 'identities' that populate the From,
Reply-To, Organization, & FCC headers, as well as setting the quoting
style & signature.
I've got some very dusty shell aliases to do the same, though they're probably
broken.
For replies, I use a perl wrapper around "repl" which examines headers to
determine which of my accounts received the mail, and the corresponding
'identity' to use in the reply. The wrapper has a config file that
defines what fields (From, FCC, signature, etc) to use for each identify.
The wrapper sets environment variables to contain different valies for
the From, Reply-To, and Fcc headers and the signature, then calls the real
"repl".
My replcomps, replgroupcomps, and repl.filter files refer to the environment
variables set in the wrapper in order to poulate fields, as in:
=========== replcomps =======================
%(lit)%(formataddr %<{reply-to}%?{from}%?{sender}%?{return-path}%>)\
%(void(width))%(putaddr To: )
%(lit)%(formataddr{to})%(formataddr{cc})%(formataddr(me))\
%(formataddr{resent-to})%(formataddr{resent-cc})\
%<(nonnull)%(void(width))%(putaddr cc: )\n%>\
CC:
%(void(getenv REPLMASQ))From: %(putstr)
Reply-To: %(putstr)
%(void(getenv REPLMASQFCC))Fcc: %(putstr)
Subject: %<{subject}Re: %{subject}%>
%<{message-id}%<{date}In-Reply-To: Your message of
"%<(nodate{date})%{date}%|%(pretty{date})%>%>." %{mes
sage-id}\nReferences: %{message-id}%<{references} %{references}%>\n%>\
-----\n
=================================================================
============= repl.filter =================
subject:nocompress,nocomponent,formatfield="%(void(getenv SIGNATURE))%(putstr)"
==============================
I've attached the wrapper.
To see the documentation:
pod repl.wrapper
-or-
repl.wrapper --wrap--D
To generate the skeleton of a config file:
repl.wrapper --wrap--C
Comments welcome.
Mark
=>
=> --Ken
=>
--
Mark Bergman Biker, Rock Climber, SCUBA Diver, Unix mechanic, IATSE #1 Stage
hand
'94 Yamaha GTS1000A^2
[email protected]
http://wwwkeys.pgp.net:11371/pks/lookup?op=get&search=bergman%40panix.com
I want a newsgroup with a infinite S/N ratio! Now taking CFV on:
rec.motorcycles.stagehands.pet-bird-owners.pinballers.unix-supporters
15+ So Far--Want to join? Check out: http://www.panix.com/~bergman
#!/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
[email protected]
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: [email protected] [email protected]
Append: [email protected] +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: MAPPING=.*@oldwork.com [email protected]
Append: MAPPINGFCC=.*@colltech.com +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: MAPPING=.*@my-own-domain.com %1
Append: MAPPINGFCC=.*@my-own-domain.com +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 <[email protected]>
=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)=@_;
$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 "\t@_\n";
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)=@_;
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)=@_;
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
@options=@ARGV;
@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,"\@ARGV=\"@ARGV\"\n");
debug(3,"\@replopts=\"@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:
# [email protected] [email protected] [email protected] [email protected]
# where the mappings are as follows:
# mail sent to: [email protected] reply masquerade of [email protected]
# mail sent to: [email protected] reply masquerade of [email protected]
@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 <[email protected]>
# 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 =~ /^[\w\.\-]+@[\w\.\-]+$/ )
{
# 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: REPLMASQ=*liz*@showbiz.com [email protected]
# Append: [email protected] [email protected]
# 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: REPLMASQ=*liz*@showbiz.com [email protected]
# Append: [email protected] [email protected]
# 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");
_______________________________________________
Nmh-workers mailing list
[email protected]
https://lists.nongnu.org/mailman/listinfo/nmh-workers
