package Apache::Earlybird;
use strict;

# © 2001 Ronald Florence <ron@18james.com>
# last modified, 3 Mar 2002

use vars qw($VERSION);
use Apache::Constants qw(OK DECLINED FORBIDDEN);
use Mail::Sendmail;
use Net::DNS;
use Cache::FileCache;
use Time::Zone;
use IO::Socket;

# ------------------------------------------------------------
$VERSION = 1.09;

# URLs to recommend in notifications.
my %security_url = (
   Nimda => 'http://www.microsoft.com/technet/security/topics/Nimda.asp',
   CodeRed => 'http://www.microsoft.com/technet/security/topics/codealrt.asp'
		   );
# address for email to SecurityFocus.com
my $security_focus_address = 'aris-report@securityfocus.com';

# for arin whois queries
my $arin_whois = 'whois.arin.net:43';

# optional BCC
my $bcc_address = '';

# default notification interval (24 hours)
my %cache_options = ('default_expires_in' => 86400 );

# $debug = 0 for errors only, 1 for logging email, 2 for max debugging.
my $debug = 0;

# end of configuration
# ------------------------------------------------------------

sub handler
  {
    my $worm;
    my $r = shift;
    my $remote_ip = $r->connection->remote_ip;
    my $uri = $r->uri;
    if ($uri =~ /default\.ida/)	{ $worm = "CodeRed"; }
    elsif ($uri =~ /\.exe/)	{ $worm = "Nimda"; }
    else 
      {
	$r->warn("Earlybird: unrecognized attack from [$remote_ip].");
	return DECLINED;
      }
    $cache_options{'namespace'} = $worm;
    my $file_cache = new Cache::FileCache(\%cache_options);
    unless ($file_cache)
      {
	$r->log_error("$worm: Could not instantiate FileCache.");
	return DECLINED;
      }

    my $last_visited = $file_cache->get($remote_ip);
    if ($last_visited)
      {
	$r->warn("$worm: Found cached IP [$remote_ip].") if ($debug > 1);
	return FORBIDDEN;
      }
    $file_cache->purge;

    # Send e-mail to SecurityFocus.com
    my $server_name = $r->server->server_hostname;
    my $from_address = $r->server->server_admin;
    my $now = scalar localtime;
    my $time_zone_name = uc tz_name;
    my $sf_message = "$remote_ip\t$now $time_zone_name

-- 
   Apache::Earlybird-$VERSION (mod_perl) on $server_name";

    my %sf_mail = ( 
      To      => $security_focus_address,
      BCC     => $bcc_address,
      From    => $from_address,
      Subject => "$worm infection on '$remote_ip': Automatic report",
      Message => $sf_message
		   );
    if (sendmail %sf_mail)
      {
	$file_cache->set($remote_ip, 1);
	$r->warn("$worm: sent e-mail to SecurityFocus about '$remote_ip'") 
	  if ($debug);
      }
    else
      {
	$file_cache->set($remote_ip, 0);
	$r->warn("$worm: sendmail returned: $Mail::Sendmail::error");
	return DECLINED;
      }

    my $admin_addr;
    my $remote_hostname;

    # Get a hostname and an email address from the SOA of the domain.
    my $res = new Net::DNS::Resolver;
    my $query = $res->search($remote_ip);
    if ($query) 
      {
	foreach my $rr ($query->answer)
	  {
	    next unless $rr->type eq "PTR";
	    $remote_hostname = $rr->rdatastr;
	  }
	chop $remote_hostname;
      }
    else
      {
	my $dns_error = $res->errorstring;
	$r->warn("$worm: PTR lookup on [$remote_ip] failed: $dns_error") 
	  if ($debug > 1);
      }
    # watch out for bogus A records
    if ($remote_hostname && $remote_hostname ne $remote_ip) 
      {
	my @zone = split /\./, $remote_hostname;
	my $SOA_query = 0;
	while (!$SOA_query)
	  {
	    $SOA_query = $res->query(join('.', @zone), "SOA");
	    last if !shift @zone;
	  }
	if ($SOA_query)
	  {
	    my $addr = ($SOA_query->answer)[0]->rname;
	    $addr =~ s/\./@/;
	    $admin_addr = $addr . ', ' . do { $addr =~ s/^[^@]+/abuse/; $addr };
	  }
      }

    # If we cannot resolve the $remote_ip or the SOA address.
    if (!$admin_addr)
      {
        $remote_hostname = $remote_ip;
	my @addr = get_arin($remote_ip);
        if (!@addr) 
          {
            $r->warn("$worm: arin whois lookup failed for $remote_ip")
	       if ($debug > 1);
     	    return FORBIDDEN;
          }
        $admin_addr = join ', ', @addr;
        $admin_addr .= ', ' . join  ', ',  map { s/^[^@]+/abuse/; $_ } @addr;
      }

    my $request = $r->the_request;  
    my $port = $r->get_server_port;
    my $outgoing_message = <<END;
A server in your ip-address space has attempted a $worm worm attack.

  Attacking server:  $remote_hostname  [$remote_ip]
    Date of attack:  $now $time_zone_name 
     Attacked port:  $port
       Initial URI:  $request

Our Apache server at $server_name was immune to the attack, but the
dissemination of infectious worms and viruses is a violation of the
terms of use of all responsible ISPs, and requires prompt attention
from the administrator/owner of the ip-address space.  Notice of this
attack has been sent to Internet security tracking groups.

Please investigate and recommend the appropriate patch at:
$security_url{$worm}

-- 
   Apache::Earlybird-$VERSION (mod_perl) on $server_name
END

    my %mail = ( 
      To      => $admin_addr,
      BCC     => $bcc_address,
      From    => $from_address,
      Subject => "Attempted $worm attack by $remote_hostname",
      Message => $outgoing_message
		);
    if (sendmail %mail)
      {
	$r->warn("$worm: sent email to '$admin_addr'") if ($debug);
	return FORBIDDEN;
      }
    else
      {
	$r->warn("$worm: sendmail returned: $Mail::Sendmail::error");
	return DECLINED;
      }


    sub get_arin
      {
	my $target = shift;
	my $sock = new IO::Socket::INET($arin_whois) || return [];
	my @nets;
	my @abuse;
	print $sock "$target\r\n";
	while (<$sock>)
	  {
	    push @nets, /\(([\w.-]+)\)/;
	    push @abuse, /\s+([\w.-]+@[\w.-]+)/; 			
	  }
	close $sock;
	if (!@abuse)
	  {
	    for (@nets) { push @abuse, get_arin("!$_"); }
	  }
	return @abuse;
      }

  }
