[Techtalk] Procmail filter
John Clarke
johnc+linuxchix at kirriwa.net
Fri Mar 26 15:08:15 EST 2004
On Wed, Mar 24, 2004 at 07:52:42AM -0800, Poppy Casper wrote:
> I'm getting so many of these viruses that I'd like to set up a
> procmail filter to throw everything with a .pif attachment into my junk
> folder.
I posted a solution to this a couple of weeks ago. This is the procmail
recipe:
# check for nasty attachments - .pif, .scr, .exe
:0 W
| $HOME/bin/viruscheck.pl
and viruscheck.pl is attached.
Cheers,
John
--
If you want to watch [a hard drive] die a slow agonizing death, whilst
incoveniencing the maximum number of your lusers, install it in the
part of your news spool that handles alt.sex.*
- Brian Kantor
-------------- 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;
More information about the Techtalk
mailing list