#!/local/bin/perl
#
# catchscan : Simple program to catch active port scans
#
# WARNING: In all likelihood, this will require a newer version of the
# IO module than comes with perl (I use the blocking() method at some point)
# This has been tested with IO 1.20 . 
#
# Usage: catchscan [ -[t|u] port1,port2,...,portN ] [ -c File_Containing_Port_List ]
#	 [ -o outfile ] [ -l facility:level ] [ -e ] [-i]
#
#		-c config file
#		-f 			 : stay in the foreground, no fork
#		-e 			 : exit if any of the ports are already bound
#		-i 			 : do an ident lookup on the remote machine for tcp scans
#		-l fac:level 		 : change syslog options using Sys::Syslog notation
#		-o outfile 		 : "-" for stdout
#		-t port1,port2,...,portN : tcp port list
#		-u port1,port2,...,portN : udp port list
#	
#
#	 If the -o option specifies "-" as the outfile, output goes to STDOUT
#	 If there's no -o option, output goes to syslog
#
# The format of the port config file is something like this
#	#
# 	# This is a comment
# 	# These are ports:
# 	25/tcp  only the first whitespace separated field in a line is significant
#	53/udp  so I can put useful info out to the side
# 	143/tcp imap like the service in question
#	515/tcp printer
#	750/tcp kerberos etc
#
#	


require 5.005;
use strict;
use Getopt::Std;
use IO::File;
use IO::Socket;
use IO::Select;
use Thread;
use Sys::Syslog;
use Errno qw(EADDRINUSE );
use vars qw($CONFIG_FILE $OUTFILE $OUTFILE_FH $IOBUFLEN $LOGLEVEL $FACILITY
	    $opt_l $opt_c $opt_o $opt_t $opt_u $opt_e $opt_f $opt_i $EXIT_ON_PORT_USED
	    $LOG_OPTIONS $HOSTNAME $RESPONSE $FOREGROUND $DO_IDENT );

$LOGLEVEL = 'crit';
$FACILITY = 'auth';
$IOBUFLEN = 1024;

$ENV{PATH} = "/local/bin/:/bin/";
$ENV{IFS} = "";

$RESPONSE = "You have reached %s:%s from %s:%s. The admins have been notified\n";

