Hi, folks,
I'd like to send a string ($line) as an e-mail from within a script.
I receive regular e-mail forwards from a college I teach at, because I
don't want to use their Outlook webmail. In the process of being
forwarded, each message gets rewritten by Outlook's webmail forwarder.
I've set up an e-mail filter (in HostMonster's cPanel) that pipes these
forwarded messages to a Perl script. The main part of the script
restores as much of the message as possible (given my very limited
knowledge of Perl). The final step I need is to send myself the restored
e-mail, the entirety of which is stored in the variable $line.
So that's my first question: how do I send the string $line -- which is
a multipart MIME message, often with one or more attachments -- as a new
e-mail to myself?
Plus, there might be a complication: three of the things I've restored
are the 'From:', 'To:' and 'Cc:' headers. Often the restored message
will, according to its header, be addressed to several people in
addition to me. How do I e-mail myself the string $line, but make sure
it only gets delivered to me and not to the other recipients in the header?
Below is the entire script for reference. The place where I want to send
$line as an e-mail is the second-to-last line.
(I should say that I have not tested this version of the script yet.
I've only been testing it with text file replicas of raw e-mails on my
computer, reading the text into the string $line, and then concluding by
printing $line in the Terminal. Also, I apologize for all the inelegance
of this code -- repeated sections instead of functions, probably sloppy
regex, and so on. This is rookie stuff.)
- Mark
#!/usr/bin/env perl
use warnings;
use strict;
use Data::Dumper;
####GET THE FULL E-MAIL AS RAW TEXT AND STORE IN $line
while ( $line = <STDIN> )
{
chomp $line;
#We're going to need the following string multiple times
my $atMCC = '@mcc.commnet.edu';
####EXTRACT THE ORIGINAL PLAIN-TEXT HEADER FROM THE MESSAGE BODY:
if ( $line =~ m/(Content-Transfer-Encoding:
quoted-printable\n)(\n\n-------------------------------------------\n)(.*?)(\nAuto
forwarded by a Rule)/s )
{
$::header = $2 . $3 . $4;
}
####EXTRACT & MASSAGE THE SENDER CONTAINED IN $header.
##Case: \nFrom: First Last[SMTP:a...@domain.ext]
##\nFrom: First \s Last '[SMTP:' E-mail
']'
##($1) ($2) ($3) ($4) ($5) ($6)
($7)
if ( $::header =~ m/(\nFrom:
)(.*?)(\[SMTP:)(\b[a-za-z0-9._%+...@[a-za-z0-9.-]+\.[a-za-z]{2,4}\b)(]\n)/s
)
{
my $emailString = $4;
$emailString =~ tr/A-Z/a-z/; # convert to lower case
$::from = $1.$2.' <'.$emailString.'>';
}
##Case: \nFrom: Last , F---irst [M]
## ($1) ($2) ($3) ($4)($5)
elsif ( $::header =~ m/(\nFrom:\s)(.*?)(,\s)(\w)(\w+)/s )
{
$::from = $1.$4.$5.' '.$2.' <'.$4.$2.$atMCC.'>';
##Check for a 'St. Someone' name in e-mail address!
if ( $::from =~ m/St\. / )
{
$::from =~ s/(.*?<.*)(St\. )(.*?)/$1St$3/g;
}##Check for two separate words in last name in e-mail address!
if ( $::from =~ m/(\n.*<\S+) (\...@\s+)/ )
{
$::from =~ s/(\n.*<\S+)( )(\...@\s+)/$1$3/g;
}
}
####EXTRACT THE RAW RECIPIENT(S) CONTAINED IN $header.
##Check to see if there's a 'CC: ' header. If so, grab 'To: '
*and* 'CC: '
$::CCswitch = "No";
if ( $::header =~ m/(\nCC:\s)/si )
{
$::CCswitch = "Yes";
##Grab the entire 'To: ' header and store in $::toRaw
if ( $::header =~ m/\n(To: .*?)\nCC:\s/si )
{
$::toRaw = $1;
}
##Grab the entire 'CC: ' header (case insensitive) and store in
$::ccRaw
if ( $::header =~ m/\n(CC:\s)(.*?)\nSubject:\s/si )
{
$::ccRaw = $1.$2;
}
##Populate @::ccHeader
##Do we need to split $::ccRaw?
if ($::ccRaw =~ m/(CC: )(.*;\s.*)/si )
{
my $ccNames = $2;
##Replace all occurrences of '\n' with '\s'
$ccNames =~ s/(\n)(\w)/ $2/g;
$ccNames =~ s/\n//g;
@::ccHeader = split('; ', $ccNames);
}
else
{
$::ccRaw =~ s/Cc: //g;
@::ccHeader = ();
$::ccHeader[0] = $::ccRaw;
}
##Process each item in the array @::ccHeader
foreach $::ccName (@::ccHeader)
{
#If $ccHeader[n] contains "," then convert it
## Last , F...irst [M]
## ($1) ($2)($3)($4)
if ( $::ccName =~ m/(.*?)(, )(\w)(\w+)/s )
{
$::cc = $3.$4.' '.$1.' <'.$3.$1.$atMCC.'>';
##Check for a 'St. Someone' name in e-mail address!
if ( $::cc =~ m/St\. / )
{
$::cc =~ s/(.*?<.*)(St\. )(.*?)/$1St$3/g;
}##Check for two separate words in last name in
e-mail address!
if ( $::cc =~ m/(.*<\S+) (\...@\s+)/ )
{
$::cc =~ s/(.*<\S+)( )(\...@\s+)/$1$3/g;
}
$::ccName = $::cc;
}
}
}
##If no 'CC: ' header, just grab the 'To: ' header and store in
$::toRaw
elsif ( $::header =~ m/\n(To: .*?)\nSubject:\s/s )
{
$::toRaw = $1;
#To avoid having to do tests down the road, create a null
@::ccHeader
@::ccHeader = ();
}
####MASSAGE THE RECIPIENT(S) CONTAINED IN $::toRaw (and $::ccRaw,
if it exists).
##Do we need arrays?
if ($::toRaw =~ m/(To: )(.*;\s.*)/s )
{
my $toNames = $2;
##Replace all occurrences of '\n' with '\s'
$toNames =~ s/(\n)(\w)/ $2/g;
$toNames =~ s/\n//g;
@::toHeader = split('; ', $toNames);
}
else
{
$::toRaw =~ s/To: //g;
@::toHeader = ();
$::toHeader[0] = $::toRaw;
}
##Process each item in the array @::toHeader
foreach $::toName (@::toHeader)
{
#If $toHeader[n] contains "," then convert it
## Last , F...irst [M]
## ($1) ($2)($3)($4)
if ( $::toName =~ m/(.*?)(, )(\w)(\w+)/s )
{
$::to = $3.$4.' '.$1.' <'.$3.$1.$atMCC.'>';
##Check for a 'St. Someone' name in e-mail address!
if ( $::to =~ m/St\. / )
{
$::to =~ s/(.*?<.*)(St\. )(.*?)/$1St$3/g;
}##Check for two separate words in last name in e-mail
address!
if ( $::to =~ m/(.*<\S+) (\...@\s+)/ )
{
$::to =~ s/(.*<\S+)( )(\...@\s+)/$1$3/g;
}
$::toName = $::to;
}
}
##If more than one element in @::toHeader, add semicolons back in
if ( scalar( @::toHeader ) > 1 )
{
$::toString = join( '; ', @::toHeader );
}
else { $::toString = $::toHeader[0] }
##Repeat: If more than one element in @::ccHeader, put back
semicolons
if ( scalar( @::ccHeader ) > 1 )
{
$::ccString = join( '; ', @::ccHeader );
}
##Concatenate the 'TO' and 'CC' strings into $::recipientString
if ( length ( $::ccString ) > 3 )
{
$::recipientString = $::toString . "\nCc: " . $::ccString;
}
else { $::recipientString = $::toString }
####Replace in $line (i.e. the actual e-mail) the actual message
####header elements From, To, CC, and Subject, as well as the
####annoying header info in the e-mail's body.
if ( $line =~ m/(\n)(From: "myLastname, myFirstname MI"
<flastna...@mcc\.commnet\.edu>\n)(To: <m...@mydomain\.org>)\n/s )
{
$::originalFromTo = $1 . "X-Outlook's Original " . $2 .
"X-Outlook's Original " . $3;
$line =~ s/(.*?)(\nFrom: "myLastname, myFirstname MI"
<flastna...@mcc\.commnet\.edu>)(\nTo:
)(<m...@mydomain\.org>\n)(.*?)/$1$::from$3$::recipientString\n$5/g;
}
####DELETE "FW: " FROM THE SUBJECT HEADER
$line =~ s/\nSubject: FW: {1}?/\nSubject: /g;
####DELETE INTERPOLATED HEADER SEGMENTS IN THE E-MAIL'S BODY
##Delete the Plain-Text version
$line =~
s/\n\n-------------------------------------------\n.*?\nAuto forwarded
by a Rule//s;
##Delete the HTML version
$line =~
s/\n<body.*?>\n.*?-------------------------------------------.*?Auto
forwarded by a =\nRule.{22}?\n//si;
####Send the new version of the e-mail
#DO SOMETHING TO SEND "$line" TO ONLY MY E-MAIL ADDRESS, WHILE
PRESERVING ALL THE HEADERS;
} #END OF 'WHILE' BLOCK
