#!/usr/bin/perl 
#
# name     : monitor_socket.pl
#
# History :
#		<4> Mar 1996 (S.Boran)
#		    Recognise Satan connections too. Modify
#		    for Perl 5.002. tested on Solaris 2.4.
#		    Send a message to syslog as well.
#
#		<3> V1.3 Oct14.'93 (S.Boran)
#		    added wait to main loop of parent 
#		    (to reduce CPU usage when idle)
#
#		<2> V1.2 Oct11.'93 (S.Boran)
#		    monitor a list of sockets & don't die after a
#		    connection (must use 'kill - TERM')
#		    Works on solaris1 & 2.2.
#
#		<1> V1.1 Aug13.'93 (S.Boran)
#		    First version monitoring a single socket.
#
# FUNCTION:	listen to local TCP sockets (list supplied on the
#		command line, or sybase defaults used)
#		& mail first $max_lines lines to $user
#		If the connection appears to come from sybase, print
#		the sybase connection data in readable form
#
# Debugging:	set $debug=1 to switch on debug mode.
#
# ToDo:		. force the other side to terminate after N secs
#		. use syslog instead of mail

## Perl 4:
#require 'sys/errno.ph';
#require 'sys/socket.ph';
#require 'sys/signal.ph';
#require 'sys/wait.ph';

## Perl 5.002
use POSIX;
use Socket;

$debug = '';				# '1' for debug, '' for no debug info

#----- signal handling ----
$SIG{'INT'}  = 'sig_handler';		# reasons to die..	
$SIG{'QUIT'} = 'sig_handler';		# (KILL,STOP cannot be caught)
$SIG{'TERM'} = 'sig_handler';		
$SIG{'TSTP'} = 'sig_handler';
$SIG{'BUS'}  = 'DEFAULT';		# these should avoid a core dump?
$SIG{'SEGV'} = 'DEFAULT';
$SIG{'ILL'}  = 'DEFAULT';
$SIG{'TRAP'} = 'DEFAULT';
$SIG{'ABRT'} = 'DEFAULT';
$SIG{'EMT'}  = 'DEFAULT';
$SIG{'FPE'}  = 'DEFAULT';

$SIG{'CHLD'} = 'reapchild';		# child status has changed	
$WNOHANG = defined &WNOHANG ? &WNOHANG : 1;

# --- perl security precautions ---
$ENV{'PATH'} = '/usr/bin';
$ENV{'SHELL'} = '/bin/sh' if $ENV{'SHELL'} ne '';
$ENV{'IFS'} = '' if $ENV{'IFS'} ne '';
umask(077);                             # -rw-------

# ----------------- variable setup  ---------------
#$user = 'admin';
$user = $ENV{'LOGNAME'};
$mail_subject = 'DANGER! attemped satan/sybase connection';
$max_lines=5;				# read only so many lines from sock
$this_prog="Socket Monitor";
$hostname=`uname -n`;  chop($hostname);
$sockaddr = 'S n a4 x8';		# binary format of socket addr
$os=`uname -r`;

if (($os == "4.1.3") || ($os == "4.1.2")) {
    $mail='/usr/ucb/mail';		# BSD
    print "OS= 4.1.2 or 4.1.3\n" if $debug;
}
else {					# assume Solaris 2 (SVR4)
    $mail='/usr/bin/mailx';		#
    print "OS= Solaris 2.x\n" if $debug;
}



# ---- port numbers are command line arguments ----
@port = @ARGV;				# copy list	
if (@port == 0) {			# scalar context=> no. of elements
    @port = (2025, 2026);		# use standard sybase ports as default
}

#if ($debug) {
    print "Ports to be monitored: ";
    for ($i=0; $i<@port; $i++) {
	print "$port[$i] ";
    }
    print "\n";
#}

# ----------------- get today's date  ---------------
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime;
$month = (Jan,Feb,Mar,Apr,May,Jun,Jul,
    Aug,Sep,Oct,Nov,Dec)[(localtime)[4]];
$day = (Sun,Mon,Tue,Wed,
    Thu,Fri,Sat)[(localtime)[6]];
$today = $day." ".$month." ".$mday.", ".$year;
$time = $hour . ":" . $min;		# . concatenates strings

#Not used
# ($mday,$mon,$year)=(localtime)[3,4,5]; 
# $date="$mday/".eval($mon+1)."/$year";

# ----------------- setup tcp socket ---------------
($name,$aliases,$proto)
    = getprotobyname('tcp'); 		# get protocol nr. $proto

#if ($port[0] !~ /^\d+$/) {		# get service name(unneeded)
#    ($name,$aliases,$port[0]) 
#    	= getservbyport($port[0], 'tcp');
#}

for ($i=0; $i<@port; $i++) {

    $this_port = $port[$i];
    $sock_struct = pack($sockaddr, $AF_INET, 
	$this_port, "\0\0\0\0"); 	# create socket addr struct

    $child_pid = fork();		# fork a child for each port
    $children[$i]= $child_pid;
    print "$i: Child $children[$i];" 	if $debug;

    if ($child_pid ) {         		# parent process
    	print "parent!\n" if $debug;
    	next;				# next port (go back to for)	
    }
    elsif ($child_pid == 0) { 
 
	# VVVVVVVVVVVVVVVVVVVV Child VVVVVVVVVVVVVVVVVVVV
	print " Child! sock $this_port ($i)\n" if $debug;

	# --- NS is the fake socket for connections --------
	select(NS); 			# NS is default o/p
	$|=1; 				# unbuffer output to NS
	select(STDOUT);			# reset stdout as default o/p 
			
	socket(S, &AF_INET, &SOCK_STREAM, $proto) 	# create comms socket
	    || die "Couldn't open socket: $!";
	bind(S, $sock_struct) 				# bind sock to port
	    ||  die "bind socket: $!";
	listen(S, 5) ||  die "listen: $!";		# allow incoming 

	select(S); $|=1; select(STDOUT);		# unbuffer S
	
	for (;;) {					# monitor sock FOREVER
	
	    # wait for, then take next connection
	    ($addr = accept(NS,S)) 
		    || die "accept: $!";
	
	    &handle_connection($addr);
	
	}						# FOREVER LOOP 
	# ^^^^^^^^^^^^^^^^^^^^^ Child ^^^^^^^^^^^^^^^^^
    }						# if child

}						# for port

