#!/s/perl/bin/perl --
#
# $Id: scan-detector.pl,v 1.2 1998/07/03 02:08:32 dparter Exp $
#
#---------------------------------------------------------------------------
#
# Synopsis: $0 [-s port[,port]*] [-d port[,port]*] [-i] 
#              [-l loghost] [-c name] [-p name] [-e]
#              [-n bytes] [-m bytes] [-t seconds] [-v]
#
#---------------------------------------------------------------------------
#
#      Copyright 1995, Christoph L. Schuba, Eugene H. Spafford
#			   COAST Laboratory
#			  Purdue  University
#		       West Lafayette, IN 47907
#		     {schuba,spaf}@cs.purdue.edu
#
#	    Mail comments, extensions, bug reports,... to
#
#		     scan-detector@cs.purdue.edu
#
#---------------------------------------------------------------------------
#
# This program was developed to detect UDP and TCP port scans such as 
#   performed by SATAN/SANTA or portscan.c and provide some useful 
#   information about them.
# 
# It takes a variable number of UDP and TCP port numbers as commandline 
#   arguments and opens a different socket for every single one. 
#
# arguments:
#   [-s port[,port]*] - list of stream (tcp) ports to monitor
#   [-d port[,port]*] - list of datagram (udp) ports to monitor
#   [-i]              - if present attempts identd lookups for tcp connections
#   [-l loghost]      - loghost for syslog (default = local host)
#   [-c name]         - name of syslogd code (default = AUTH)
#   [-p name]         - name of syslogd priority (default = NOTICE)
#   [-e]              - log to STDERR, not syslog. This overwrites options
#                       -l, -c, and -p (default = disabled)
#   [-n bytes]        - number of bytes to be monitored (default = 64)
#   [-m bytes]        - max number of bytes to be read for udp (default = 1600)
#                       should be > MTU of LAN) - use C prg to determine 
#                       SIOCGIFMTU via ioctl() on open socket.
#   [-t seconds]      - timeout for monitored connection (default = 15) 
#   [-v]              - verbose mode 
#
# For each socket that gets a TCP connection, the prg accepts it,
#   attempts to contact identd for peer information (if the -i switch is 
#   set ), keeps the connection up to opt_t seconds open, 
#   and reads up to opt_n --- whatever happens first.
# For each UDP packet sent to a specified port, all bytes of the 
#   packet are read, but only the first opt_n are logged along
#   with the number of bytes orginally read.
#
# The connection endpoint information and the transferred data are
#   then transformed into a legible format and logged. Here is the layout:
#
#     <prg-name> [user-id@]<remote-IPaddr>.<remote-port> -> 
#     <local-IPaddr>.<local-port> <protocol> ><received-data><
#     <#bytes in received-data> of <#bytes data received> bytes
#     [ - Possible SATAN scan!]
#
#---------------------------------------------------------------------------
# Data dictionary
#
# first letter "L" means data for 'local' side of connection
# first letter "R" means data for 'remote' side of connection
# 
# Host   - hostname (string)
# Ip     - IP address (unsigned long)
# Port   - port number (int)
# User   - user name
# Proto  - communcation protocol
# Name   - name of filedescriptor used in program
#
# Buffer - buffer for accumulation of received data
# Len    - original number of bytes of received data
#
# Watched is an associative array indexed by file descriptor number
# containing the following fields:
#   FILEHANDLE: fd of the current socket
#   PROTOCOL:   protocol value for tcp/udp
#   PORT:       bound port number
#   ADDRESS:    sockaddr_in struct to which the port is bound locally
#
#---------------------------------------------------------------------------
# Include section

use Socket;
use Config;

require 'Sys/Hostname.pm';
require 'getopts.pl';
require 'syslog.ph';
require 'sys/ioctl.ph';
require 'sys/termio.ph';
require 'sys/wait.ph';

