eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'

    if 0; # not running under some shell

 

 

 

 

my $children = 4;

my $minperchild = 5;

my $maxperchild = 10;

my $maxsize = 80000;

my $shared=0;

my $debug=0;

my $recipient_mapping=0; # name of the file which will be used

my %recipient_mapping;

 

 

use Sys::Syslog qw(:DEFAULT setlogsock);

 

use Carp;

use Net::SMTP::Server;

use Net::SMTP::Server::Client;

use Mail::SpamAssassin::SMTP::SmartHost;

use Mail::SpamAssassin::NoMailAudit;

use Mail::SpamAssassin;

use Net::DNS;

use Getopt::Long;

use strict;

 

my $spamtest = Mail::SpamAssassin->new();

$spamtest->compile_now(0);      # ensure all modules etc. are preloaded

$/ = "\n";                      # argh, Razor resets this!  Bad Razor!

 

 

my $syntax = "syntax: $0 [--children=$children] [--minperchild=$minperchild] ".

             "[--maxperchild=$maxperchild] [--shared] [--debug] [--recipient_mapping=file]".

             "listen.addr:port talk.addr:port [spamaddr\@example.com]\n";

 

sub stop{

    my $message=$_;

    print $message;

    die $syntax;

 

GetOptions("children=n" => \$children,

           "shared" => \$shared,

           "debug+" => \$debug,

           "recipient_mapping=s" => \$recipient_mapping,

           "minperchild=n" => \$minperchild,

           "maxperchild=n" => \$maxperchild) or &stop("can't get the options !\n");

 

&stop("Numbers of arguments must be at least two !\n") unless @ARGV == 2;

 

my ($srcaddr, $srcport) = split /:/, $ARGV[0];

my ($dstaddr, $dstport) = split /:/, $ARGV[1];

my $spamaddr;

if(@ARGV == 3) {

  $spamaddr = $ARGV[2];

} else {

  $spamaddr = "recipient";

 

if ($recipient_mapping)

 

    print "opening file $recipient_mapping ...\n" if $debug;

    open(RECIPIENT_MAPPING,$recipient_mapping) || die "can't open $recipient_mapping, $!";

    my @recipient_mapping=<RECIPIENT_MAPPING>;

    close RECIPIENT_MAPPING;

    foreach (@recipient_mapping)

    {

        next if /^\s*\#/;

        if (/([\w\-@\.\+<>]+)\s+([\w\-@\.\+<>]+)/)

        {

            my $destination=$1;

            my $rewrite=$2;

            print "$destination -> $rewrite\n" if $debug;

            $recipient_mapping{$destination}=$rewrite;

        }

    }

 

 

my $trying_message="Trying to start using source $srcaddr port $srcport, " .

    "destination $dstaddr port $dstport, " .

    "reporting e-mail address $spamaddr.".

    " shared : $shared".

    " recipient_mapping file : $recipient_mapping".

    " debug : $debug\n";

 

print $trying_message;

 

setlogsock 'unix';

openlog('spamassassin', 'nowait', 'local3');

syslog('notice', $trying_message);

closelog();

 

&stop("srcport or dstport not defined !\n") unless defined($srcport) and defined($dstport)

  and defined($spamaddr);

 

my $smarthost=$dstaddr . ":" . $dstport;

 

 

my $server = new Net::SMTP::Server($srcaddr, $srcport) ||

  croak("Unable to create server: $!\n");

 

my $startup_message= "Server started on address $srcaddr port $srcport " .

      "with destination address $dstaddr port $dstport\n";

 

print $startup_message;

 

setlogsock 'unix';

openlog('spamassassin', 'nowait', 'local3');

syslog('notice', $startup_message);

closelog();

 

 

my %children;

use vars qw($please_die);

$please_die = 0;

$SIG{TERM} = sub { $please_die = 1; };

 

 

PARENT: while (1) {

    while (scalar(keys %children) >= $children) {

        my $child = wait;

        delete $children{$child} if exists $children{$child};

        if ($please_die) { kill 15, keys %children; exit 0; }

    }

    my $pid = fork;

    die "$0: fork failed: $!\n" unless defined $pid;

    last PARENT if $pid == 0;

    $children{$pid} = 1;

    select(undef, undef, undef, 0.1);

    if ($please_die) { kill 15, keys %children; exit 0; }

 

 

my $lives = $minperchild + (rand($maxperchild - $minperchild));

my %opts;

 

while(my $conn = $server->accept()) {

    my $port=$conn->peerport();

    print "getting connection port $port\n" if $debug;

    my $client = new Net::SMTP::Server::Client($conn) ||

      croak("Unable to handle client connection: $!\n");

 

    # [MSDW]

    # Process the client.  This command will block until

    # the connecting client completes the SMTP transaction.

    $client->process || next;

 

    # Mail::SpamAssassin::NoMailAudit wants an array of lines, while the

    # server returns a huge string.  Since I am unsure whether it needs to

    # have the CR/LF pair for each line for use with Razor, after splitting

    # it, using the CR/LF pairs as delimiters, I walk over the message again

    # to re-add them.  Once the array is populated and tweaked, it is then

    # handed to a new Mail::SpamAssassin::NoMailAudit object.

    # --irj

 

    # perldoc -f split

    #split   Splits a string into a list of strings and returns

    #           that list.  By default, empty leading fields are

    #           preserved, and empty trailing ones are deleted.

    #

    # so, it removes last empty lines !!! -> hence the last argument, -1

   

 

    my $message = $client->{MSG};

 

        my $len = length($client->{MSG});

        my $tmpMessage = "Message length is : ".$len." chars\n";

        setlogsock 'unix';

        openlog('spamassassin', 'nowait', 'local3');

        syslog('notice', $tmpMessage);

        closelog();

 

    my $recips;

    my $msg;

 

   if ($len < $maxsize)

   {

    my @msg = split ("\r\n", $message,'-1');

    my $arraycont = @msg; for(0..$arraycont) { $msg[$_] .= "\r\n"; }

    my %args = (data => \@msg);

    my $mail = Mail::SpamAssassin::NoMailAudit->new(%args);

 

    # At some point, I may also put some other code so I can go grab

    # preferences, e.g. via MySQL, e.g. scoring parameters, or even whether to

    # filter at all (hey, with Perl + MySQL, your imagination is the

    # limit).

    #

    # This is where the testing actually happens.  In this example, which I

    # have in an actual production environment (save the address), I have it

    # rewriting the message then forwarding to a collection account for

    # examination.  The addresses have been changed to protect the innocent.

    #

    # If the message is OK, we skip doing anything with the object and

    # instead, pass the original message to the smarthost code below.

    # --irj

 

    my $status = $spamtest->check($mail);

    my @msg_debug;

 

    if ($status->is_spam ()) {

        $msg = sprintf("    SPAM[%6.1f]: %s", $status->get_hits(), $status->get_names_of_tests_hit());

        # add headers

        $status->rewrite_mail ();

       

        my $header=join("",$mail->header());

        my $body=join("",@{$mail->body()});

        $message = join ("\r\n",$header,$body);

 

        # $message = join ("",$mail->header(),@{$mail->body()}); # original

        print $message,"\n" if $debug>=2;

 

        # check if the mail goes to one address

        if($spamaddr ne "recipient") {

          my @recipients = ("$spamaddr");

          $recips = \@recipients;

        } else {

            $recips = $client->{TO};

         

 

            if ($shared)

            {

                my @rewrite=map {my $init=$_;s/<(.*?)(\@.*)/<shared+user.$1.spam$2/g;

                             push @msg_debug,"rewrite shared $init -> $_";$shared} @{$client->{TO}};

               

                $recips=\@rewrite;

            }

           

           

            if ($recipient_mapping)

            {

                # if there is an entry in the recipient mapping, replace it by the value

                # otherwise let it alone.

                my @rewrite=map { if ($recipient_mapping{$_})

                                  {push @msg_debug,"rewrite $_ -> $recipient_mapping{$_}";

                                   $recipient_mapping{$_}}

                                  else{push @msg_debug,"not rewriting $_";$_}} @{$client->{TO}};

               

                $recips=\@rewrite;

            }

           

 

        }

    } else {

        $msg = sprintf("NOT_SPAM[%6.1f]: %s", $status->get_hits(), $status->get_names_of_tests_hit());

 

        # added the next 2 lines so that even if it's not spam we got statistics (xavier renaut)

 

        $status->rewrite_mail ();

        my $header=join("",$mail->header());

        my $body=join("",@{$mail->body()});

        $message = join ("\r\n",$header,$body);

        print $message,"\n" if $debug>=2;

        # end of addition

 

        $recips = $client->{TO};

    }

 

    setlogsock 'unix';

    openlog('spamassassin', 'nowait', 'local3');

    syslog('notice', $msg);

    if ($debug)

    {

        foreach (@msg_debug)

        {

            syslog('notice', $_);

            print $_,"\n";

        }

    }

    closelog();

 

    $status->finish();

 

    # Here is where we actually connect back into Postfix or wherever.  As

    # has been mentioned before, more detailed information on how to set

    # Postfix up to use an "advanced" filter setup, directly upon this

    # documentation this implementation is based.

    #

    # Here, we need to use a hacked version of Net::SMTP::Server::Relay to

    # make this work, which I will bundle in along with the script.  I made

    # no other modifications to the rest of the distribution (which is

    # required to make this work and is in CPAN).

    # --irj

    my $relay = new Mail::SpamAssassin::SMTP::SmartHost($client->{FROM},

                                                 $recips,

                                                 $message,

                                                 "$smarthost");

   

    } else

    {

 

    my @msg = split ("\r\n", $message,'-1');

    my $arraycont = @msg; for(0..$arraycont) { $msg[$_] .= "\r\n"; }

    my %args = (data => \@msg);

    my $mail = Mail::SpamAssassin::NoMailAudit->new(%args);

    my $header=join("",$mail->header());

    my $body=join("",@{$mail->body()});

    $message = join ("\r\n",$header,$body);

    print $message,"\n" if $debug>=2;

    $recips = $client->{TO};

 

    my $relay = new Mail::SpamAssassin::SMTP::SmartHost($client->{FROM},

                                                 $recips,

                                                 $message,

                                                 "$smarthost");

 

    }

 

 

    # Zap this instance if this child's processing limit has been reached.

    # --irj

    print "mail     delivered port $port\n" if $debug;

   

    delete $server->{"s"};

    exit 0 if $lives-- <= 0;