Re: sending valid 'from' field to perl script.

On Thu, 6 Jun 1996, Spiderline Consulting wrote:

> hello.  I have been searching archive's for the answer, but nothing yet..
>
> I'm looking for a way to have procmail pick out the original sender of a 
> the message and then pass it along, with the body of the message, to a 
> perl script.
>
> Perhaps there is a way to pick out the valid field entries (ie, from, to, 
> subject) and then send along with the message?
>
> If not, anyone who can write the section of perl code which *can* do 
> this, please let me know..
What, exactly are you trying to do?

This is a perl script I sue for dealing with known idiots at sites i 
don't want to delete all mail from.  Note how it grabs header info I 
want.  Someone told me that Elf S. wrote the script (NOADS) i based this 
upon.  (This is a perl5 script.  And client is a script I promised the 
author NOT to distribute.  Try feeding to Sendmail instead.)

#!/u9/wotan/bin/perl

$data = "";
while ($line = <STDIN>) {
    $data = "$data$line";
    chop($line);
    if ($line =~ /^$/) { last ; }
    if ($line =~ /^From: (.*)$/) {                          # Get from
        $from = $1 ;
        if ($from =~ /<(.*)>/) { $from = $1 ; } 
        else { $from =~ s/(\S+)\s(.*)$/$1/ ; }
        $from =~ /(.*)\@(.*)/; 
        $user = $1;
        $address = $2;
        $address =~ s/^\W+//g;
        $pmaster = "postmaster\(_at_)$address";
# For the abuse address'.
        if ($address =~ 
/^(netcom.com|aol.com|airmail.net|iadfw.net|hell.corp)$/) {
                $pmaster="abuse\(_at_)$address";
        }

        $from = "$user\(_at_)$address";
                                      # clone address to send copy to postmaster
    }
    if ($line =~ /^Subject: (.*)$/ ) { $subject = $1 ; }
    if (! $subject =~ /^re: /i ) { $subject = "Re: ".$subject ; }
    if ($line =~ /^Message-ID: (.*)$/ ) { $ref = $1 ; }
    if ($line =~ /^To: (.*)$/) {                          # Get from
        $to = $1 ;
        if ($to =~ /<(.*)>/) { $to = $1 ; }
        else { $to =~ s/(\S+)\s(.*)$/$1/ ; }
        $to =~ /(.*)\@(.*)/;
        $tome = $1;
    }
} 

$idiot = $from;
$from = "$from,$pmaster";
$subject =~ s/\\/\\\\/g;
$subject =~ s/"/\\"/g;         # these characters can cause problems, even
                               # inside quotes, on the command line.

###
# get mailing server to claim as the origin
  $machinefrom = "netcom30.netcom.com";

###
# get mailing server to use  
#Needs modification since sometimes this is down.  :-(
#Another day's project
$machine = "netcom23.netcom.com";

#Is the the smtp up today?

open(CHECKSITE, "/usr/etc/ping $machine|");
$input = <CHECKSITE>;
chop $input;
($blah, $reply) = $input =~ /(\S*)\s(\w*\s\w*).*/;
unless ("$reply" eq "is alive") {
    $machine = "netcomsv.netcom.com";
  }

$mailsender = "$tome\(_at_)netcom20(_dot_)netcom(_dot_)com";

###
# now get recipient's account
$mailto = "$idiot";


###
# now read file into a variable
while ($line = <STDIN>) {
  $data = "$data$line";
}

###
# now pack it all up - organized, ready to send
$line1 = "helo $machinefrom\n";
$line2 = "mail from: $mailsender\n";
$line3 = "rcpt to: $mailto,$pmaster\n";
$line4 = "data\n";
$line5 = "Reply-to: $pmaster\n";
$line6 = "From: $mailsender\n";
$line7 = "To: $mailto\n";
$line8 = "cc: $pmaster\n";
$line9 = "Subject: Mail returned unread by procmail (was: $subject)\n";
$line10 = "I have asked once that mail from you cease.  It has not.\n";
$line11 = "So I am now returning all mail from you, unread.  I am also\n"; 
$line12 = "cc'ing your postmaster in the hopes that they will give you a\n";
$line13 = "free clue.\n";
$line14 = "\n";
$line15 = "$data";
$line16 = ".\nquit\n";

$total = 
"$line1$line2$line3$line4$line5$line6$line7$line8$line9$line10$line11$line12$line13$line14$line15$line16";

###
# Finally ship it off to the port and data handling program to be sent
open(SENDTOPORT, "| /u9/wotan/bin/client $machine 25 > /dev/null");
print SENDTOPORT "$total";
close SENDTOPORT;








--
Sedona is pretty this time of the year.  (Having just been there a week ago.)