<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!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' =&gt; \$user,
           'pass=s' =&gt; \$pass,
           'host=s' =&gt; \$host,
           'head=i' =&gt; \$head,
           'help'   =&gt; \$help,
           'delete!'=&gt; \$del,  # for debug purposes
           'man'    =&gt; \$man) or pod2usage(2);

pod2usage(1) if $help;
pod2usage(-exitstatus =&gt; 0, -verbose =&gt; 2) if $man;
pod2usage(2) unless $user &amp;&amp; $pass &amp;&amp; host;

my $pop = new Mail::POP3Client( USER     =&gt; $user,
                                PASSWORD =&gt; $pass,
                                HOST     =&gt; $host,
                                AUTH_MODE =&gt; "PASS",
                              );

die "$user\@$host: *LOGIN ERROR*\n" unless $pop-&gt;State eq "TRANSACTION";

my @size=$pop-&gt;ListArray;

print "$user\@$host: $#size messages\n";

foreach $num  (1..$#size)
{
        next unless $size[$num]&gt;10000; # don't bother with emails &lt;10k.
        if ($head) { $_=$pop-&gt;Head($num,$head); }
        else       { $_=$pop-&gt;Retrieve($num);   }

        if (/^(Content.+\r\n.+\.(pif|scr))/im)
        {
          $_=$1;
          s/\r//;
          print "**VIRUS DETECTED** $_\n";
          $pop-&gt;Delete($num) if $del;
        }
}
$pop-&gt;Close();
exit 0;

__END__

=head1 NAME

del_pop3_scr.pl  delete msgs from a POP3 mbox with SCR &amp; 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 &lt;HEAD&gt; 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&lt;Mail::POP3Client&gt; C&lt;Getopt::Long&gt; C&lt;Pod::Usage&gt;

=head1 AUTHOR

Robert Eden (F&lt;reden@cpan.org&gt;)

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
</pre></body></html>