Main();
sub Main
{
	my (@ports, @tcp, @udp, $TCP_PORT_LIST, $UDP_PORT_LIST, @tcpsockets, @udpsockets);
	my ($logline, @bound, @unbound);
	STDOUT->autoflush(1);
	my $PROGNAME = $0;
	$PROGNAME = $1 if ($0 =~ m,/(\w+)$,);	
	
	#
	# Get the hostname. Alas, if a udp socket is bound to INADDR_ANY, it 
	# cannot tell to which interface a udp packet was sent (like tcp can),
	# instead returning INADDR_ANY. Bummer.
	#

	chomp($HOSTNAME = `/bin/hostname`);
	# get fqdn
	($HOSTNAME) = gethostbyname("$HOSTNAME");

	getopts("c:feil:o:t:u:");

	($opt_c) && ($CONFIG_FILE = $opt_c);
	($opt_f) && ($FOREGROUND = 1);
	($opt_e) && ($EXIT_ON_PORT_USED = 1);
	($opt_i) && ($DO_IDENT = 1);
	($opt_l) && ($LOG_OPTIONS = $opt_l);
	($opt_o) && ($OUTFILE = $opt_o);
	($opt_t) && ($TCP_PORT_LIST = $opt_t);
	($opt_u) && ($UDP_PORT_LIST = $opt_u);

	#
	# Fork unless -f supplied
	#

	unless ($FOREGROUND)
	  {
		my $pid = fork;
		die "Fork error: $!" if ($pid eq undef);
		exit if $pid;
	  }

	#
	# Change syslog options if desired
	#

	($FACILITY, $LOGLEVEL) = split(/:/, $LOG_OPTIONS) if ($LOG_OPTIONS);

	#
	# Set logging according to command line options
	#

	if ($OUTFILE)
	  {
		if ($OUTFILE eq "-") 
		  {
			($OUTFILE_FH = \*STDOUT);
		  }
		else
		  {
			$OUTFILE_FH = new IO::File("> $OUTFILE") or die "file '$OUTFILE' : $!";
			$OUTFILE_FH->autoflush(1);
	  	  }
	  }
	else
	  {
		openlog("$PROGNAME", "pid,ndelay", $FACILITY);
	  }

	#
	# Get a list of ports from the config file or the command line
	#

	die "-t or -u and -c are mutually exclusive" if ( ($opt_t  || $opt_u ) and $opt_c);

	if ( $TCP_PORT_LIST || $UDP_PORT_LIST )
	  {
		@tcp = split(/\,/, $TCP_PORT_LIST); for (@tcp) { $_ .= "/tcp"; };
		@udp = split(/\,/, $UDP_PORT_LIST); for (@udp) { $_ .= "/udp"; };
		push(@ports, @tcp, @udp);
	  }
	else
	  {
		@ports = first_field($CONFIG_FILE) if ($CONFIG_FILE);
	  }

	die "No ports specified" unless ( @ports );

	#
	# Bind to each port specified, and save in the @sockets array
	#

	foreach my $port ( @ports )
	  {
		my ($type, $portnum, $proto, $s);

		($portnum, $proto) = split(/\//, $port); 
		($proto eq "tcp") ? $type = SOCK_STREAM 
				  : $type = SOCK_DGRAM ; 

		if ($proto eq "tcp")
		  {
			$s = new IO::Socket::INET
			      (Listen 		=> 5,
			       Type   		=> SOCK_STREAM,
			       LocalAddr 	=> INADDR_ANY,
			       LocalPort 	=> $portnum,
			       Reuse		=> 1,
		   	       Proto 		=> $proto);
		  }
		else
		  {
                        $s = new IO::Socket::INET
                              (Type             => SOCK_DGRAM,
                               LocalAddr        => INADDR_ANY,
                               LocalPort        => $portnum,
                               Proto            => $proto);
		  }


	        if ($s eq undef)
	          {
                	die "IO::Socket::INET : port $port : $!" if 
				( ( $!{EADDRINUSE} && $EXIT_ON_PORT_USED ) || ! $!{EADDRINUSE} );
			push(@unbound, $port);
          	  }
        	else
          	  {
			$s->autoflush(1);
			$s->blocking(undef);
			push(@bound, $port);
			($proto eq "tcp") ? push(@tcpsockets, $s)
					  : push(@udpsockets, $s);
          	  }

	  }

	if (@bound)
	  {
		$logline = "Ports bound: " . join(",", @bound) . "\n";
		writelog($logline);
	  }

	if (@unbound)
	  {
		$logline = "Ports not bound: " . join(",", @unbound) . "\n";
		writelog($logline);
	  }

	die "No ports bound. Exiting\n" unless @bound;

	#
	# Create a select object, and stuff all the sockets in there
	# for polling
	#
	
	my $tcpsel = new IO::Select;
	$tcpsel->add(@tcpsockets);

	my $udpsel = new IO::Select;
	$udpsel->add(@udpsockets);

	my @handles = $udpsel->handles;
	#
	# Main loop. Poll all the sockets, respond to any incoming probes, and
	# log the location
	#

	# do_recv($handles[0]);

	while (1)
	  {
		my (@readers, $s);

		@readers = $tcpsel->can_read(.1);
		foreach $s (@readers)
		  {
			do_accept($s);
		  }

		@readers = $udpsel->can_read(.1);
		foreach $s (@readers)
		  {
			do_recv($s);
		  }

	  }
}

#
# Do the socket dirty work. Should probably collapse these into one function
# that takes "tcp" or "udp" as an arg. Too much duplicated code.
#

sub do_accept
{
	my $s = shift;
        my ($sockaddr, $remoteport, $remoteiaddr, $remoteaddr, $remotehostname, 
	    $localaddr, $localhost, $localport, $ident_query, $logmsg);

	my $n = $s->accept();

        $n->autoflush(1);
        $sockaddr = $n->peername;
        ($remoteport, $remoteiaddr) = unpack_sockaddr_in($sockaddr);

        $remoteaddr = inet_ntoa($remoteiaddr);
        $remotehostname = gethostbyaddr($remoteiaddr, AF_INET);
        $remotehostname ||= "(no reverse)";

        $localaddr = $n->sockaddr;
        $localport = $n->sockport;

	if ($DO_IDENT)
	  {
		$ident_query = ident_lookup($localport, $remoteport, $remoteaddr);
		$ident_query ||= "remote ident not running";
		chomp($ident_query);
	  }

        $localhost = gethostbyaddr($localaddr, AF_INET);
        $localhost ||= $n->sockhost;

        #respond($n, $localhost, $localport);

	my $msg = sprintf $RESPONSE, $localhost, $localport, $remotehostname, $remoteport;

	$n->write($msg, $IOBUFLEN);

	$logmsg = "Possible tcp port scan from $remoteaddr [ $remotehostname ] " . 
		  "on $localhost:$localport";

	$DO_IDENT ? $logmsg .= ", ident returns: $ident_query"
		  : $logmsg .= "\n";
	
        writelog($logmsg);
        $n->close();
}

sub do_recv
{
	my $s = shift;

        my ($sockaddr, $remoteport, $remoteiaddr, $remoteaddr, $remotehostname,
            $localaddr, $localhost, $localport, $output);


	$s->recv($output, 1024);
	my $peer = $s->peername;
	
	($remoteport, $remoteiaddr) = unpack_sockaddr_in($peer);
	
	$remoteaddr = inet_ntoa($remoteiaddr);
	$remotehostname = gethostbyaddr($remoteiaddr, AF_INET);
	$remotehostname ||= "(no reverse)";
	
	$localaddr = $s->sockaddr;
	$localport = $s->sockport;
	
	$localhost = gethostbyaddr($localaddr, AF_INET);
	$localhost ||= $s->sockhost;
	
        my $msg = sprintf $RESPONSE, $HOSTNAME, $localport, $remotehostname, $remoteport;

        $s->send($msg, undef, $peer);
        writelog("Possible udp port scan from $remoteaddr [ $remotehostname ] on $localhost:$localport\n");
}

sub ident_lookup
{
	my ($local, $remote, $hostname) = @_;
	my $response;

	my $serv = getservbyname("ident", "tcp");
	my $s = new IO::Socket::INET(PeerAddr => "$hostname:$serv",
				     Proto    => 'tcp' );

	return undef unless $s;
	$s->blocking(undef);
	my $sel = new IO::Select;
	$sel->add($s);

	$s->write("$remote, $local\n", $IOBUFLEN);
	while (! $sel->can_read(.1) ) { };
	$s->read($response, $IOBUFLEN);

	return "$response";
}

#
# writelog: write either to a log file or syslog
#

sub writelog
{
	my $logline = shift;

	if ($OUTFILE_FH) 
	  {
		print $OUTFILE_FH $logline;
	  }
	else
	  {
		syslog($LOGLEVEL, $logline);
	  }
}

#
# Grab the first field out of a file
#

sub first_field
{
	my $file = shift;
	my $fh = new IO::File($file) or die "file '$file' : $!";
	my (@lines, @returnarray, $x);

	while (my $line = $fh->getline)
	  {
		next if ($line =~ /^#/);
		chomp($line);
		push(@lines, $line);
	  }

	$fh->close();

	@returnarray = map { ($x) = split(' ') } @lines;
}