sa-wrapper.pl

#!/usr/bin/perl -w
# Time-stamp: <05 April 2004, 13:37 home>
#
# sa-wrapper.pl
#
# SpamAssassin sa-learn wrapper
# (c) Alexandre Jousset, 2004
# This script is GPL'd
#
# Thanks to: Chung-Kie Tung for the removal of the dir
#            Adam Gent for bug report
#
# v1.2
 
use strict;
use MIME::Tools;
use MIME::Parser;
 
my $DEBUG = 0;
my $UNPACK_DIR = '/var/spool/amavis/mime';
my $SA_LEARN = '/usr/bin/sa-learn';
my @DOMAINS = qw/example.com example.org/;
 
my ($spamham, $sender) = @ARGV;
 
sub recurs
{
    my $ent = shift;
 
    if ($ent->head->mime_type eq 'message/rfc822') {
        if ($DEBUG) {
            unlink "/tmp/spam.log.$$" if -e "/tmp/spam.log.$$";
            open(OUT, "|$SA_LEARN -D --$spamham --single >>/tmp/spam.log.$$ 2>&1") or die "Cannot pipe $SA_LEARN: $!";
        } else {
            open(OUT, "|$SA_LEARN --$spamham --single") or die "Cannot pipe $SA_LEARN: $!";
        }
 
        $ent->bodyhandle->print(\*OUT);
 
        close(OUT);
        return;
    }
 
    my @parts = $ent->parts;
 
    if (@parts) {
        map { recurs($_) } @parts;
    }
}
 
my ($domain) = $sender =~ /\@(.*)$/;
unless (grep { $_ eq $domain } @DOMAINS) {
    die "I don't recognize your domain !";
}
 
if ($DEBUG) {
    MIME::Tools->debugging(1);
    open(STDERR, ">/tmp/spam_err.log");
}
my $parser = new MIME::Parser;
$parser->extract_nested_messages(0);
$parser->output_under($UNPACK_DIR);
 
my $entity;
eval {
    $entity = $parser->parse(\*STDIN);
};
 
if ($@) {
    die $@;
} else {
    recurs($entity);
}
 
$parser->filer->purge;
rmdir $parser->output_dir;