PERL   25

spamproxyd

Guest on 18th August 2022 01:18:59 AM

  1. #!/usr/bin/perl -w
  2.  
  3.  
  4. eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
  5.     if 0; # not running under some shell
  6.  
  7. # Some configurable stuff here.  This may get offloaded to a file in the
  8. # future.
  9.  
  10. # $smarthost="localhost:10026";
  11.  
  12. # Some stuff from MSDW's smtpprox for preforking stuff
  13.  
  14. my $children = 4;
  15. my $minperchild = 5;
  16. my $maxperchild = 10;
  17. my $maxsize = 80000;
  18. my $shared=0;
  19. my $debug=0;
  20. my $recipient_mapping=0; # name of the file which will be used
  21. my %recipient_mapping;
  22.  
  23. # This file is based largely on example code bundled with MacGyver's
  24. # Net::SMTP::Server kit, but with some additional stuff to use
  25. # Mail::SpamAsssassin and a modified version of Net::SMTP::Server::Relay so
  26. # then it becomes Net::SMTP::Server::SmartHost.  This way I can direct mail
  27. # to a specific mailserver specified.  ::Relay does MX lookups which isn't
  28. # what we want, but instead, reinject the message back into the system via
  29. # an unfiltered version of SMTP server
  30. #
  31. # This was written with Postfix in mind, but nothing says you cannot use it
  32. # for another MTA.  Be sure to read FILTER_README for a bit more background
  33. # on how to integrate an SMTP-based filter (considered an "advanced" method).
  34. #
  35. # --Ian R. Justman <ianj@esper.net>, 11/21/2001
  36.  
  37. use Sys::Syslog qw(:DEFAULT setlogsock);
  38.  
  39. use Carp;
  40. use Net::SMTP::Server;
  41. use Net::SMTP::Server::Client;
  42. use Mail::SpamAssassin::SMTP::SmartHost;
  43. use Mail::SpamAssassin::NoMailAudit;
  44. use Mail::SpamAssassin;
  45. use Net::DNS;
  46. use Getopt::Long;
  47. use strict;
  48.  
  49. my $spamtest = Mail::SpamAssassin->new();
  50. $spamtest->compile_now(0);      # ensure all modules etc. are preloaded
  51. $/ = "\n";                      # argh, Razor resets this!  Bad Razor!
  52.  
  53. # This is the preforking and option-parsiong section taken from the MSDW
  54. # smtpproxy code by Bennett Todd.  Any comments from that code are not my
  55. # own comments (marked with "[MSDW]") unless otherwise noted.
  56. #
  57. # Depending on your platform, you may need his patch which uses
  58. # IPC/semaphores to get information which may be required to allow two
  59. # simultaneous instances to accept() a connection, which can be obtained at
  60. # http://bent.latency.net/smtpprox/smtpprox-semaphore-patch.  It is best to
  61. # apply the patch to the original script, then port it to this one.
  62. #
  63. # --irj
  64.  
  65. my $syntax = "syntax: $0 [--children=$children] [--minperchild=$minperchild] ".
  66.              "[--maxperchild=$maxperchild] [--shared] [--debug] [--recipient_mapping=file]".
  67.              "listen.addr:port talk.addr:port [spamaddr\@example.com]\n";
  68.  
  69. sub stop{
  70.     my $message=$_;
  71.     print $message;
  72.     die $syntax;
  73. }
  74.  
  75. GetOptions("children=n" => \$children,
  76.            "shared" => \$shared,
  77.            "debug+" => \$debug,
  78.            "recipient_mapping=s" => \$recipient_mapping,
  79.            "minperchild=n" => \$minperchild,
  80.            "maxperchild=n" => \$maxperchild) or &stop("can't get the options !\n");
  81.  
  82. &stop("Numbers of arguments must be at least two !\n") unless @ARGV == 2;
  83.  
  84. my ($srcaddr, $srcport) = split /:/, $ARGV[0];
  85. my ($dstaddr, $dstport) = split /:/, $ARGV[1];
  86. my $spamaddr;
  87. if(@ARGV == 3) {
  88.   $spamaddr = $ARGV[2];
  89. } else {
  90.   $spamaddr = "recipient";
  91. }
  92.  
  93. if ($recipient_mapping)
  94. {
  95.  
  96.     print "opening file $recipient_mapping ...\n" if $debug;
  97.     open(RECIPIENT_MAPPING,$recipient_mapping) || die "can't open $recipient_mapping, $!";
  98.     my @recipient_mapping=<RECIPIENT_MAPPING>;
  99.     close RECIPIENT_MAPPING;
  100.     foreach (@recipient_mapping)
  101.     {
  102.         next if /^\s*\#/;
  103.         if (/([\w\-@\.\+<>]+)\s+([\w\-@\.\+<>]+)/)
  104.         {
  105.             my $destination=$1;
  106.             my $rewrite=$2;
  107.             print "$destination -> $rewrite\n" if $debug;
  108.             $recipient_mapping{$destination}=$rewrite;
  109.         }
  110.     }
  111. }
  112.  
  113.  
  114. my $trying_message="Trying to start using source $srcaddr port $srcport, " .
  115.     "destination $dstaddr port $dstport, " .
  116.     "reporting e-mail address $spamaddr.".
  117.     " shared : $shared".
  118.     " recipient_mapping file : $recipient_mapping".
  119.     " debug : $debug\n";
  120.  
  121. print $trying_message;
  122.  
  123. setlogsock 'unix';
  124. openlog('spamassassin', 'nowait', 'local3');
  125. syslog('notice', $trying_message);
  126. closelog();
  127.  
  128. &stop("srcport or dstport not defined !\n") unless defined($srcport) and defined($dstport)
  129.   and defined($spamaddr);
  130.  
  131. my $smarthost=$dstaddr . ":" . $dstport;
  132.  
  133. # Set up the server using the IP address and port specified on the command
  134. # line by the user.
  135. #
  136. # Since a vast majority of the SMTP code is based on MacGyver's sample code,
  137. # I'll spare everyone those details here as that info is in his code.
  138. # Instead,  I'll be concentrating on the message-handling portion. --irj
  139.  
  140. my $server = new Net::SMTP::Server($srcaddr, $srcport) ||
  141.   croak("Unable to create server: $!\n");
  142.  
  143. my $startup_message= "Server started on address $srcaddr port $srcport " .
  144.       "with destination address $dstaddr port $dstport\n";
  145.  
  146. print $startup_message;
  147.  
  148. setlogsock 'unix';
  149. openlog('spamassassin', 'nowait', 'local3');
  150. syslog('notice', $startup_message);
  151. closelog();
  152.  
  153. # [MSDW]
  154. # This should allow a kill on the parent to also blow away the
  155. # children, I hope
  156.  
  157. my %children;
  158. use vars qw($please_die);
  159. $please_die = 0;
  160. $SIG{TERM} = sub { $please_die = 1; };
  161.  
  162. # [MSDW]
  163. # This sets up the parent process
  164.  
  165. PARENT: while (1) {
  166.     while (scalar(keys %children) >= $children) {
  167.         my $child = wait;
  168.         delete $children{$child} if exists $children{$child};
  169.         if ($please_die) { kill 15, keys %children; exit 0; }
  170.     }
  171.     my $pid = fork;
  172.     die "$0: fork failed: $!\n" unless defined $pid;
  173.     last PARENT if $pid == 0;
  174.     $children{$pid} = 1;
  175.     select(undef, undef, undef, 0.1);
  176.     if ($please_die) { kill 15, keys %children; exit 0; }
  177. }
  178.  
  179. # [MSDW]
  180. # This block is a child service daemon. It inherited the bound
  181. # socket created by SMTP::Server->new, it will service a random
  182. # number of connection requests in [minperchild..maxperchild] then
  183. # exit
  184.  
  185. my $lives = $minperchild + (rand($maxperchild - $minperchild));
  186. my %opts;
  187.  
  188. while(my $conn = $server->accept()) {
  189.     my $port=$conn->peerport();
  190.     print "getting connection port $port\n" if $debug;
  191.     my $client = new Net::SMTP::Server::Client($conn) ||
  192.       croak("Unable to handle client connection: $!\n");
  193.  
  194.     # [MSDW]
  195.     # Process the client.  This command will block until
  196.     # the connecting client completes the SMTP transaction.
  197.     $client->process || next;
  198.  
  199.     # Mail::SpamAssassin::NoMailAudit wants an array of lines, while the
  200.     # server returns a huge string.  Since I am unsure whether it needs to
  201.     # have the CR/LF pair for each line for use with Razor, after splitting
  202.     # it, using the CR/LF pairs as delimiters, I walk over the message again
  203.     # to re-add them.  Once the array is populated and tweaked, it is then
  204.     # handed to a new Mail::SpamAssassin::NoMailAudit object.
  205.     # --irj
  206.  
  207.     # perldoc -f split
  208.     #split   Splits a string into a list of strings and returns
  209.     #           that list.  By default, empty leading fields are
  210.     #           preserved, and empty trailing ones are deleted.
  211.     #
  212.     # so, it removes last empty lines !!! -> hence the last argument, -1
  213.    
  214.  
  215.     my $message = $client->{MSG};
  216.  
  217.         my $len = length($client->{MSG});
  218.         my $tmpMessage = "Message length is : ".$len." chars\n";
  219.         setlogsock 'unix';
  220.         openlog('spamassassin', 'nowait', 'local3');
  221.         syslog('notice', $tmpMessage);
  222.         closelog();
  223.  
  224.     my $recips;
  225.     my $msg;
  226.  
  227.    if ($len < $maxsize)
  228.    {
  229.     my @msg = split ("\r\n", $message,'-1');
  230.     my $arraycont = @msg; for(0..$arraycont) { $msg[$_] .= "\r\n"; }
  231.     my %args = (data => \@msg);
  232.     my $mail = Mail::SpamAssassin::NoMailAudit->new(%args);
  233.  
  234.     # At some point, I may also put some other code so I can go grab
  235.     # preferences, e.g. via MySQL, e.g. scoring parameters, or even whether to
  236.     # filter at all (hey, with Perl + MySQL, your imagination is the
  237.     # limit).
  238.     #
  239.     # This is where the testing actually happens.  In this example, which I
  240.     # have in an actual production environment (save the address), I have it
  241.     # rewriting the message then forwarding to a collection account for
  242.     # examination.  The addresses have been changed to protect the innocent.
  243.     #
  244.     # If the message is OK, we skip doing anything with the object and
  245.     # instead, pass the original message to the smarthost code below.
  246.     # --irj
  247.  
  248.     my $status = $spamtest->check($mail);
  249.     my @msg_debug;
  250.  
  251.     if ($status->is_spam ()) {
  252.         $msg = sprintf("    SPAM[%6.1f]: %s", $status->get_hits(), $status->get_names_of_tests_hit());
  253.         # add headers
  254.         $status->rewrite_mail ();
  255.        
  256.         my $header=join("",$mail->header());
  257.         my $body=join("",@{$mail->body()});
  258.         $message = join ("\r\n",$header,$body);
  259.  
  260.         # $message = join ("",$mail->header(),@{$mail->body()}); # original
  261.         print $message,"\n" if $debug>=2;
  262.  
  263.         # check if the mail goes to one address
  264.         if($spamaddr ne "recipient") {
  265.           my @recipients = ("$spamaddr");
  266.           $recips = \@recipients;
  267.         } else {
  268.             $recips = $client->{TO};
  269.          
  270.  
  271.             if ($shared)
  272.             {
  273.                 my @rewrite=map {my $init=$_;s/<(.*?)(\@.*)/<shared+user.$1.spam$2/g;
  274.                              push @msg_debug,"rewrite shared $init -> $_";$shared} @{$client->{TO}};
  275.                
  276.                 $recips=\@rewrite;
  277.             }
  278.            
  279.            
  280.             if ($recipient_mapping)
  281.             {
  282.                 # if there is an entry in the recipient mapping, replace it by the value
  283.                 # otherwise let it alone.
  284.                 my @rewrite=map { if ($recipient_mapping{$_})
  285.                                   {push @msg_debug,"rewrite $_ -> $recipient_mapping{$_}";
  286.                                    $recipient_mapping{$_}}
  287.                                   else{push @msg_debug,"not rewriting $_";$_}} @{$client->{TO}};
  288.                
  289.                 $recips=\@rewrite;
  290.             }
  291.            
  292.  
  293.         }
  294.     } else {
  295.         $msg = sprintf("NOT_SPAM[%6.1f]: %s", $status->get_hits(), $status->get_names_of_tests_hit());
  296.  
  297.         # added the next 2 lines so that even if it's not spam we got statistics (xavier renaut)
  298.  
  299.         $status->rewrite_mail ();
  300.         my $header=join("",$mail->header());
  301.         my $body=join("",@{$mail->body()});
  302.         $message = join ("\r\n",$header,$body);
  303.         print $message,"\n" if $debug>=2;
  304.         # end of addition
  305.  
  306.         $recips = $client->{TO};
  307.     }
  308.  
  309.     setlogsock 'unix';
  310.     openlog('spamassassin', 'nowait', 'local3');
  311.     syslog('notice', $msg);
  312.     if ($debug)
  313.     {
  314.         foreach (@msg_debug)
  315.         {
  316.             syslog('notice', $_);
  317.             print $_,"\n";
  318.         }
  319.     }
  320.     closelog();
  321.  
  322.     $status->finish();
  323.  
  324.     # Here is where we actually connect back into Postfix or wherever.  As
  325.     # has been mentioned before, more detailed information on how to set
  326.     # Postfix up to use an "advanced" filter setup, directly upon this
  327.     # documentation this implementation is based.
  328.     #
  329.     # Here, we need to use a hacked version of Net::SMTP::Server::Relay to
  330.     # make this work, which I will bundle in along with the script.  I made
  331.     # no other modifications to the rest of the distribution (which is
  332.     # required to make this work and is in CPAN).
  333.     # --irj
  334.     my $relay = new Mail::SpamAssassin::SMTP::SmartHost($client->{FROM},
  335.                                                  $recips,
  336.                                                  $message,
  337.                                                  "$smarthost");
  338.    
  339.     } else
  340.     {
  341.  
  342.     my @msg = split ("\r\n", $message,'-1');
  343.     my $arraycont = @msg; for(0..$arraycont) { $msg[$_] .= "\r\n"; }
  344.     my %args = (data => \@msg);
  345.     my $mail = Mail::SpamAssassin::NoMailAudit->new(%args);
  346.     my $header=join("",$mail->header());
  347.     my $body=join("",@{$mail->body()});
  348.     $message = join ("\r\n",$header,$body);
  349.     print $message,"\n" if $debug>=2;
  350.     $recips = $client->{TO};
  351.  
  352.     my $relay = new Mail::SpamAssassin::SMTP::SmartHost($client->{FROM},
  353.                                                  $recips,
  354.                                                  $message,
  355.                                                  "$smarthost");
  356.  
  357.     }
  358.  
  359.  
  360.     # Zap this instance if this child's processing limit has been reached.
  361.     # --irj
  362.     print "mail     delivered port $port\n" if $debug;
  363.    
  364.     delete $server->{"s"};
  365.     exit 0 if $lives-- <= 0;
  366. }
  367.  
  368.  
  369. =head1 NAME
  370.  
  371. spamproxyd - mail filter to identify spam using text analysis
  372.  
  373. =head1 SYNOPSIS
  374.  
  375. =over
  376.  
  377. =item spamproxyd
  378.  
  379. =back
  380.  
  381. =head1 OPTIONS
  382.  
  383. =over 4
  384.  
  385. --shared deliver the spam to shared+user.$user.spam
  386.    (usefull for imap users (i'm using cyrus))
  387.  
  388. --debug print the recipient inside of spamproxyd (using twice --debug will increase the debug)
  389.  
  390. --recipient_mapping=file  reads a file which contains two emails per line
  391.     (with <> around each email (depending on your mta)), space separated.
  392.     the spam coming to the first email will be sent to the second email
  393.     (example : <joe@mydomain.com> <joe-spam@mydomain.com>
  394.  
  395.  
  396.  
  397. spamproxyd used Mail::Spamassassin, which loads local.cf
  398. (in rules directory) as site-wide preferences. You may want to add/modify it.
  399.  
  400. =back
  401.  
  402. =head1 DESCRIPTION
  403.  
  404. IMPORTANT!  PLEASE read CHANGES.spamproxy before continuing!
  405.  
  406. This is a prototype for an SMTP filter based on Mail::SpamAssassin
  407. (http://spamassassin.org, http://spamassassin.sourceforge.net).
  408.  
  409. This was originally written with Postfix's filering in mind, based on the
  410. "advanced" example detailed in the FILTER_README file in the Postfix
  411. distribution, but there's no reason why it couldn't be used with other
  412. servers.
  413.  
  414. This script is just proof of concept right now; it may more than likely not
  415. be usable in a larger-scale environment where there's high volumes of mail
  416. being transferred.  However, it's currently good enough for a small-scale
  417. environment, like the IRC network for which I serve as postmaster, along
  418. with several other people I service on a small machine.
  419.  
  420. This script requires Mail::Assassin (see above) and Net::SMTP::Server
  421. (http://www.macgyver.org/software/perl/, plus it is also in CPAN).  You also
  422. need a modified version of one of the modules in order to connect to a
  423. specific SMTP server, which I include in the package.
  424.  
  425. Right now, this script has a couple of shortcomings:
  426.  
  427. 1.  Configurability, configurability!  This is especially true if this will
  428.     filter for multiple people whose needs may be quite different, including
  429.     per-user weighting of the "suspicious stuff", white-lists, etc, and of
  430.     course, whether to tag spam then deliver (if wanted), even whether to
  431.     filter at all.
  432.  
  433. 2.  What do YOU want? Who knows?  With Perl, your imagination's the limit.
  434.  
  435. So far, I've managed to zap quite a bit of spam that'd normally go right
  436. through the server.  With Vipul's Razor, this can go up quite a bit.  If
  437. anyone has any ideas about Vipul's Razor and how I populate my arrays,
  438. please let me know.
  439.  
  440. =head1 SEE ALSO
  441.  
  442. Mail::SpamAssassin(3)
  443. Net::SMTP::Server(3)
  444.  
  445. =head1 AUTHOR
  446.  
  447. Ian R. Justman E<lt>ianj@esper.netE<gt>
  448.  
  449. =head1 CREDITS
  450.  
  451. Justin Mason and Craig Hughes for B<Mail::SpamAssassin>
  452.  
  453. Habeeb J. "MacGyver" Dihu for his B<Net::SMTP::Server> code
  454.  
  455. Bennett Todd for the perforking code and option-parsing code from his
  456.     pacakge, smtpproxy
  457.  
  458. Alexandre Dulaunoy added size check to bypass for a specified size of the message
  459.  
  460. Special thanks go out to the crew at my usual IRC hangout, notably Barry
  461. Hughes, Matti Koskimies, plus a number of others whom I may have not given
  462. appropriate credit, but you still deserve it.  You've been a big help.  :)
  463.  
  464. =head1 PREREQUISITES
  465.  
  466. C<Mail::SpamAssassin>
  467. C<Net::SMTP::Server>
  468.  
  469. =head1 EXAMPLES
  470.  
  471. here is how i use it (postfix) :
  472.  
  473. I added in :
  474.  
  475. postfix main.cf :
  476.  
  477. content_filter = smtp:localhost:10025
  478.  
  479. postfix master.cf :
  480.  
  481. localhost:10026     inet  n      -      n      -      10      smtpd
  482.       -o content_filter=
  483.       -o local_recipient_maps=
  484.       -o myhostname=localhost.hansonpublications.com
  485.  
  486. and i start spamproxyd via :
  487.  
  488. ./spamproxyd.pl --debug 127.0.0.1:10025 127.0.0.1:10026
  489.  
  490. =head1 TODO
  491.  
  492. Daemonize it
  493.  
  494. Add signal catchs (for termination)
  495.  
  496. Create a pid file
  497.  
  498. =cut

Raw Paste


Login or Register to edit or fork this paste. It's free.