#!/usr/bin/perl
# blackbox
# script to collect specified network traffic
# in a series of dump logfiles for later analysis
# 
#
# Copyright (C) 2003, 2004, 2005, Marco Guardigli mgua@tomware.it
#
# Modified by Cristian Evangelisti (June 2004)
#
# ------------
# This program is free software; you can redistribute it and/or modify it 
# under the terms of the GNU General Public License as published by the 
# Free Software Foundation; either version 2 of the License, or (at your 
# option) any later version.
#
# This program is distributed in the hope that it will be useful, but 
# WITHOUT ANY WARRANTY; without even the implied warranty of 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along 
# with this program; if not, write to the Free Software Foundation, Inc., 
# 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
#
# ---------------
# history:
# 	aug 03:	v 0.1 first hack (mg)
# 	jun 04:	v 0.2 multi-os support (ce)
# 	nov 04:	v 0.3 code cleaning, comment translation,
# 		submission to savannah.gnu.org (mg)
# 	jan 05: v 0.4 bux fix on date format (day was not always expressed 
# 		in two digit format) (mg)
#
# 	
# ---------------
#
#
# This script requires the presence of the Perl Interpreter. Perl should be 
# fairly common on unices. On Windows, it has been tested with the 
# Activestate (TM) Perl port. See www.activestate.com
#
# Libraries for network packet capture are also required. On unices these 
# are normally installed along with the tcpdump/libcap package.
# See http://www.tcpdump.org/
#
# A Tcpdump/Libcap port on Windows is called Windump/Winpcap, and works 
# very well. You need to install both the windump executable in a directory
# inside your path and the winpcap driver.
# See windump.polito.it
#
# ---------------
# 
# by default, network dump files are left in the current directory on windows
# they are put in /var/log/blackbox/ on unices (the directory must exist)
#
# ---------------
# 
# Blackbox has to be run as root
# 
# ---------------
# 
# Currently, blackbox has no command line interface. 
# parameters have to be inserted modifying the source code.
# this is not an ideal situation. Feel free to improve it.
#
# 


use strict;

my $DEBUG 		= 0;	# leave as 0 in production use
my $keep 		= 10;	# how many old files to keep 
my $filter		= "";	# i.e. "host 172.20.5.4 and tcp port 23"
my $pcount		= 50;	# number of packets to collect in each file
				# use something like 100000 for production use
my $count		= 0;	# 



# Ideally blackbox should support many different operating systems
# extensive testing has been done on linux and windows platoform
# 
# Code should (probably) work with minor tweaks in every platform
# you should check the parameters for your OS in the respective code section
# 
# A tcpdump port to OS/2: see http://www.unixos2.org/sw/pub/unixos2/packages/tcpdump.zip
# 

use vars qw( $OS $mvcmd $bbpath $dumpcmd $interface $logfile $osredir );

require Config;
$OS = $Config::Config{'osname'};

my $OS_label_1 = $OS;

