Perl skript bearbeiten

[thabermann]

Ich müsste ein Perlskript bearbeiten damit ich es einsetzen kann. Das Skript dient dazu auf einem QMail Server in einem Heimnetz die Mails zu maskieren. Wenn userxyz im lokalen Netz im Internet userabc@gmx.de heißt kann das Skript die From: umschreiben. Soweit so gut. Nun möchte ich aber daß auch Return-Path entsprechend angepasst wird, damit das Relayen funktioniert. Allerdings kapier ich das Skript nicht so ganz, aber vielleicht kann mir ja jemand ein paar Típps geben. Das Mail kommt im Standardinput rein.
Hoffe das kommt richtig, sitze grade an einem Win2k:
<BLOCKQUOTE><font size="1" face="Arial,Helvetica,Geneva">Zitat:</font><HR> #!/usr/bin/perl
#
# qmail-masq.pl v0.2 by Davide Giunchi (gdavide@mclink.it)
#
# LICENSE:
#
# Copyright (c) 20001 Davide Giunchi
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
#
# TODO: disable debug mode in next versions

open (CONF, "&lt;/etc/qmail-masq.conf") or die; # open config file or die (file not present?)
while ($riga = &lt;CONF&gt; ) # read and parse config file, get the settings
{
if ($riga =~ /^#.*/) # discard comment line
{
next;
}
if ($riga =~ /^domain=(\S+).*$/) # server domain name, internal network domain
{
$domain=$1;
next;
}
if ($riga =~ /^mail_masq=(\S+).*$/) # default email to use when masquerade
{
$user_masq=$1;
next;
}
if ($riga =~ /^masq=(\S+)=(\S+).*$/) # get the hash 'masq' with the exception
{
$masq{$1}=$2;
next;
}
if ($riga =~ /^debug=(\d).*$/) # enable or disable debug mode
{
$debug=$1;
next;
}
}
close (CONF);

$cont=0;

open (LOG, "&gt;&gt;/tmp/qmail-masq.log") if $debug==1;

while (&lt;STDIN&gt; )
{
if ($end_all==1)
{
print; # header finished so always print until the end of email
print LOG if $debug==1;
next;
}
elsif (/^\n$|^\cM$/) # if there's only a newline in a line
{ # it's sign that the headers are finished
&parse_header (); # call the subrouting to (eventually) change the 'From:' field
for ($c=0;$c!=$cont+1;$c++) # on the sub's exit print the headers
{
print LOG "$c" if $debug==1;
print "$head{$c}";
print LOG "$head{$c}" if $debug==1;
}
print;
$end_all=1;
next;
}
elsif ($found_to==1 && $found_from==1)
{ # found to and from, so wait until the end of header and memorize
&control_cc() if (/^(?:BCC|CC):.*?[^ \t\n\r\f&lt;&gt;]+\@([^ \t\n\r\f&lt;&gt;;,]+).*$/i);
$head{$cont}=$_;
$cont++; # increase generic counter
next;
}
elsif (/^To:.*[^ \t\n\r\f&lt;&gt;]+?\@[^ \t\n\r\f&lt;&gt;,;]+.*?$/) # found 'To:'
{
$head{$cont}=$_;
$cont++;
$found_to=1;
while (/[^ \t\n\r\f&lt;&gt;]+\@([^ \t\n\r\f&gt;&lt;,;]+)/g)
{ # search in all To adressee if there's an external on
$to_external=1 if ($1 ne $domain);
}
next;
}
elsif (/^From :(.*?)([^ \t\n\r\f&lt;&gt;]+?)\@([^ \t\n\r\f&lt;&gt;,;]+)(.*)$/)
{ # found 'From:'
$nome_mitt=$1; # memorize the name e and adress (diveided into user and domain) of the sender
$user_mitt=$2;
$domain_mitt=$3;
$from_altro=$4;
print LOG "DEBUG: From name: $1,user: $2,domain: $3,other: $4\n" if $debug==1; # for debug only
$cont_mitt=$cont; # sign where the 'From:' has been found
$head{$cont}=$_;
$cont++;
$found_from=1;
next;
}
elsif (/^(?:BCC|CC):.*?[^ \t\n\r\f&lt;&gt;]+\@([^ \t\n\r\f&lt;&gt;;,]+).*$/i)
{ # found CC
&control_cc();
$head{$cont}=$_;
$cont++;
next;
}
elsif ($found_to==1 or $found_from==1 or $found_cc==1)
{
$head{$cont}=$_; # if From: , To: or CC: has been found, begin to memorize the lines in the hash
$cont++;
next;
}
else
{ # all the header before From and To print only
print;
}
}


sub parse_header
{
SUB: {
if ($domain_mitt ne $domain)
{ # if the sender is external don't modify nothing and exit from the cycle
last SUB;
}
elsif ($to_external==1) #if the adressee is external and the sender is internal modify the field
{
while (($expect_user, $expect_mail)=each(%masq))
{ # parse the exeption hash, if the name on the hash it's equal to
$user_masq=$expect_mail if ($user_mitt eq $expect_user); # the true adress of sender
} # place the variable with the user to masquerade
$head{$cont_mitt}="From:$nome_mitt"."$user_masq"."$from_altro\n";
last SUB; # modify the 'From:' field
}
else
{
last SUB;
}
}
}

sub control_cc
{
while (/[^ \t\n\r\f&lt;&gt;]+\@([^ \t\n\r\f&gt;&lt;,;]+)/g)
{ # search in all CC adressee if there's an external one
$to_external=1 if ($1 ne $domain);
}
$found_cc=1; # sign that the CC has been found (usless)
}
close (LOG) if $debug==1;
[/quote]