# All modules must return a true value
1;


__END__
# Below is stub documentation for your module. 

=head1 NAME

    Apache::Earlybird - Responds to worm attacks with e-mail warnings

=head1 SYNOPSIS

    Make sure your Apache is compiled with mod_perl and put the
    following in your httpd.conf:

	PerlModule	Apache::Earlybird

	<LocationMatch "/(root|cmd)\.exe">
	    SetHandler perl-script
	    PerlHandler Apache::Earlybird
	</LocationMatch>

        <Location  /default.ida>
	    SetHandler perl-script
	    PerlHandler Apache::Earlybird
	</Location>

=head1 DESCRIPTION

    The Earlybird gets the worm.  This Perl module should be invoked
    whenever IIS worms attack.  We don't have to worry about such
    attacks on Apache servers on Unix or Linux, but we can be good
    Internet citizens and spare ourselves and others the log clutter
    and lost bandwidth by notifying webmasters or ISPs of infected
    machines.

=head1 LICENSE

    You may distribute this module under the same license as Perl itself.

=head1 AUTHOR

    Ronald Florence <ron@18james.com> 

    Portions of the code are adapted from Apache::CodeRed by Reuven
    M. Lerner <reuven@lerner.co.il> and Apache::MSIISprobe by Nick
    Tonkin <nick@tonkinresolutions.com>.

=head1 SEE ALSO

L<mod_perl>.

=cut