#!/usr/bin/perl -w

# Nimda Notifyer 1.3
# Copyright (C) 2001 Trevor Peirce

# Reporting tool for Code Red-like worm that's taking down networks.
# This tool will look up IP addresses and send an email to the administrator
# of a machine "gone bad" scanning everybody.

# The idea came from an anti-Code Red script I saw once, though I don't know
# where and didn't feel like digging.

# Any improvements are welcome - trev@digitalcon.ca

# Enjoy!

#######################################################################
# CHANGES
######################################################################
# Release 1.0 - Wednesday, September 19, 2001
#	- Initial Release
#
# Release 1.1 - Friday, September 21, 2001
# 	- added a debug mode
#	- fixed major problem with ARIN sub delegations (they were being
#	ignored)
#	- added ability to submit IPs to a Nimda-Registry of infected
#	hosts, see http://worm.jungnickel.com/ for details
#	- added timestamp to email letter
#	- improved documentation in configuration section.
# 
# Release 1.2 - Friday, October 5, 2001
#	- corrected syntax for gmtime() to eliminate warnings in error log
#	- added support for APNIC delegations <franck@sopac.org>
#	- added X-Mailer: Nimda Notifyer to email headers
#	- fixed omission of netblk owner's name when there was no comma
#
# Release 1.3 - Saturday, October 6, 2001
#	- added option to summerize action taken in server's error log
#
######################################################################

use strict;
use CGI::Carp qw(fatalsToBrowser);
use Net::Whois::Raw;
use File::Cache;
use LWP::UserAgent;

$|++;

use vars qw($version $fromaddr $subject $sendmail $bcc $submitip $debug $verbose);

######################################################################
#### Configuration 

# This is who the email appears to be from.  Remember to escape @'s
# if you change this address, or to use single quotes.
# Default: SERVER_ADMIN from Apache's configuration

$fromaddr = "$ENV{SERVER_ADMIN}";

# This is the subject of the email being sent.  REMOTE_ADDR = remote ip
# Default: Nimda Detected - $ENV{REMOTE_ADDR}

$subject = "Nimda Detected - $ENV{REMOTE_ADDR}";

# The path to sendmail.  This should work fine for most.
# Default: /usr/bin/sendmail -t

$sendmail = "/usr/bin/sendmail -t";

# Send a BCC of every email to the From address.  1=on, 0=off
# Default: 1

$bcc = 1;

# Automatically submit IPs to Nimda-Registry.  See
# http://worm.jungnickel.com/ for more information about their site.
# 1=on, 0=off
# Default: 1

$submitip = 1;

# Verbose mode.  When enabled, a message will be left in your error log
# indicating the detected IP, and the results of the lookup. 1=on, 0=off
# Default: 1

$verbose = 1;

# Debug mode.  If debug is on, no emails are actually sent.  Instead
# the email that would be sent is displayed at the bottom, after
# the results.  1=on, 0=off
# Default: 0

$debug = 0;

#### End Configuration
######################################################################

$version = "Nimda Notifyer 1.3";
my $header = "";
if ($debug) {
	$header = "<h1>Debug Mode</h1>\n";
	$fromaddr =~ s/</&lt;/g;
}
elsif (($ENV{HTTP_USER_AGENT} ne "") or ($ENV{QUERY_STRING} eq "")) {
	$header = "<h1>Debug Mode automatically enabled -- you are not Nimda ;)</h1>\n";
	$debug++;
	$fromaddr =~ s/</&lt;/g;
}

# Print the HTTP headers, and debug header if needed.
print "Content-Type: text/html\n";
if ($debug) { print "Status: 200 OK\n\n" }
else { print "Status: 404 Not Found\n\n" }
print $header;

my $ip = $ENV{REMOTE_ADDR};

if (checkcache($ip) and !$debug) {
	print "Already sent a letter to the administrator of $ip\n";
	warn "Already sent a letter to the administrator of $ip\n";
	exit;
}

my ($server, $wr);
print "<pre><code>whois $ip@" if $debug;

if ($ip =~ /^(61|202|203|210|211|218)\./) {
        print "whois.apnic.net\n\n" if $debug;
        $server="APNIC";
        $wr = Net::Whois::Raw::_whois($ip,"whois.apnic.net",0,[]);
}
else {
        print "whois.arin.net\n\n" if $debug;
        $server="ARIN";
        $wr = Net::Whois::Raw::_whois($ip,"whois.arin.net",0,[]);
}

print "$wr</code></pre>" if $debug;

my @email;

