OK, folks; I've added (thanks in part to Randal's private suggestion)
Cache::FileCache, which made it pretty trivial to ensure that we only
send a single message per 24-hour period.
I also added e-mail to administrator@ the infected host, since I've
been getting a fair number of bounces from webmaster@ and postmaster@.
And for those of you who were wondering whether multiple attacks will
come from the same IP address, I can assure you that I've received at
least 3-4 attempts from each of 2-3 addresses.
Sigh.
Reuven
# This Perl module should be invoked whenever the CodeRed or CodeRed2
# worm attacks. We don't have to worry about such attacks on Linux
# boxes, but we can be good Internet citizens, warning the webmasters
# on infected machines of the problem and how to solve it.
# On my system, I put CodeRed.pm in /usr/local/apache/lib/perl, which
# is in @ISA under mod_perl. I then added the following to my httpd.conf:
# PerlModuleCodeRed
# Location /default.ida
# SetHandler perl-script
# PerlHandler CodeRed
# /Location
# This module does require mod_perl (of course), Mail::Sendmail (which
# works fine with qmail, despite its name), and Net::DNS.
#
package CodeRed;
use vars qw($VERSION);
use Apache::Constants qw(OK DECLINED FORBIDDEN);
use Mail::Sendmail;
use Net::DNS;
use Cache::FileCache;
# What version of the module is this?
$VERSION = 1.02;
# Set this to your favorite URL describing how to fix this problem.
my $security_url =
'http://www.microsoft.com/technet/treeview/default.asp?url=/technet/itsolutions/security/topics/codealrt.asp';
# Do you want to know when one of these alerts has been sent? If so,
# put your address here.
my $cc_address = '[EMAIL PROTECTED]';
# Define whatever cache options you want to set. The
# most important for our purposes is default_expires_in.
my %cache_options = ('default_expires_in' = 86400 );
# Our handler subroutine, which deals with this.
sub handler
{
# Get Apache request/response object
my $r = shift;
# Create a DNS resolver, which we'll need no matter what.
my $res = new Net::DNS::Resolver;
my $remote_hostname;
#
# Open the cache of already-responded-to IP addresses,
# which we're going to keep in /tmp, just for simplicity.
my $file_cache = new Cache::FileCache(\%cache_options);
unless ($file_cache)
{
$r-log_error(CodeRed: Could not instantiate FileCache);
return DECLINED;
}
# Get some basic information about the request
my $remote_ip_address = $r-get_remote_host();
# If we don't have the remote IP address, then we cannot
# send mail to the remote server, can we?
return DECLINED unless (defined $remote_ip_address);
# If we have the remote IP address, then check to see if it's in
# our cache.
my $last_visited = $file_cache-get($remote_ip_address);
# If the address is in our cache, then we've already
# sent e-mail to that person, and we'll just return FORBIDDEN.
if ($last_visited)
{
$r-log_error(CodeRed: Found cached IP '$remote_ip_address');
return FORBIDDEN;
}
#
# If we only have the IP address (rather than the hostname),
# then get the hostname. (We can't look up the MX host
if ($remote_ip_address =~ /^[\d.]+$/)
{
$dns_query_response = $res-search($remote_ip_address);
if ($dns_query_response)
{
foreach $rr ($dns_query_response-answer)
{
next unless $rr-type eq A;
$remote_hostname = $rr-address;
}
}
else
{
$r-log_error(CodeRed: DNS query failed (',
$res-errorstring, '));
}
}
# If we had the hostname to begin with, then use it.
else
{
$remote_hostname = $remote_ip_address;
}
#
# Get the MX for this domain. This is trickier than you might
# think, since some DNS servers (like my ISP's) give accurate
# answers for domains, but not for hosts. So www.lerner.co.il
# doesn't have an MX, while lerner.co.il does. So we're going to
# do an MX lookup -- and if it doesn't work, we're going to break
# off everything up to and including the first . in the hostname,
# and try again. We shouldn't have to get to the top-level
# domain, but we'll try that anyway, just in case the others don't
# work.
my @mx = ();
my @hostname_components = split /\./, $remote_hostname;
my $starting_index = 0;
# Loop around until our starting index begins at the
# same location as it would end
while ($starting_index @hostname_components)
{
