Kill that Swen worm on your POP3 account!

[bart]

Category:

E-mail Programs

Description:

Currently my mailbox is just flooded with the newest e-mail worm, Swem. I receive about 50 of them an hour, at 150k each. So I wrote a script to check my POP3 account, for each mail fetch the headers and the first lines, and see if it's most likely a worm mail, by checking if it appears to contain an executable as an attachment. If so, it deletes it. There's no specific test for this particular worm.

You can run it both at home, where you save bandwidth, by avoiding to download the entire message, and your precious time, of course; or, as I do, put them on a server somewhere on internet, and run it from there. I put it in my crontab, and let it run ever 20 minutes, like this:

14,34,54 * * * *     $HOME/mailwormkiller.pl >>$HOME/mailwormkiller.lo
+g 2>&1

Note that this server is a different server than the one my mail arrives at.

The display in the log (via STDOUT) shows a table of all mails that arrived, with mail number, what type of executable it found (if any) and at what line number, sender, and subject. The line number is in order to tweak the initial number of lines fetched for the body. I found that the offending content-type line, for this worm, usually appears earlier than line 20, or around line 300.

Update (Sep 28, 2003 14:00 CEST — extra update at 15:37 CEST):
Edited the regexp to trap more other worms:

• Allow for wrapped Content* headers
• Match filenames both in Content-Type and in Content-Disposition headers

Update (Nov 30, 2004 16:10 CET):
Added the "cpl" extension (control panel)

#!/usr/local/bin/perl
# mailwormkiller.pl
# (c) Bart Lateur 20/21 sept 2003
# This is free software. Just don't pretend YOU wrote it!
# framework based on example 8.1 of Lincoln Stein's book,
# "Network Programming with Perl"
# Edit these to your personal settings:
my($host, $login, $passwd) = qw(mailhost.mydomain.com mylogin mypasswo
+rd);

use strict;
use Net::POP3;
use Mail::Header;

my $pop = Net::POP3->new($host, Timeout=>30) or die "Can't connect to 
+$host: $!\n";
my $messages = $pop->login($login => $passwd)  or die "Can't log in: "
+, $pop->message,"\n";

printf "Check at %s\n", scalar localtime;
my $delcount = 0;
if($messages += 0) {
    printf "Inbox holds %d message%s\n", $messages, $messages!=1 && 's
+';

    for my $msgnum (1 .. $messages) {
        my $header = $pop->top($msgnum, my $linecount = 40);
        my $parsedhead = Mail::Header->new($header);
        chomp(my $subject = $parsedhead->get('Subject'));
        chomp(my $from = $parsedhead->get('From'));

        my $deleted = 0;
        my $offset = '';
        if($parsedhead->get('Mime-Version')) {
            my $redone;
            {
                local $_ = join "", @$header;
                tr/\r//d;
                s/^(.+\n)+\n+//;
                (undef, $deleted) = m[^--.*\n
                  (?:(?:Content|[\t\ ]).+\n)*
                  Content-(?:Type:\s+\w*/[\w\-]+;\s+
                   |Disposition:\s+\w+;\s+file)
                  name=("?).*\.(exe|scr|pif|com|dll|bat|cpl)\1$]xmi
                  and $offset = substr($_, 0, $+[0]) =~ tr/\n//;
                # for earlier perls you can get along (with slightly d
+ifferent results) by using:
                # $offset = $` =~ tr/\n//;
                last if $deleted || $redone++ || tr/\n// < $linecount;
                $header = $pop->top($msgnum, $linecount = 700);
                redo;
            }
        }
        if($deleted) {
            $pop->delete($msgnum);
            $delcount++;
        }
        printf "%3d %-3s %3s %-25s  %s\n", $msgnum, $deleted || 'ok', 
+$offset, $from, $subject;
    }
    printf "%d message%s deleted.\n\n", $delcount, $delcount!=1 && 's'
+;
} else {
    printf "%s\n\n", "You don't have pending mail.";
}
$pop->quit;