if ($server eq "ARIN") {
	unless ((@email = coordlisted($wr)) > 1) {  # Perhaps it's further delegated
	
		my ($company, $block) = findhandle($wr);

			print "<hr>No coordinator found.  Looking up info for <b>$company</b>" .
				"($block)</hr>\n" if $debug;
	
		print "<pre><code>whois !$block\n\n" if $debug;
		my $contact = Net::Whois::Raw::_whois("!" . $block, "whois.arin.net",0,[]);

		print "$contact</code></pre>" if $debug;
	
		unless ((@email = coordlisted($contact)) > 1) { # Give up
		
			print "Couldn't find coordinator in sub delegation either.  Giving up.\n";
			warn "Unable to find email address for administrator of $ip using ARIN. Giving up.\n";
			exit;
		}
	}
}
elsif ($server eq "APNIC") {
	
	# Pick out the contact name from the results
	if ($wr =~ /person: +(.+)/) {
		$email[0] = $1;
	}
	else {
		$email[0] = "Whom It May Concern";
	}
	
	# Pick out the email address from the results
	if ($wr =~ /e\-mail: +(.+)/) {
		$email[1] = $1;
	}
	else {
		print "Unable to find email address.  Giving up.\n";
		warn "Unable to find email address for administrator of $ip using APNIC.  Giving up.\n";
		exit;
	}
}

print "<hr>";

print "Sending report to <b>$email[0]</b> ($email[1])...<hr>\n";
sendletter(@email, $ip);
submitnr($ip) if $submitip and not $debug;

exit;

#### Subs below ####

sub checkcache {
	my $ip = shift;
	
	my $cache = new File::Cache( { namespace  => 'NimdaWorm',
								expires_in => 86400,
								filemode => 0600 } );
	
	my $cr = $cache->get($ip);
	
	if ($cr) {
		return 1;
	} 
	else {
		$cache->set($ip, 1);
		return;
	}
}
	

sub coordlisted {
	my $wr = shift;  # whois results
	
	if ($wr =~ /Coordinator:/) {
		if ($wr =~ /^(.+)  \(.+?\)  (.+?\@.+)$/m) {
			return $1, $2;
		}
	}
	
	return undef;
}

sub findhandle {
	my $wr = shift;  # whois results
	my @res;
	
	while ($wr =~ /^(.*?) \((.+?)\)/mg) {
		unshift(@res, $1,$2);
		#print "<pre><code><hr>Delegated to: \"$1\" ($2)</code></pre>";
	}
	
	print "<pre><code><hr>Delegated to: $res[0] ($res[1])</code></pre>";
	
	return $res[0], $res[1];
}

sub submitnr {
	my $ip = shift;
	
	my $ua = LWP::UserAgent->new;
	my $req = HTTP::Request->new(HEAD => 'http://worm.jungnickel.com/?action=submit&type=nimda&ip=' . $ip);
	my $res = $ua->request($req);
	if ($res->is_success) {
		print "Successfully submitted $ip to the Nimda Registry at http://worm.jungnickel.com<br>\n";
	}
	else {
		print "There was a problem submitting $ip to the Nimda Registry:  " . $res->status_line . "<br>\n";
	}
}

sub sendletter {
	my $name = shift;
	my $addr = shift;
	my $ip = shift;
	
	# Change the name from "Last, First" to "First Last" + kill leading whitespace
	if ($name =~ /^ *(.+?), *(.+)$/) {
		$name = "$2 $1";
	}
	
	# If the email address belongs to RIPE, do not send!! (patches, anyone?)
	if ($addr eq 'nicdb@RIPE.NET') {
		print "Nope, looks like you're a lucky one.  RIPE support will come soon however.\n";
		return;
	}
	
	if ($debug) {
		*MAIL = *STDOUT;
		print "<code><pre>\n";
	}
	else {
		open(MAIL, "|$sendmail") || die "can't open pipe to $sendmail: $!";
	}
	print MAIL "To: $addr\n";
	print MAIL "BCC: $fromaddr\n" if ($bcc);
	print MAIL "From: $fromaddr\n";
	print MAIL "Subject: $subject\n";
	print MAIL "X-Mailer: $version\n\n";
	print MAIL "$name,\n\n";
	print MAIL "    This is an automated email from $ENV{SERVER_NAME}.  It appears\n";
	print MAIL "as though you are listed as the coordinator for the netblock from\n";
	print MAIL "which a Windows NT machine appears to have been infected with the\n";
	print MAIL "Nimda worm.\n\n";
	
	print MAIL "    The IP address of the infected machine is $ip.  This\n";
	print MAIL "was detected on " . gmtime() . " GMT.  Please either remove\n";
	print MAIL "the worm or disconnect the machine from the Internet until you have\n";
	print MAIL "the chance to do so.  It is using up not only your bandwidth but\n";
	print MAIL "everybody else's too.\n\n";
	
	print MAIL "    Here are a few links with information about this worm:\n\n";
	print MAIL 'http://www.sarc.com/avcenter/venc/data/w32.nimda.a@mm.html' . "\n";
	print MAIL "http://www.newsbytes.com/news/01/170225.html\n\n";
	
	print MAIL "Thank you for your attention,\n";
	print MAIL "Administrator of $ENV{SERVER_NAME}";
	close MAIL unless $debug;
	print "</pre></code><hr>\n" if $debug;
	
	warn "Sent report to $name <$addr> regarding $ip.\n";
}