All:

Attached is a script I wrote to sort spam into maildirs, using .qmail
files. Those of you with qmail will understand immediately, if you have 
users that are not bright enough to filter themselves.

This is the first time I have had something useful enough to give back 
to the community, so all you Perl demi-gods out there go easy on my 
code. I'm looking for feedback on the script. I am concerned only with 
clarity and robustness, not brevity.

If mailers munge the line wrapping, look at the script at:
http://bluefx.com/spamfork/

Please send your feedback to the list and [EMAIL PROTECTED] .

Thanks!
-Bryan
#!/usr/bin/perl -w
# 
#  | | |   spamfork.pl - sorts STDIN into Maildirs 
#  | | |                 based on X-Spam-Status headers
#  \-|-/ 
#    |                   Version 0.3
#    |
#    |                   Released under the GNU GPL.  A text version of the 
#    |                   GPL should have come with this program in the 
#    |                   file "COPYING".
#    |                  
#                        Copyleft 2002 Bryan T. Schmidt
#                        [EMAIL PROTECTED]
#
# SYNOPSIS:
# 
# spamfork.pl [ -m ./Maildir/ ] [ -s ./Maildir/.spam-maildir/ ]
#
#
# DESCRIPTION
#
# spamfork.pl is designed to work with 'spamc' and 'safecat' to help do
# server side sorting of spam into Maildirs based on the X-Spam-Status header
# added by SpamAssassin.  Normally, it would be called from inside a .qmail 
# file like this:
#
# |preline spamc | /usr/local/bin/spamfork.pl
#
# The above delivers to the default ./Maildir/ , and spam to ./Maildir/.spam/
# The -m and -s flags may be employed to change these locations to other 
# maildirs.
#
# Placement of mail into the Maildir is done by piping to 'safecat' , 
# which implements djb's Maildir algorithm, so that this script does 
# not worry about it.
#
# Additionally, $maxlines defines the number of lines to buffer before 
# we give up and assume that its not Spam.
#
#

use strict;
use Getopt::Std;

$| = 1;
my $key = "X-Spam-Status:";
my $maxlines = 200;   # how far can we go without $key?
my $count = 0;
my $scan = 1;
my $line = "";
my $pid;
my $buffer = "";
my $args = "";
my $program = "/usr/local/bin/safecat";
my $maildir = "./Maildir/";
my $spamdir = "./Maildir/.spam/";

my %option = ();
getopts("m:s:", \%option);

if ($option{m})
{
   $maildir = $option{m};
}

if ($option{s})
{
   $spamdir = $option{s};
}

$spamdir =~ s/\/$//;  # remove trailing slash
$maildir =~ s/\/$//;  # remove trailing slash

# print STDERR (" SPAM: $spamdir \n MAIL: $maildir");

### originally, we run mail through SpamAssassin.  basically do the same here
### except that we pipe to safecat, determining args 
### The old .qmail line was:
### |preline spamc | /usr/local/bin/safecat ./Maildir/tmp/ ./Maildir/new/


while (<STDIN>) {                   # reads from STDIN
    $line = $_;
    $count++;

    if ( $scan )
    {
      if ( $line =~ /^$key/ || ($count > $maxlines))
      {
        # print STDERR "found '$key' or stopped looking due to maxlines\n";
        # print STDERR "on line '$line'\n";
        $scan = 0;
        
        if ( $line =~ /$key yEs/i )
        {
          # its spam
          # print STDERR "SPAM FOUND\n";
          $args = "$spamdir/tmp/ $spamdir/new/";
          $pid = open(OUTPIPE, "| $program $args") or die "Couldn't fork: $!\n";
          print OUTPIPE $buffer;
          print OUTPIPE $line;

          } else {
            # we've found the key, but its not spam
            # print STDERR "this is not SPAM\n";
            $args = "$maildir/tmp/ $maildir/new/";
            $pid = open(OUTPIPE, "| $program $args") 
                        or die "Couldn't fork: $!\n";

            print OUTPIPE $buffer;
            print OUTPIPE $line;
        }

        
        } else {
          # still have not found key, so store what we have in the buffer
          $buffer .= $line;
      }

      } else {
      print OUTPIPE $line;

    }
}

if ($scan)
{
  # never found key
  $args = "$maildir/tmp/ $maildir/new/";
  # print STDERR "we never found the key '$key' \n";
  $pid = open(OUTPIPE, "| $program $args") or die "Couldn't fork: $!\n";

  print OUTPIPE $buffer;
}

close(OUTPIPE) or die "Couldn't close: $!\n";

exit;


Reply via email to