if ( $OS =~ /Win/i ) {			# ******* WINDOWS *******
	$OS		= 'WINDOWS';
	$mvcmd		= "move";
	$bbpath 	= ".\\";
	$interface	= "2";	# identify your target interface with windump -D and use 
				# its numerical identifier
	$dumpcmd 	= "windump -n -s 0 -i $interface -c $pcount"; # -s 0 gets whole packets
	$logfile 	= $bbpath . "blackbox.log";
	$osredir	= "";	# this is appended to the end of the dump command
}
elsif ( $OS =~ /^netbsd$/i ) {		# ******* NetBSD *******
	die "unsupported Operating system [$OS]";
	# following code has to be checked.
	$OS         = 'NetBSD';
	$mvcmd		= 'mv';
	$bbpath 	= "/var/log/blackbox/";
	$interface	= "";
	$dumpcmd 	= "tcpdump -n -s 0 -i $interface -c $pcount"; # -s 0 gets whole packets
	$logfile 	= $bbpath . "blackbox.log";
	$osredir	= "2> /dev/null";
}
elsif ( $OS =~ /^MacOS$/i ) {		# ******* MACINTOSH *******
	die "unsupported Operating system [$OS]";
	# following code has to be checked.
	$OS         = 'MACINTOSH';
	$mvcmd		= 'mv';	
	$bbpath 	= "~/";
	$interface	= "";
	$dumpcmd 	= "";
	$logfile 	= $bbpath . "blackbox.log";
	$osredir	= "";
}
elsif ( $OS =~ /os2/i ) {			# ******* OS2 *******
	die "unsupported Operating system [$OS]";
	# following code has to be checked.
	$OS         = 'OS2';
	$mvcmd		= 'ren';
	$bbpath 	= ".\\";
	$interface	= "";
	$dumpcmd 	= "";
	$logfile 	= $bbpath . "blackbox.log";
	$osredir	= "";
}
elsif ( $OS =~ /linux/i ) {
	$OS         = 'GNU Linux';		# ******* Linux *******
	$mvcmd		= 'mv';
	$bbpath 	= "/var/log/blackbox/";
	$interface	= "eth0";
	$dumpcmd 	= "tcpdump -n -s 0 -i $interface -c $pcount"; # -s 0 gets whole packets
	$logfile 	= $bbpath . "blackbox.log";
	$osredir	= "2> /dev/null";
}
else {
	die "unsupported Operating system [$OS]";
	# following code has to be checked.
	$OS         = 'UNIX';		
	$mvcmd		= 'mv';	
	$bbpath 	= "/var/log/blackbox/";
	$interface	= "";
	$dumpcmd 	= "tcpdump -n -s 0 -i $interface -c $pcount"; # -s 0 gets whole packets
	$logfile 	= $bbpath . "blackbox.log";
	$osredir	= "";
}	

my $OS_label_2 = $OS;
print "\n ----------------\n ";
print "OS Type: $OS_label_2\n Details: $OS_label_1";
print "\n ----------------\n\n";

print "Blackbox is capturing...\n"; 
print "dumpcmd =[$dumpcmd $filter]\n"; 
print "press CTRL-C or CTRL-Interrupt to stop capture.\n";

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


sub now {
        my ($dow,$mon,$dd,$hms,$yyyy) = split(/ +/,scalar localtime());
        print "NOW: " . scalar localtime() . "dow=[$dow] mon=[$mon] dd=[$dd] hms=[$hms] yyyy=[$yyyy]\n" if $DEBUG;
        my $ix = index("-Jan-Feb-Mar-Apr-May-Jun-Jul-Aug-Sep-Oct-Nov-Dec","-$mon");
        if ($ix == -1) {
                die "Illegal month specification: [$mon]";
        }
        print "NOW: ix=[$ix]\n" if $DEBUG;
        my $mno = substr("010203040506070809101112",($ix / 2),2);
        my ($hh,$mm,$ss) = split(/:/,$hms);
	$dd = "0" . $dd if length($dd) == 1;
        my $now="$yyyy-$mno-$dd-". $hh . $mm . $ss;
        print "NOW: now=[$now]\n\n" if $DEBUG;
        return $now;
}

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

sub wlog {
        my $lf = $logfile;
        my $line;
        open (LOGF,">>$lf") || print "\n*** wlog failed open $lf: $!\n";
        foreach $line (@_) {
                my $t=scalar localtime();
                print LOGF "$t $line";
        }
        close(LOGF);
}

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