#---------------------------------------------------------------------------
# The following subroutine is lifted from Socket.pm in Perl5.001
# If you run >= Perl5.001 you can remove this code. although it
# should behave normally if you don't.

eval "require 5.001" || eval q[
# pack a sockaddr_in structure for use in bind() calls.
# (here to hide the 'S n C4 x8' magic from applications)
sub Socket::sockaddr_in{
    my($af, $port, @quad) = @_;
    my $pack = 'S n C4 x8'; # lookup $pack from hash using $af?
    pack($pack, $af, $port, @quad);
}] ;
#---------------------------------------------------------------------------
# Determine own IP address and frequently used socket constants

$LHost       = &Sys::Hostname::hostname or
    die "Hostname lookup for myself didn't work!\n";
$LIp         = (gethostbyname($LHost))[4] or
    die "gethostbyname for local host failed";
$LIp = join(".", unpack('C4', $LIp));

$PROTO_TCP   = getprotobyname('tcp') or
    die "getprotobyname for 'tcp' failed";
$PROTO_UDP   = getprotobyname('udp') or
    die "getprotobyname for 'udp' failed";

#---------------------------------------------------------------------------
#  Set up default values on arguments
#
# You might want to adjust some of these

# counterintelligence
$opt_i = 0;			# No "ident" by default

# logging
$opt_l = "loghost";		# Syslog host is "loghost" by default
$opt_c = "AUTH";		# Syslog message type
$opt_p = "NOTICE";		# Level of syslog message
$opt_e = 0;			# Default logging to syslog

# data collection
$opt_n = 64;			# Max bytes to read from each connection
$opt_m = 1600;			# Default MTU for UDP packets
$opt_t = 15;			# Timeout for reading TCP message

# debugging
$opt_v = 0;			# Default is no verbose output

#---------------------------------------------------------------------------
# Examine runtime call - examine arguments.

$usage = "usage: ".$0." [-s port[,port]*] [-d port[,port]*] [-i]\n".
    "\t\t[-l loghost] [-c name] [-p name] [-e]\n".
    "\t\t[-n bytes] [-m bytes] [-t timeout] [-v]\n";

&Getopts("s:d:il:c:p:en:t:v") || die $usage;

# If there were no ports specified, we have nothing to do. That can 
# happen because both -s and -d switches are optional.

(defined($opt_s) || defined($opt_d))
    || die "Usage error: no ports specified!\n$usage";

# s -- stream port list
(defined $opt_s) && (($opt_s =~ m/^\d+(,\d+)*$/) || die $usage);

# d -- datagram port list
(defined $opt_d) && (($opt_d =~ m/^\d+(,\d+)*$/) || die $usage);

# c -- syslog code
eval "\$SyslogCode = &LOG_$opt_c" || die $usage;

# p -- syslog priority
eval "\$SyslogPrio = &LOG_$opt_p" || die $usage;


#--------------------------------------------------
# set up syslog facilities and identd data

&Syslog::Open($opt_l) unless $opt_e;

$Ident::Timeout = 10;

#--------------------------------------------------
#  Install a signal handler for children.
#
$SIG{'CHLD'} = sub {1 while (waitpid(-1, &WNOHANG) >= 0);};

#--------------------------------------------------
#
# we should drop the controlling TTY if neither -e, nor -v options are present
# after we become a daemon.
#

unless ($opt_e || $opt_v) {

    fork && exit(0);

    close (STDIN);
    close (STDOUT);
    close (STDERR);

    open  (DEVTTY,">/dev/tty");
    ioctl (DEVTTY,&TIOCNOTTY,0+0);
    close (DEVTTY);
}

#--------------------------------------------------
# For each specified port get a socket, bind to it and establish the 
# input queue with listen (for tcp only).
#
#--------------------------------------------------
$NoPorts   = 0;

# Now handle the -s port[,port]* stream TCP ports
PortsParse($PROTO_TCP, SOCK_STREAM, $opt_s) if defined($opt_s);

