#!perl # # del_pop3_scr.pl # # script to remove scr and pif attachements from a pop3 mailbox # see POD documentation below # # Copyright (c) 2003 Robert Eden, rmeden@cpan.org # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # If you find this useful, please drop an email and say thanks! # Feedback welcome of course. # # reden@cpan.org # use Strict; use Mail::POP3Client; use Getopt::Long; use Pod::Usage; my $head=200,$user,$pass,$host,$help,$man,$del=1; GetOptions('user=s' => \$user, 'pass=s' => \$pass, 'host=s' => \$host, 'head=i' => \$head, 'help' => \$help, 'delete!'=> \$del, # for debug purposes 'man' => \$man) or pod2usage(2); pod2usage(1) if $help; pod2usage(-exitstatus => 0, -verbose => 2) if $man; pod2usage(2) unless $user && $pass && host; my $pop = new Mail::POP3Client( USER => $user, PASSWORD => $pass, HOST => $host, AUTH_MODE => "PASS", ); die "$user\@$host: *LOGIN ERROR*\n" unless $pop->State eq "TRANSACTION"; my @size=$pop->ListArray; print "$user\@$host: $#size messages\n"; foreach $num (1..$#size) { next unless $size[$num]>10000; # don't bother with emails <10k. if ($head) { $_=$pop->Head($num,$head); } else { $_=$pop->Retrieve($num); } if (/^(Content.+\r\n.+\.(pif|scr))/im) { $_=$1; s/\r//; print "**VIRUS DETECTED** $_\n"; $pop->Delete($num) if $del; } } $pop->Close(); exit 0; __END__ =head1 NAME del_pop3_scr.pl delete msgs from a POP3 mbox with SCR & PIF attachements =head1 SYNOPSIS del_pop3_scr.pl --user=username -pass=password --host=hostname The following are optional --head=x check x lines/message. (200 default) If x=0, get all --help print this message --man print complete manpage =head1 README This script scans a POP3 mailbox and deletes messages with *.SCR or *.PIF attachements =head1 DESCRIPTION This script is a quick hack to look through the first records of messages in a POP3 mailbox and delete lines similar to the ones below. Content-Type: application/octet-stream; name="thank_you.pif" The initial version fetched the entire message and parsed the body looking for true attachments. That placed quite a load on the server and required lots of bandwith because users had large valid attachments. In addition, many hosts were bouncing messages back to the forged address and they were just as annoying as the virus itself. This version just fetches a few lines and looks for a string pattern of a MIME attachment we're interested in. This can cause a false alarm. For example, the file you are reading would be automatically deleted due to the example line above. I think it's best. If someone wants the old version let me know. =head1 PREREQUISITES This script requires C C C =head1 AUTHOR Robert Eden (F) All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =pod SCRIPT CATEGORIES Mail =cut