sub hkeeper {
	if ( $OS eq 'WINDOWS' ) {		
		my @nomif;
		opendir(DIR, $bbpath) or die "can't opendir $bbpath: $!";
		while (defined(my $file = readdir(DIR))) {
			next if $file =~ /^\.\.?$/;
			if ($file =~ /\.tcpdump$/i) {
			$nomif[$count] = $file;
			#print "$nomif[$count]\n";
			$count++;
			}
		}
		closedir(DIR);
		wlog "hkeeper: \$count=[$count] (>=) \$keep=[$keep] ?\n";			
		my $victim ="";
		while ($count >= $keep) {
			print "hkeeper \$count=$count keep=$keep\n" if $DEBUG;
			$victim = shift(@nomif);
			chomp $victim;
			print "hkeeper: deleting file [$victim]\n" if $DEBUG;
			print "hkeeper sleep...\n" if $DEBUG;
			sleep(3) if $DEBUG;
			wlog "hkeeper: deleting file [$victim]\n";
			unlink "$bbpath"."$victim" || die "hkeeper: cannot delete file [$bbpath $victim]";
			$count--;
		}
	}
	elsif ( $OS eq 'NetBSD' ) {	
		die "unsupported Operating system [$OS]";
		# insert here the code for your OS.
	}
	elsif ( $OS eq 'MACINTOSH' ) {
		die "unsupported Operating system [$OS]";
		# insert here the code for your OS.
	}
	elsif ( $OS eq 'OS2' ) {
		die "unsupported Operating system [$OS]";
		# insert here the code for your OS.
	}
	elsif ( $OS eq 'GNU Linux' ) {
		my $tgt = $bbpath . '*.tcpdump';
		my @old=`ls $tgt`;
		wlog "hkeeper: \$#old=[$#old] (>=) \$keep=[$keep] ?\n";
		while ($#old >= $keep) {
			print "hkeeper #old=$#old keep=$keep\n" if $DEBUG;
			print "hkeeper: old=\n@old\n" if $DEBUG;
			my $victim = shift(@old);
			chop $victim;
			print "hkeeper: deleting file [$victim]\n" if $DEBUG;
			# print "hkeeper sleep...\n" if $DEBUG;
			# sleep(3) if $DEBUG;
			wlog "hkeeper: deleting file [$victim]\n";
			unlink $victim || die "hkeeper: cannot delete file [$victim]";
			@old=`ls $tgt`;
		}
	}
	else {
		die "unsupported Operating system [$OS]";
		# insert here the code for your OS.
	}
}	


# ##############################################
# main code starts here
# 

if ($DEBUG) {
	print "blackbox network recorder\n";
	print "now=" . now() . "\n";
	print "OS=[$OS]\n";
	print "files to keep=$keep\n";
	print "blackbox base path=$bbpath\n";
	print "filter=$filter\n";
	print "dumpcmd=$dumpcmd\n";
	print "logfile=$logfile\n";
	print "mvcmd=$mvcmd\n";
}

wlog "Blackbox started on: " . scalar localtime();
wlog ("$DEBUG=$DEBUG\n","\$keep=$keep\n","\$bbpath=$bbpath\n","\$filter=$filter\n");
wlog ("\$interface=$interface\n","\$dumpcmd=$dumpcmd\n","\$logfile=$logfile\n");
wlog "----\n";

my $el;

while(1) {
	hkeeper();
	my $t1 = now();
	print "blackbox: data collect started: $t1 ...\n" if $DEBUG;
	my $outfile = $bbpath . "blackbox.$t1" . "_.tcpdump";
	my $cmd = "$dumpcmd -w $outfile $filter" . $osredir;
	my $out = `$cmd`;	
	wlog "[$cmd] done: \$?=[$?]\n";
	print "blackbox done $cmd : el=$el\n" if $DEBUG;
	my $t2 = now();
	my $fn = $bbpath . "blackbox.$t1" . "_$t2" . ".tcpdump";
	print "$mvcmd $outfile $fn\n" if $DEBUG;
	my $out = `$mvcmd $outfile $fn`;
	print "renamed [$outfile] to [$fn]: \$?=$?\n" if $DEBUG;
	wlog "renamed [$outfile] to [$fn]: \$?=[$?]\n";
}



