[Techtalk] Procmail spam recipes (was simple mail filtering via whitelist)

[John Clarke]

On Mon, Mar 08, 2004 at 04:31:22PM -0800, Akkana Peck wrote:

> As long as we're discussing procmail filtering and spam: I've been
> googling for procmail recipes to block messages with attachments of
> certain types, or attachments with filenames that include patterns like
> .exe and .pif.  I haven't had much luck.  Most of my existing procmail

As it happens, I've done this.  I wrote a simple and crude little perl
program to do the work (attached), and the procmail recipe is simply:

    # check for nasty attachments - .pif, .scr, .exe
    :0 W
    | $HOME/bin/viruscheck.pl

I wrote this a long time ago and can't remember why I've commented out
the alternative version using MIME::Parser.  I think it was because
MIME::Parser wasn't installed on the machine I wanted to run it on and
I couldn't install it at the time.  It might have been because it
didn't work though, so be careful :-)

Or you could install amavis and have it do it for you.


Cheers,

John
-- 
"Introducing Voodoo, for MS-Windows programmers. You are already familiar 
with the basic principles of placating unknown gods..."
                -- Roger Burton West
-------------- next part --------------
#!/usr/bin/perl -w
#
# Expects a multipart message on STDIN.  Checks for attachments named
# *.pif, *.scr, *.exe which are usually viruses.  Returns 1 if no attachments
# with such names are found, 0 if one or more is found.  This allows it to
# be run as a delivering recipe in .procmailrc - any virus will be discarded
# and legitimate mail will be delivered by rules which follow.
#
use strict;

my ($line, $nasty, $boundary);

sub parse_headers
{
    my $content_header;

    $content_header = "";
    while (1)
    {

        if ($line =~ /^Content-(?:Type|Disposition):/)
        {
            chomp($content_header = $line);
        }
        elsif ($content_header and $line =~ /^\s/)
        {
            chomp($content_header .= $line);
        }
        else
        {
            $content_header = "";
        }
        
        $nasty = 1
            if ($content_header =~ /(?:;|\s)(?:file)?name="[^"]+\.(?:pif|scr|exe)"/);
        
        $boundary = "\Q$1\E"
            if (!$boundary and $content_header =~ /(?:;|\s)boundary="([^"]+)"/);

        $line = <STDIN>;
        last if !defined($line);
        chomp $line;
        last if $line eq "";
    }
}

sub parse_body
{
    my $next_part;

    $next_part = 0;
    while (!$next_part)
    {
        $next_part = 1 if $line =~ /^--$boundary$/;

        $line = <STDIN>;
        last if !defined($line);
        chomp $line;
    }
}

$nasty = 0;
$boundary = "";

$line = <STDIN>;
chomp $line;

while ($line)
{
    parse_headers();
    
    last if $nasty;
    
    parse_body();

    last if $nasty;
}

# read the rest of the message and discard (stops 'broken pipe' errors)
while ($line = <STDIN>)
{
}

exit !$nasty;



#
# Alternate version using MIME::Parser.  I can't remember why it's commented
# out - possibly because MIME::Parser wasn't available on the machine I 
# wanted to run this on, but it could have been because it didn't work. 
#

#use MIME::Parser;
#
##
#my ($parser, $entity, $part, $filename, $nasty, $IO, $line, $content_header);
#
#$nasty = 0;
#
## create the parser
#$parser = new MIME::Parser;
#
## tell it not to store files on disc
#$parser->output_to_core(1);
#
## and parse the input stream
#$entity = $parser->parse(\*STDIN) or die "parse failed\n";
#
## if not multipart then no attachment, so OK
#exit 0 if !$entity->is_multipart();
#
## now deal with each part
#foreach $part ($entity->parts)
#{
#    # get the name of the attached file
#    
#    $filename = $part->head()->get('Content-Type');
#
#    if (defined($filename) and $filename =~ /name=".*\.(?:pif|scr|exe)"/)
#    {
#        # is a nasty attachment
#        $nasty = 1;
#        last;
#    }
#    
#    $filename = $part->head()->get('Content-Disposition');
#
#    if (defined($filename) and $filename =~ /name=".*\.(?:pif|scr|exe)"/)
#    {
#        # is a nasty attachment
#        $nasty = 1;
#        last;
#    }
#}
#
#exit $nasty;