# all children are still running
print "Children @children\n" if $debug;
for (;;) {
    # waiting for a signal .....
    wait();
}

# should never get here
#EOF

######################### SUBROUTINES ####################

	############# Subroutine: sig_handler ########
	# A shutdown signal has been received so:

sub sig_handler {

   if ($child_pid == 0) {			# For children
	print "$this_prog: Child $$ dying, " if $debug;
        close(NS);				# close sock
	exit 0;
   }

   # I'm the parent: kill kids, wait for them to die,
   #                 then kill myself
   kill 'TERM', @children;
   waitpid(-1,$WUNTRACED);
   print "$this_prog: All children dead\n";
   
   shutdown(S, 2); close(S);
   exit 0;
}

	############# Subroutine: reapchild ########
	# A child has changed state (SIGCHLD received) so:
	# request status on any child (param -1 below)
	# This routine should prevent zombie processes.

sub reapchild {
    while (1) {
	print "Reaping child\n" if $debug;
	$pid = waitpid(-1,$WNOHANG);		# catch any child, but don't 
	last if ($pid < 1);			# wait
    }
}


	############# Subroutine: handle_connection ########
	# Handle socket connection subroutine.

sub handle_connection {
    local($addr) = @_;
    local($i, $result);

    # we have a connection! If we wanted to write AND
    # read to the socket, a fork would be needed mow.
    # however all we do is listen

    # ---- decode the other hostname
    ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
    ($targethost,$aliases,$addrtype,$len,@addrs) 
	= gethostbyaddr($inetaddr,&AF_INET);
    # ---- decode IP address -----
    @inetaddr = unpack('C4',$inetaddr);		# @inetaddr=161 20 36 65
    $ipaddr = join('.', @inetaddr);		# $ipaddr=161.20.36.65

    # ----------------- file setup  ---------------
    $tmpfile = "/tmp/mon_sock.$$";
    print "$tmpfile $today \n" if $debug;

    open(OUTFILE,">$tmpfile")			# log traffic
    || die "can't open $tmpfile: $!\n";
    print OUTFILE "\t\tConnection! \n\n",
	"TO:\t $this_port($hostname)\n",
	"FROM:\t af=$af port=$port ",
	"host=$targethost($ipaddr) ",
    	"(aliases:$aliases)\n";

   $line_count = 0;				# accept $max_lines, then break
    while (<NS>) {
       $line_count++;

       if  ($line_count > $max_lines) {
	    print OUTFILE "$line_count: $_",
	    	"Closing connection after ",
		"$max_lines lines.\n";
	    print "Too many lines: closing connection\n" if $debug;
	    last;				# exit while <NS>
       }
       elsif (($line_count == 1) && (/DB-Library$/)){
	    # Is this a sybase (dwb) connection?

	    print OUTFILE "\n ------- Looks like Sybase? ----------\n";
	    print OUTFILE "Raw data (line $line_count): $_\n";
		
            # format:
	    # voodoousernmapasswd1267dwbPMDS_GVpasswDB-Library
	    print OUTFILE "\nInterpreting the above data gives: \n\n";

	    # translate control chars to spaces, use space as delimiter
	    tr/a-zA-Z0-9_/ /cd;
	    ($f1,$f2,$f3,$f4,$f5,$f6,$f7,$f8,$f9) = split(' +',$_);
		
	    print ">>$f1-$f2-$f3-$f4-$f5-$f6-$f7-$f8-$f9<<\n" if $debug;

	    print OUTFILE "Host:\t\t$f2",
	    	"\t\tSybase server:\t$f7 \nSybase user:\t$f3",
	    	"\t\tPassword:\t$f4 ($f8)\n",
	    	"Service:\t$f6($f9)\n";

#    	    print OUTFILE unpack($sockaddr,getpeername(NS));

	    print OUTFILE "-----------------------" . 
		"-------------------------\n";
       }
       elsif (($line_count == 1) && (/QUIT$/)){
	    # Hmmm.. looks like a satan scan
	    print OUTFILE "\n ------- Looks like a Satan scan! ----------\n";
	    print OUTFILE "Raw data (line $line_count): $_\n",
	    	"-----------------------" . 
		"-------------------------\n";
       }
       else {
	    print OUTFILE "Raw data (line $line_count): $_\n",
	    	"-----------------------" . 
		"-------------------------\n";
       }
    }						# while <NS>
    close(OUTFILE);
    shutdown(NS, 2);
    close(NS);

    # ========= if there was output, mail & remove tmp file =====
    if ($debug) {				# use instead of mail for debug
	system("cat $tmpfile");
    }
    else {
	system("$mail -s '$mail_subject' $user < $tmpfile");
	# <4>
        system("/usr/ucb/logger -p auth.alert 'Socket monitor: possible sybase/satan connection!'");
    }
    unlink($tmpfile);
 
   $result='1';
}