Listing 1 wormhost
#!/usr/bin/perl
# wormhost
#
# Identifies a host infected with an email worm
# when fed a virus alert message on STDIN
#
# Copyright 2004 Philip B Chase
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
# USA
use strict;
my $install_root = "/usr/local/worm-defense-tools/";
my ($ip, $rev_ip, $worm_name, $worm_desc);
my $opt;
my $bl_addr = "127.0.0.2";
my $ttl = "7200";
my $reason_prefix = "Host blocked because it is a know source of ";
use vars qw($self %worms $debug $worm_patterns_file);
$worm_patterns_file = "$install_root/etc/worm-patterns.cfg";
# setup and filter the message
init();
($opt) = parse_args();
($ip, $worm_name, $worm_desc) = find_worm_host();
# format the output
if (!($ip =~ /^$/)) {
$rev_ip = join('.', reverse (split(/\./, $ip)));
if ($opt->{t}) {
debug("$self: formatting for tinydns");
print "+$rev_ip.$opt->{z}:$bl_addr:$ttl\n";
print "'$rev_ip.$opt->{z}:$reason_prefix$worm_desc:$ttl\n";
} elsif ($opt->{r}) {
debug("$self: formatting for rbldns");
print "$ip.$opt->{z}:$bl_addr:$reason_prefix$worm_desc\n";
} elsif ($opt->{b}) {
debug("$self: formatting for bind");
print "$rev_ip.$opt->{z}\tIN\tA\t$bl_addr\n";
print "$rev_ip.$opt->{z}\tIN\tTXT\t\"$reason_prefix$worm_desc\"\n";
} elsif ($opt->{d}) {
debug("$self: formatting as tab delimited");
print join("\t", $ip, $worm_name, $worm_desc), "\n";
} elsif ($opt->{a}) {
debug("$self: formatting as a bare IP address");
print "$ip\n";
}
}
sub init {
my ($name, $pattern, $description);
($self = $0) =~ s!.*/!!; # get program name
# load worm patterns into a hash
open (WORMS, $worm_patterns_file) or die "$self: Can't open worm \
pattern file\n";
while (<WORMS>) {
chop;
if (($name, $pattern, $description) = (split(/\t/))) {
eval { 'junk' =~ /$pattern/, 1 } or die "$self: $.: bad pattern: $@";
$worms{$name}{'pattern'} = $pattern;
$worms{$name}{'desc'} = $description;
} else {
die "$self: bad pattern line: $_";
}
}
close WORMS;
}
sub usage {
die <<EOF
usage: $self [flags] [files]
options:
-t output tinydns records
-r output rbldns records
-b output BIND records
-z zone name for RBL queries
-d output a tab delimited record
-a output address only
-h print this usage info
-v verbose output
EOF
}
sub parse_args {
use Getopt::Std;
my ($optstring, %opt);
$optstring = "trbz:dahv";
getopts($optstring, \%opt) or usage();
if ($opt{v}) {
$debug = 1;
} else {
$debug = 0;
}
if ($opt{h}) {
usage();
}
if (($opt{t} || $opt{b} || $opt{r}) && ! $opt{z}) {
die "use of -t, -r, or -b requires a zone name specified with -z\n";
}
# Set a default output format if none specified
$opt{a} = 1 unless ($opt{t} || $opt{r} || $opt{b} || $opt{d});
return (\%opt);
}
sub debug {
print STDERR @_, "\n" if ($debug);
}
sub my_exit {
debug(@_);
exit;
}
sub find_worm_host {
my $received_headers;
my $normal_received_headers = 3;
my $received_ip;
my $worm = 0;
my $temp;
my $i;
my $name;
my $line;
my ($worm_name, $worm_desc);
my ($from_host, $mailfrom_host, $received_host, $message_id_host);
while ($line = <>) {
++$i;
# negative tests
if (($line =~ /^Received/i)) {
++$received_headers;
if ($received_headers > $normal_received_headers) {
my_exit("$self: Possible relayed message. Too many \
received headers: $received_headers");
}
}
if (($line =~ /From: postmaster/i)) {
my_exit("$self: Possible automated message: $line");
}
if (($line =~ /Returned mail: see transcript for details/i)) {
my_exit("$self: Probable bounce: $line");
}
if (($line =~ /Message status - undeliverable/i)) {
my_exit("$self: Probable bounce: $line");
}
if (($line =~ /MAIL FROM: $/i)) {
my_exit("$self: Odd message: $line");
}
# get data to watch for list servers bouncing worms
if ($line =~ /^MAILFROM: .*@([^@]+)$/) {
$mailfrom_host = $1;
chop $mailfrom_host;
debug("$self: mailfrom_host: $mailfrom_host");
}
if ($line =~ /^Received:\s+from\s+(\S+)\s/) {
$received_host = $1;
debug("$self: received_host: $received_host");
}
if ($line =~ /^Message-Id: .*@([^@]+)>$/) {
$message_id_host = $1;
debug("$self: message_id_host: $message_id_host");
}
if ($line =~ /From: .*@([^@]+)>$/) {
$from_host = $1;
debug("$self: from_host: $from_host");
}
if (!($from_host =~ /^$/) &&
$from_host eq $mailfrom_host &&
$from_host eq $received_host &&
$from_host eq $message_id_host ) {
my_exit("$self: probably list server bounce from: $from_host");
}
# Positive tests
if ($line =~ /^Received: from\s.*\s\((\d+\.\d+\.\d+\.\d+)\)$/i) {
# this is the host we will block if all other tests pass.
$received_ip = $1;
}
if (!$worm) { # one positive hit is enough
foreach $name (keys %worms) {
if (eval { $line =~ /$worms{$name}{pattern}/ } ) {
# found a worm pattern
debug("$self: last line: $line");
debug("$self: line number: $i");
debug("$self: name: $name");
debug("$self: pattern: $worms{$name}{pattern}");
$worm = 1;
$worm_desc = $worms{$name}{desc};
$worm_name = $name;
debug("$self: Worm Description: $worm_desc");
}
}
}
}
# negative tests
if ($received_headers < $normal_received_headers) {
my_exit("$self: Possible local message. Too few received \
headers: $received_headers");
}
# final positive test
if ($worm) {
debug("$self: worm originator found: $received_ip");
return ($received_ip, $worm_name, $worm_desc);
} else {
my_exit("$self: worm originator not found");
}
} |