# Now handle the -d port[,port]* datagram UDP ports
PortsParse($PROTO_UDP, SOCK_DGRAM, $opt_d) if defined ($opt_d);

#--------------------------------------------------
# create the read bitmask for select()

$rfd = $rin  = '';
foreach $i (keys %Watched) {
    vec($rin, $i, 1) = 1;
}

#--------------------------------------------------
# the parent will loop forever and select connections sequentially

while (1) {

    print STDERR ("before rin = ", unpack("b*", $rin),"\n") if $opt_v;

    # Select the first port that becomes ready for input.
    $ReadyCount = select($rfd = $rin, undef, undef, undef);
    if ( $ReadyCount > 0 ) {

	# $ReadyCount file descriptors are ready for input now.

	print STDERR ("ready count = $ReadyCount\n",
	      "after   rfd = ", unpack("b*", $rfd),"\n") if $opt_v;
	
	# break the ready read file descriptor up for processing
	@RReady = split(//, unpack("b*", $rfd));

	# go through the array to determine the read ready file descriptors
	&PortsDo( grep($RReady[$_], (0 .. $#RReady)) );

    } elsif ( $ReadyCount < 0) {
	# We ignore this, because the "wait" will interrupt the select
    }
}

#--------------------------------------------------

sub PortsDo{
    # functionality:
    #   main routine to handle all ready sockets.
    #   TCP connections are accepted, and after the fork the child reads
    #   up to opt_n bytes of data - or until opt_t seconds pass. 
    #   Whatever happens first.
    #   UDP packets are read completely
    #   Data about the connecting machine/port/user are collected, and the
    #   log string is then created and written to the syslog
    # arguments:
    #   indices of ready file descriptors in our global datastructure.
    # result:
    #   none.

    my (@Indices) = @_;
    my ($RAddr, $fd, $LPort);

    foreach $fd (@Indices) {

	# now we know to which local port the peer connected
	$LConn = "$LIp.$Watched{$fd}{PORT}";

	print STDERR "fh\t= $Watched{$fd}{FILEHANDLE}\tfileno\t= $fd\n" 
	    if $opt_v;

	undef $RBuffer;
	$RBuffer = "";
	$RUser = "";
	$RLen = 0;

	#---------------------------
	if ($Watched{$fd}{PROTOCOL} == $PROTO_TCP) {

	    $RProto = "tcp";

	    # then accept the connection
	    ($RAddr = accept(NS, $Watched{$fd}{FILEHANDLE})) 
		|| die "accept: $!";
	    ($RIp, $RPort, $RConn) = &StringConnection($RAddr);

	    # fork - let the child handle this connection, 
	    #        let the parent go back to the select for further 
	    #          connections.

	    my $Child = fork;
	    if ($Child > 0) {
		print STDERR "I am the parent. child pid = $Child\n" if $opt_v;
		close (NS);
	    }			# if - end of parent code

	    elsif ($Child == 0) {

		print STDERR "I am the child. child pid = $$\n" if $opt_v;
			
                # call the ident daemon to get some info about the peer
		$RUser = Ident::Lookup($RIp, $RPort, $Watched{$fd}{PORT}) 
		    if ($opt_i);

		# install the alarm handler and install the
		# notification after opt_t seconds
		$NS = NS;
		$SIG{'ALRM'} = 'SigAlrmHandler';
		alarm ($opt_t);
			
		# read up to opt_n bytes from the socket
		# The SIGALRM might interrupt this (so what?)
		#   however, if we collect all the bytes, we shut off
		#   the alarm and call the handler ourselves

		while ($RLen < $opt_n) {
		    last if eof(NS);
		    $RBuffer .= getc NS;
		    $RLen++;
		}		# while less than opt_n characters read
		alarm (0);
		&SigAlrmHandler;
	    }			# elsif fork - end of child code
		    
	    else {
		# weird fork error
		die "Can't fork: $!\n";
	    }			# else fork

	}			# if protocol == tcp

	#------------------------------
	elsif ($Watched{$fd}{PROTOCOL} == $PROTO_UDP) {

	    $RProto = "udp";
	    $RUser  = "";
	    # The UDP protocol is handled by the parent. 
	    # Slight delay is ok for us.
	    # read all data out of the UDP packet.
	    # CONN_MAXBYTES should be defined at least as large as 
	    # the maximum MTU of the underlying network.
	    ($RAddr = recv ($Watched{$fd}{FILEHANDLE}, $RBuffer, $opt_m, 0))
		|| die "recv: $!";
	    ($RIp, $RPort, $RConn) = &StringConnection($RAddr);

	    # shrink the read data to opt_n, if necessary
	    $RLen = length($RBuffer);

	    $RBuffer = substr($RBuffer, 0, $opt_n);
		    
	    Syslog::Print(($SyslogCode|$SyslogPrio), $RUser, $RConn, $LConn,
			  $RBuffer, $RLen, $RProto);

	}			# if protocol == udp

	else {
	    die "Protocol not supported!\n";
	}
	
    }				# for $fd
}

#---------------------------------------------------------------------------

sub PortsParse {
    # functionality:
    #   for each port in the passed list connect via socket,bind,connect
    #   if we have a tcp port, and connect via socket,bind if we have a 
    #   udp port. Update the global Watched structure.
    # side effect!: For each successfully processed port, we increase 
    #   $NoPorts by one and update Watched
    # arguments:
    #   PROTO:     protocol value of tcp or udp
    #   $SOCKtype:  socket type value according to protocol type 
    #   $PortsList: list of ports to be opened for data retrieval
    # result:
    #   none.

    my ($PROTO, $SOCKtype, $PortsList) = @_;
    my ($Port, $LSock, $LFH);

    foreach $Port (split(/,/,$PortsList)) {

	$LFH = S.$NoPorts;

	$LSock = Socket::sockaddr_in(AF_INET, $Port, 0, 0, 0, 0);

	socket($LFH, PF_INET, $SOCKtype, $PROTO) 
	    || die"socket: $!";
	bind ($LFH, $LSock)                         
	    || die"bind: $!";
	($PROTO == $PROTO_TCP) && (listen($LFH, 5)
            || die"listen: $!");

	print STDERR ("\U$PROTO\E port\t= $Port\tFiledes\t=",fileno($LFH),"\n")
	    if $opt_v;

	$Watched{fileno($LFH)} = { FILEHANDLE => $LFH,
				   PROTOCOL => $PROTO,
				   PORT => $Port,
				   ADDRESS => $LSock };

	$NoPorts++;
    }				# foreach port

}		

#---------------------------------------------------------------------------

sub StringConnection {
    # functionality:
    #   determine the remote IP address and port number, given a sock_addr 
    # arguments:
    #   SockAddr: a socket address in the sock_addr structure
    # result: 
    #   $RIp:   IP address of the remote machine
    #   $RPort: port of the remote machine
    #   $RConn: IP address of the connection as a dotted quad
    #           and the port number attached -> dotted quint

    my ($RPort,$RIp) = (unpack('S n a4', $_[0]))[1,2];

    my ($RConn) = sprintf "%d.%d.%d.%d.%d", unpack('C4', $RIp), $RPort;

    print STDERR "Remote connection from $RConn\n", if $opt_v;

    ($RIp, $RPort, $RConn);
}

#---------------------------------------------------------------------------

sub StringSanitize {
    # functionality;
    #   A routine to clean out control characters and other funny stuff.
    # arguments:
    #   $_[0]: any character string
    # result:
    #   $_[0]: the sanitized string

    return "" unless $_[0];

    $_[0] =~ s/\^/^^/g;
    $_[0] =~ s/([\0-\037\177])/sprintf("^%c",ord($&)+64)/ge;
    $_[0] =~ s/([\200-\377])/sprintf("\\%03o",ord($&))/ge;

    # return the sanitized string
    $_[0];
}

#---------------------------------------------------------------------------

sub SigAlrmHandler {
    # functionality:
    #   signal handler reacting to a SIGALRM scheduled by the child process.
    # arguments:
    #   none.
    # global variables:
    # (remark: it is necessary to use global variables, because this 
    #   subroutine is called as a signal handler.)
    #   $RUser:   <user-id> or <error-token> from identd, or ""
    #   $RConn:   IP address and port number of remote connection endpoint
    #   $LConn:   IP address and port number of local connection endpoint
    #   $RBuffer: up to opt_n bytes of data gathered during the 
    #               access within opt_t seconds
    #   $RLen:    number of bytes received on socket
    #   $RProto:  protocol identifier of the connection
    # result:
    #   exit(0)

    shutdown ($NS,2);

    Syslog::Print(($SyslogCode|$SyslogPrio), $RUser, $RConn, $LConn, 
		  $RBuffer, $RLen, $RProto);

    # return
    exit (0);
}


#---------------------------------------------------------------------------

package Syslog;
use Socket;

sub Open {
    # functionality:
    #   We only need to do this once...then we can reuse the socket.
    #   create a udp 'connection' to the syslog daemon
    # arguments: 
    #   $HostName:   the name of the host to which we log
    # result:
    #   none.

    my($HostName) = @_;

    # check that the user has either adjusted the default, or used the 
    # command line option properly.
    if ($HostName eq "loghost") {
	die "adjust constant \$main::opt_l or use -l command line switch"; }

    # get the port for the service
    my $port = (getservbyname ("syslog", "udp"))[2]
	|| die "getservbyname: $!";

    my $proto = getprotobyname('udp')
	|| die "getprotobyname for 'udp' failed";

    socket(SyslogFH, PF_INET, SOCK_DGRAM, $proto) 
	|| die "socket: $!";

    my $ipaddr = (gethostbyname($HostName))[4]
	|| die "gethostbyname for loghost $_[0] failed\n";

    my $sock = Socket::sockaddr_in(AF_INET, $port, 
					 unpack('C4', $ipaddr));
    connect(SyslogFH, $sock) 
	|| die "connect $!";

    print STDERR "Logging to host $HostName\n" if $main::opt_v;
}

#---------------------------------------------------------------------------

sub Print {
    # functionality:
    #   concatenate the data gathered about the remote
    #   connection attempt, convert it to readable characters, and dump
    #   it to the log.
    # arguments: (we split them up for legibility)
    #   $SyslogLevel: syslog code ORed with the syslog priority
    #   $RUser:        <user-id> or <error-token> from identd
    #   $RConn:        IP address and port number of remote connection endpoint
    #   $LConn:        IP address and port number of local connection endpoint
    #   $RBuffer:      up to opt_n bytes of data gathered during the 
    #                    access within opt_t seconds.
    #   $RLen:         number of bytes received on socket.
    #   $RProto:       protocol type as string of the 'connection'
    # results:
    #   $_:       the constructed resulting string

    my ($SyslogLevel,$RUser,$RConn,$LConn,$RBuffer,$RLen,$RProto) = @_;

    # if RUser is specified, we'd like to create an e-mail like address
    $RUser .= '@' if $RUser;

    # construct the report string for the log.
    $_ = "<".($SyslogLevel).">".$0." ".
	 $RUser.$RConn." -> ".$LConn." ".$RProto.
	     " >".$RBuffer."< ".length($RBuffer);

    # note only for udp how much data was actually sent, since with tcp 
    # we don't read everything to prevent the CIAC-Shimomura game.
    $_ .= " of $RLen" if ($RProto eq 'udp');
    $_ .= " bytes";

    if (($RBuffer =~ m/QUIT/) && ($RProto eq 'tcp')) {
	$_ .= " - Possible SATAN scan!";
    }

    # format non printable characters nicely.
    $_ = main::StringSanitize($_);

    print STDERR "$_\n" if ($main::opt_v || $main::opt_e);

    if (!$main::opt_e) {
	send(SyslogFH, $_, 0) || print STDERR "send: $!\n";
    }
}

#---------------------------------------------------------------------------

package Ident;
use Socket;

sub Lookup {
    # functionality:
    #   given a TCP connection, contact the remote ident daemon and
    #   request the userid of the owner of the connection at the 
    #   remote side. Return the user userid, or an empty string.
    #   Keep this connection only IdentTimeout seconds open, such that
    #   we don't run into a blocking problem here. (via select)
    # arguments:
    #   $RIp:   IP address of the connecting machine
    #   $RPort: port of the connecting machine
    #   $LPort: port on local machine
    # result:
    #   <user-id>     if the identd returned the userid
    #   <error-token> otherwise

    my ($RIp, $RPort, $LPort) = @_;
    my $LookupResult = "";

    # create a tcp connection to the ident daemon on the remote system 
    my $Port = (getservbyname ("ident", "tcp"))[2]
	|| die "Cannot get ident service port: $!";

    my $PROTO_TCP   = getprotobyname('tcp')
	|| die "getprotobyname for 'tcp' failed";

    socket(SockFH, PF_INET, SOCK_STREAM, $PROTO_TCP) 
	|| die "socket: $!";
    my $Sock = Socket::sockaddr_in(AF_INET, $Port, unpack('C4',$RIp));
    connect(SockFH, $Sock) || goto DONE;;

    # set autoflush for the connection
    select((select(SockFH), $| = 1)[0]);

    # send the  request a la RFC 1413
    # <request>   ::= <port-pair> <EOL>
    # <port-pair> ::= <integer> "," <integer>
    # <EOL>       ::= "015 012"  ; CR-LF End of Line Indicator

    print SockFH "$RPort , $LPort\r\n";

    print STDERR "Request to identd service: >$RPort , $LPort<\n" 
	if $main::opt_v;

    my ($ReadyCount, $rfd);
    $rfd = '';
    vec($rfd, fileno(SockFH), 1) = 1;

    if ( $ReadyCount = select($rfd, undef, undef, $Timeout) != 1) {
	# either error or timeout. In either case we stop trying.

	print STDERR "Timeout or Error condition in ident select\n" 
	    if $main::opt_v;
    }
    else {
	# the select returned one ready file descriptor -> the ident reply.
	
	$ReplyLine = <SockFH>;

	print STDERR "Reply from identd service: >$ReplyLine<\n" 
	    if $main::opt_v;
	$ReplyLine =~ y/\r\n//d;

	# here is the reply a la RFC 1413
	# <reply-text> ::= <error-reply> | <ident-reply>
	# <ident-reply> ::= <port-pair> ":" "USERID" ":" <opsys-field> ":"
	#                   <user-id>
	# we want to log only the <user-id> field

	local @Reply = split (/\s*:\s*/, $ReplyLine);
	if ($Reply[1] =~ m/userid/i) {
	    $LookupResult = $Reply[3]; }

	# <error-reply> ::= <port-pair> ":" "ERROR" ":" <error-type>
	# <error-type>  ::= "INVALID-PORT" | "NO-USER" | "UNKNOWN-ERROR" |
	#                   "HIDDEN-USER" |  <error-token>
	# <error-token> ::= "X"1*63<token-characters>
	
	elsif ($Reply[1] =~ m/error/i) {
	    $LookupResult = $Reply[2]; }
	
	# identd doesn't adhere to the protocol?
	
	else {
	    $LookupResult = ""; }
	
	# Sanitize the return in case they are playing games with ident... 
	$LookupResult = &main::StringSanitize($LookupResult);
	
	print STDERR "Result of identd lookup: >$LookupResult<\n" 
	    if $main::opt_v;
    }

DONE:
    shutdown(SockFH, 2);

    # return
    $LookupResult;
}


#---------------------------------------------------------------------------
