#!/usr/bin/perl

# Ken MacInnis <kmacinni>
# 5 Aug 2001
# Code Red (I/II) scanner
#
# $Id: crlog.pl,v 1.8 2001/08/06 04:25:54 kmacinni Exp $

use Fcntl;
use File::Basename;
use IO::Handle;
use HTTP::Daemon;
use HTTP::Status;

$LOGFILE = "/tmp/cr.log";
$TOUCH_CMD = "/usr/bin/touch";
$LISTEN_PORT = 80;

$SIG{'INT'} = "shutdown";
$SIG{'QUIT'} = "shutdown";
$SIG{'TERM'} = "shutdown";
$SIG{'CHLD'} = "IGNORE";

$foreground = $quiet = 0;
$prog = ( basename($0) );

while ( $_ = shift() ) {
	/^-h/ && ( &usage(), exit(0) );
	/^-k/ && ( &kill_old(), exit(0) );
	/^-d/ && ( $foreground = 1 );
	/^-q/ && ( $quiet = 1 );
	/^-p/ && ( $LISTEN_PORT = shift() );
}

my $daemon = ( HTTP::Daemon->new(LocalPort => $LISTEN_PORT) );

unless ( $daemon ) {
	die <<EOM;	

There appears to be a $prog running already on port $LISTEN_PORT already,
or you are attempting to bind to a port you are not allowed to.
'$prog -k' will try to remove all other background $prog processes
Unable to allocate daemon!

EOM
}

( $foreground ) || ( $pid = fork() );

if ( $pid != 0 ) {
	system($TOUCH_CMD . " /tmp/pid.cr." . $pid);
	print "PID is " . $pid . "\n";
}

if ( ($foreground) || ($pid == 0) ) {

open (OFH, ">>$LOGFILE") || die "Couldn't open logfile!  (Maybe it's owned by root?)\n";
print OFH "Started logging at " . localtime() . " on " . `hostname` . "\n";

OFH->autoflush(1);

print "Code Red logger v1e-3 listening at: ", $daemon->url(), "\n";

while (my $conn = $daemon->accept() ) {
	while ( my $req = $conn->get_request() ) {
			if ( $req->method() eq 'GET' and $req->url()->canonical() =~ m/.+XXXXX.*/ ) {
				&loghit( OFH, "CR2", $conn->peerhost(), $foreground );
				$conn->send_error(RC_FORBIDDEN);
			} elsif ( $req->method() eq 'GET' and $req->url()->canonical() =~ m/.+NNNNN.*/ ) {
				&loghit( OFH, "CR1", $conn->peerhost(), $foreground );
				$conn->send_error(RC_FORBIDDEN);
			} elsif ( $req->method() eq 'GET' and $req->url()->canonical() =~ m/xDIEMOFOx/ ) {
				$conn->send_error(RC_NOT_FOUND);
				&shutdown();
#			} elsif ( $req->method() eq 'GET' and $req->url()->canonical() =~ m/stats/ ) {
#				$conn->send_response( &send_status() );
			} else {
				( $quiet ) || ( &loghit( OFH, "NonCR", $conn->peerhost(), $foreground, $req->url()->canonical() ) );
				$conn->send_error(RC_NOT_FOUND);
			}
	} # while ( my $req ...
	$conn->close();
	undef($conn);
} # while (my $conn ...

} # if (pid == 0)

sub usage {

	die <<EOM;

Usage: $prog [-dkqh] [-p NN]

  -d		Do not fork into background
  -k		Attempt to reap background process(es)
  -q		Quiet (do not log non-"Code Red" HTTP requests)
  -p NN		Listen on port NN instead of 80
  -h		Show this message

EOM
	return;

} # &usage

sub loghit {

	($fh, $type, $host, $echo, $url) = @_;
	
	my @lt = (localtime())[0..5];
	# log uses grokable time/date for stats purposes
	print $fh $type . ": DATE:" . sprintf("%02d.%02d.%04d.%02d.%02d.%02d", ++$lt[4], $lt[3], $lt[5] + 1900, $lt[2], $lt[1], $lt[0]) . " HOST:" . $host . ( $url ? " INFO:" . $url : "" ) . "\n";
	# echo uses human-readable time/date
	($echo) && ( print STDOUT $type . "! -- " . localtime() . $host . "\n" );

	return;

} # &loghit

sub kill_old {

	my $numkilled = $idx = 0;

	my @pids = @pidfiles = < /tmp/pid.cr.* >;
	
	for (@pids) {
		s/\/tmp\/pid\.cr\.([0-9]+)/$1/;
		($numkilled++, unlink $pidfiles[$idx]) if (kill 15, $1); # eh..
		$idx++;
	}
	
	print $prog . ": attempted to kill " . $numkilled . " process" . ( (($numkilled > 1) || (!$numkilled)) ? "es" : "" ) . "\n";

	$numkilled;

	return;

}

sub shutdown {

	($foreground) && ( print STDERR "Caught signal, shutting down..\n" );
	( OFH ) && ( print OFH "\nStopped logging at " . localtime() . "\n");
	($conn) && ( $conn->close() ) && ( undef($conn) );
	exit(0);

} # &shutdown

exit(0);