#!/usr/bin/perl -w

use strict;

use threads;
use threads::shared;

use Config;
use Socket;

use Net::Pcap 0.03;
use Net::PcapUtils;

use NetPacket::Ethernet;
use NetPacket::IP;
use NetPacket::UDP;
use NetPacket::TCP;

use Getopt::Std;
use Text::ParseWords;

use Time::HiRes;

my $VERSION = 0.1;

$|++;

################################################################################
# Thread shared common variables
################################################################################

# Indicates should thread loop continue
my $CONTINUE : shared;
$CONTINUE = 1;

# These hashes used to store DNS lookup cache (and to communicate between threads)
my %cacheNames : shared;
my %cacheATime : shared;
%cacheATime = ();
%cacheNames = ();
  
# Lengths of the display fields
my $MINHOSTLEN = 15;
my $PORTLEN    = 8;
my $PROTOLEN   = 5;
my $AMOUNTLEN  = 10;
my $HEADHIGHT  = 3;

# Use these signals to stop the program
$SIG{'INT'}  = \&stopProgram;
$SIG{'TERM'} = \&stopProgram;
$SIG{'HUP'}  = \&stopProgram;

#my $COLUMNS   = 80;
#my $LINES     = 24;

####################################################################################
# Command line switches must be processed
####################################################################################

# Usage message
my $usage = <<"EndOfUsage";
Print info about traffic on specified interface[s]

Usage: $0 [-hl] -i<interface[,interface[...]]> [-f<filterLine>] [-r<screenRefreshInterval>] [-d<disapperTimeout>] [-pnecst]

$0 is capturing traf on the specified interfaces 
and show it on terminal in real time

EndOfUsage

# Read the options

my @opts = (['h', '',  0,     ": Print help notice, and exit\n"],
            ['l', '',  0,     ": List all available interfaces, and exit\n\n"],
            ['p', '',  0,     ": Do not operate in promiscuous mode\n"],
            ['e', '',  0,     ": Show  the  Ethernet  traffic  rather  than IP. It is possible to\n\tswitch between them by pressing the ENTER or 'e' key.\n"],
            ['n', '',  0,     ": Do not resolve host and services names, toggle by 'n' key\n\n"],
            ['i', ':', undef, "<iface>[,<anotherIface>[...]: interface to listen for the traf\n"],
            ['f', ':', '',    "<filterLine>: traf filter line in PCap format\n\n"],
            ['r', ':', 1,     "<screenRefreshInterval>: how frequently screen will be updated (in seconds)\n\tDefault is 1\n"],
            ['d', ':', 10,    "<disappearTimeout>: for how long inactive (no more traf) lines\n\twill be preserved on screen\n\tDefault is 10 seconds\n\n"],
            ['c', '',  0,     ": sort lines by CPS\n"],
            ['s', '',  0,     ": sort lines by total bytes transferred\n"],
            ['t', '',  1,     ": sort lines by time of last packet detected\n\tToggled by corresponding key\n\tDefault is 't'\n\n"],
           );
# Default values
my %cfg = makeCfg(\@opts);

getopts(makeOpts(\@opts), \%cfg);

foreach my $key ('t', 'c', 's')
	{
	if ($cfg{$key})
		{
		$cfg{'sort'} = $key;
		last;
		};
	};

$usage .= makeUsage(\@opts)." (opts line is ".makeOpts(\@opts).")\n";

# print usage if requested
if ($cfg{'h'})
	{
	print STDERR $usage;
	exit 0;
	};

# List all the interface if requested
if ($cfg{'l'})
	{
	my $err     = undef;
	my %devinfo = ();
	my @devs = Net::Pcap::findalldevs(\$err, \%devinfo);
	
	if (defined($err))
		{ die $err; };
	
	for my $dev (@devs)
		{ print "$dev : ".$devinfo{$dev}."\n"; };

	exit 0;
	};

# interface(s) must be specified
if (!defined($cfg{'i'}))
	{ die $usage; };


####################################################################################
# Open all necessary interfaces
####################################################################################
my %ifaces = ();
foreach my $iface (quotewords('\s*,+\s*', 1, $cfg{'i'}))
	{
	my $err = undef;
	
	$ifaces{$iface} = openPCap($iface, !$cfg{'p'}, $cfg{'f'});

	print STDERR "Interface '".$iface."' opened\n";
	};

####################################################################################
# Run resolving thread
####################################################################################

if (!$Config{'useithreads'})
	{ die "threads required for resolving, but not supported by your perl interpreter"; };
my $resolvingThread = threads->new(\&resolvingThread, 30, 300);

####################################################################################
# Lets load Term::Screen
####################################################################################
use Term::Screen::Uni;
my $scr = Term::Screen::Uni->new();
if (!$scr) { die "Could not create Term::Screen::Uni instance!"; };

my $COLS = $scr->cols();
my $ROWS = $scr->rows();

my $LINEFORMAT = makeLineFormat($scr->cols(), $MINHOSTLEN, $PORTLEN, $PROTOLEN, $AMOUNTLEN);

#my $HEADER = sprintf($LINEFORMAT,
#                     'From Address',
#                     'Port',
#                     'To Address',
#                     'Port',
#                     'Proto',
#                     'Bytes',
#                     'CPS').('=' x $scr->cols())."";

####################################################################################
# Main loop
####################################################################################

# Flush timer
my $nextFlush = 0;

#clean the screen
print "\e[2J";

push(@opts, ['q', '']);

while (doCONTINUE())
	{
	sleep(0.1);
	my $curTime = Time::HiRes::time();

	while($scr->key_pressed())
		{
		$nextFlush = 0;
		toggleOpts(\%cfg, $scr->getch());
		};


	foreach my $iface (keys(%ifaces))
		{
		my %hdr = ();
		
	    my $pkt = Net::Pcap::next($ifaces{$iface}, \%hdr);
	    
		if (!defined($pkt))
			{ next; };
	
		fillCache($curTime, $iface, parsePkt($pkt, !$cfg{'e'}), $hdr{'len'}, $cfg{'d'});
		};

	if ($nextFlush <= $curTime)
		{
		$COLS = $scr->cols();
		$ROWS = $scr->rows();

		$LINEFORMAT = makeLineFormat($COLS, $MINHOSTLEN, $PORTLEN, $PROTOLEN, $AMOUNTLEN);
		
		$scr->at(0, 0);

		printf($LINEFORMAT,
               'From Address',
               'Port',
               'To Address',
               'Port',
               'Proto',
               'Bytes',
               'CPS');
		print STDOUT ('=' x $COLS)."";

	    my $result = flushCache($LINEFORMAT,
	                            $curTime,
	                            ($curTime - $cfg{'d'}),
	                            $cfg{'sort'},
	                            ($ROWS - $HEADHIGHT),
	                            !($cfg{'n'} || $cfg{'e'})
	                           );

	    if (scalar(@{$result}) > 0)
	    	{
			foreach my $str (@{$result})
				{ print $str->[1]; };
	    	}
	    else
	    	{
	    	print "No traffic detected";
	    	};
		

		$nextFlush = $curTime + $cfg{'r'};
		};

	my $localTime = localtime($curTime);
	printf("\e[0K\e[1E\e[0J\e[%d;%dH\e[7m%s\e[0m", $ROWS, ($COLS - length($localTime)), $localTime);
	};

if (defined($resolvingThread))
	{ $resolvingThread->join; };

$scr->normal();

exit 0;

########################################################################

sub makeOpts
	{
	my ($opts) = @_;

	my $result = '';
	foreach my $opt (@{$opts})
		{ $result .= $opt->[0].$opt->[1]; };
	return $result;
	};

sub makeCfg
	{
	my ($opts) = @_;

	my %result = ();
	foreach my $opt (@{$opts})
		{ $result{$opt->[0]} = $opt->[2]; };
	return %result;
	};

sub makeUsage
	{
	my ($opts) = @_;

	my $result = '';
	foreach my $opt (@{$opts})
		{ $result .= '-'.$opt->[0].$opt->[3]; };
	return $result;
	};

sub checkKey
	{
	foreach my $keyPat (@{$_[0]})
		{
		if ($_[1] eq $keyPat)
			{ return 1; };
		};
	return 0;
	};

sub toggleOpts
	{
	my ($cfg, $key) = @_;

	#print STDERR "got '".$key."'\n";
	
	if (checkKey(['q'], $key))
		{
		stopProgram();
		return;
		};

	if (checkKey(['e', 'n'], $key))
		{
		$cfg->{$key} = !$cfg->{$key};
		return;
		};

	if (checkKey(['c', 's', 't'], $key))
		{
		$cfg->{'sort'} = $key;
		return;
		};

	return;
	};


sub makeLineFormat
	{
	my ($columns, $minhostlen, $portlen, $protolen, $amountlen) = @_;

	my $faddrlen   = ($columns - 6*length(' ') - $protolen - 2*$amountlen - 2*$portlen);

	if ($faddrlen < ($minhostlen * 2))
		{ die "screen too small"; };
	
	my $srcaddrlen = int($faddrlen / 2) ;
	my $dstaddrlen = $faddrlen - $srcaddrlen;
	
	my $fmt =   '%'.$srcaddrlen.'.'.$srcaddrlen.'s %'.$portlen.'.'.$portlen.'s'
	          .' %'.$dstaddrlen.'.'.$dstaddrlen.'s %'.$portlen.'.'.$portlen.'s'
	          .' %'.$protolen  .'.'.$protolen  .'s'
	          .' %'.$amountlen .'.'.$amountlen .'s'
	          .' %'.$amountlen .'.'.$amountlen .'s';

	return $fmt;
	};

sub formatNum
	{
	my ($num) = @_;

	foreach my $suf ('', 'k', 'm', 'g', 't', 'p')
		{
		$num = int($num + 0.5);
		if (length($num) <= $AMOUNTLEN)
			{ return int($num + 0.5).$suf; };
		$num /= 1024;
		};
	return 'ERROR'
	};

sub ethType
	{
	if ($_[0] == NetPacket::Ethernet::ETH_TYPE_IP)        { return 'ip'; };
	if ($_[0] == NetPacket::Ethernet::ETH_TYPE_ARP)       { return 'arp'; };
	if ($_[0] == NetPacket::Ethernet::ETH_TYPE_APPLETALK) { return 'apple'; };
	if ($_[0] == NetPacket::Ethernet::ETH_TYPE_SNMP)      { return 'snmp'; };
	if ($_[0] == NetPacket::Ethernet::ETH_TYPE_IPv6)      { return 'ipv6'; };
	if ($_[0] == NetPacket::Ethernet::ETH_TYPE_PPP)       { return 'ppp'; };
	return 'ether';
	};

sub parsePkt
	{
	my ($pkt, $parseIp) = @_;

	my @result = ('','','','',0,0,0);

	my $obj = NetPacket::Ethernet->decode($pkt);
	if (!$parseIp || ($obj->{'type'} != NetPacket::Ethernet::ETH_TYPE_IP))
		{
		$result[3] = ethType($obj->{'type'});
		$result[1] = $obj->{'src_mac'};
		$result[2] = $obj->{'dest_mac'};
		$result[3] = ethType($obj->{'type'});
		return \@result;
		};
	
	$result[6] = 1;

	$result[0] = $obj->{'src_mac'};
	
	$obj = NetPacket::IP->decode($obj->{'data'});
	$result[1] = $obj->{'src_ip'};
	$result[2] = $obj->{'dest_ip'};
	$result[3] = ((getprotobynumber($obj->{'proto'}))[0]);
	
	if ($obj->{'proto'} == NetPacket::IP::IP_PROTO_UDP)
		{
		$obj = NetPacket::TCP->decode($obj->{'data'});
		$result[4] = $obj->{'src_port'};
		$result[5] = $obj->{'dest_port'};
		}
	elsif ($obj->{'proto'} == NetPacket::IP::IP_PROTO_TCP)
		{
		$obj = NetPacket::UDP->decode($obj->{'data'});
		$result[4] = $obj->{'src_port'};
		$result[5] = $obj->{'dest_port'};
		}
	elsif ($obj->{'proto'} == NetPacket::IP::IP_PROTO_ICMP)
		{
		#
		}
	else
		{
		#
		};

	return \@result;
	};

{
my %cache    = ();

sub fillCache
	{
	my ($curTime, $iface, $pkt, $size, $refresh) = @_;

	my $cell = $cache{$iface}{$pkt->[0]}{$pkt->[1]}{$pkt->[2]}{$pkt->[3]}{$pkt->[4]}{$pkt->[5]};
	if (defined($cell))
		{
		$cell->{'size'}  += $size;
		$cell->{'cps'}    = ($cell->{'cps'} * ($refresh - ($curTime - $cell->{'atime'})) + $size) / $refresh;
		$cell->{'atime'}  = $curTime;
		}
	else
		{
		$cache{$iface}{$pkt->[0]}{$pkt->[1]}{$pkt->[2]}{$pkt->[3]}{$pkt->[4]}{$pkt->[5]} = {'size'  => $size,
		                                                                                    'cps'   => $size / $refresh,
		                                                                                    'ctime' => $curTime,
		                                                                                    'atime' => $curTime,
		                                                                                    'ip'    => $pkt->[5],
		                                                                                   };
		};
	};


sub flushCache
	{
	my ($format, $curTime, $expireTime, $sortKey, $maxSize, $resolve) = @_;

	my @result = ();
	
	while (my ($iface, $macaddrs) = each(%cache))
		{
		while (my ($macaddr, $srcaddrs) = each(%{$macaddrs}))
			{
			while (my ($srcaddr, $dstaddrs) = each(%{$srcaddrs}))
				{
				while (my ($dstaddr, $protos) = each(%{$dstaddrs}))
					{
					while (my ($proto, $srcports) = each(%{$protos}))
						{
						while (my ($srcport, $dstports) = each(%{$srcports}))
							{
							while (my ($dstport, $params) = each(%{$dstports}))
								{
								my $age = $params->{'atime'} - $params->{'ctime'};

								if ($params->{'atime'} < $expireTime)
									{
									#push(@result, [-1, "\e[7m".sprintf($LINEFORMAT, $srcaddr, $srcport, $dstaddr, $dstport, $proto, formatNum($params->{'size'}), formatNum($cps))."\e[0m"]);
									delete($dstports->{$dstport});
									next;
									};
								
								if ($resolve && $params->{'ip'})
									{
									injectVal(\@result,
									          (($sortKey eq 't') ? $params->{'atime'} : (($sortKey eq 'c') ? $params->{'cps'} : $params->{'size'})),
									          sprintf($LINEFORMAT,
									                  resolveHost($curTime, $srcaddr),
									                  resolvePort($srcport, $proto),
									                  resolveHost($curTime, $dstaddr),
									                  resolvePort($dstport, $proto),
									                  $proto,
									                  formatNum($params->{'size'}),
									                  formatNum($params->{'cps'})),
									         $maxSize
									         );
									}
								else
									{
									injectVal(\@result,
									          (($sortKey eq 't') ? $params->{'atime'} : (($sortKey eq 'c') ? $params->{'cps'} : $params->{'size'})),
									          sprintf($LINEFORMAT,
									                  $srcaddr,
									                  $srcport,
									                  $dstaddr,
									                  $dstport,
									                  $proto,
									                  formatNum($params->{'size'}),
									                  formatNum($params->{'cps'})),
									         $maxSize
									         );
									};
								};

							if (!scalar(keys(%{$dstports}))) { delete($srcports->{$srcport}); };
							};
						if (!scalar(keys(%{$srcports}))) { delete($protos->{$proto}); };
						};
					if (!scalar(keys(%{$protos}))) { delete($dstaddrs->{$dstaddr}); };
					};
				if (!scalar(keys(%{$dstaddrs}))) { delete($srcaddrs->{$srcaddr}); };
				};
			if (!scalar(keys(%{$srcaddrs}))) { delete($macaddrs->{$macaddr}); };
			};
		if (!scalar(keys(%{$macaddrs}))) { delete($cache{$iface}); };
		};

	return \@result;
	};
};

sub injectVal
	{
	my ($array, $sortVal, $line, $maxSize) = @_;


	for (my $ri = 0; $ri < scalar(@{$array}); $ri++)
		{
		if ($sortVal > $array->[$ri]->[0])
			{
			splice(@{$array}, $ri, 0, [$sortVal, $line]);
			if (scalar(@{$array}) > $maxSize)
				{ splice(@{$array}, $maxSize, 1); };
			return;
			};
		};

	if (scalar(@{$array}) < $maxSize)
		{ push(@{$array}, [$sortVal, $line]); };
	};

sub openPCap
	{
	my ($iface, $promisc, $filterStr) = @_;

	my $err = undef;

	my $pcap = Net::Pcap::open_live($iface, 256, $promisc, 512, \$err);;

	if (!defined($pcap))
		{ die "Error opening interface '".$iface."': ".$err; };

	if (defined($filterStr) && length($filterStr))
		{ setFilter($pcap, $filterStr); };

	return $pcap;
	};

sub setFilter
	{
	my ($pcap, $filterStr) = @_;

	my $filter = undef;
	if (Net::Pcap::compile($pcap, \$filter, $filterStr, 1, 0) < 0)
		{ die "Filter '".$filterStr."' could not be compiled"; };

	Net::Pcap::setfilter($pcap, $filter);
	};


sub resolveHost
	{
	my ($curTime, $addr) = @_;

	lock(%cacheATime);
	$cacheATime{$addr} = $curTime;
	
	lock(%cacheNames);
	return defined($cacheNames{$addr}) ? $cacheNames{$addr} : $addr;
	};

sub resolvePort
	{
	my @serv = getservbyport($_[0], $_[1]);
	return defined($serv[0]) ? $serv[0] : $_[0];
	};

sub doCONTINUE
	{
	lock($CONTINUE);
	return ($CONTINUE);
	};

sub stopProgram
	{
	lock($CONTINUE);
	$CONTINUE = 0;
	};

sub resolvingThread
	{
	my ($minTTL, $maxTTL) = @_;

	my %cacheUTime   = ();

	while (doCONTINUE())
		{
		threads->yield();
		sleep 1;

		my $curTime = Time::HiRes::time();
		my @toResolve = ();

		{
		lock(%cacheATime);
		lock(%cacheNames);
		while (my ($addr, $atime) = each(%cacheATime))
			{
			if (($atime < ($curTime - $maxTTL)))
				{
				delete($cacheATime{$addr});
				delete($cacheUTime{$addr});
				delete($cacheNames{$addr});
				}
			elsif (!defined($cacheUTime{$addr}) ||
			       ($cacheUTime{$addr} < ($curTime- $maxTTL))
			      )
				{
				delete($cacheNames{$addr});
				push(@toResolve, $addr);
				}
			elsif (($cacheUTime{$addr} + $minTTL) < $atime)
				{
				push(@toResolve, $addr);
				};
			};
		};
		
		foreach my $addr (@toResolve)
			{
		    if (!doCONTINUE())
		    	{ last; };
			my $name  = eval { return gethostbyaddr(inet_aton($addr), AF_INET); };
			{
			lock(%cacheNames);
			$cacheNames{$addr} = $name;
			};
			$cacheUTime{$addr} = Time::HiRes::time();
			};
		};
	};

###################################################################

=head1 NAME

trafshow.pl - provides basic network traffic visualisation on text-based terminal

=head1 DESCRIPTION

script listening on the interface(s) for the network packets
and displaying info about them on the terminal

=head1 README

Print info about traffic on specified interface[s]

Usage: trafshow.pl [-hl] -i<interface[,interface[...]]> [-f<filterLine>] [-r<screenRefreshInterval>] [-d<disapperTimeout>] [-pnecst]

trafshow.pl is capturing traf on the specified interfaces
and show it on terminal in real time

-h: Print help notice, and exit
-l: List all available interfaces, and exit

-p: Do not operate in promiscuous mode
-e: Show  the  Ethernet  traffic  rather  than IP. It is possible to
        switch between them by pressing the ENTER or 'e' key.
-n: Do not resolve host and services names, toggle by 'n' key

-i<iface>[,<anotherIface>[...]: interface to listen for the traf
-f<filterLine>: traf filter line in PCap format

-r<screenRefreshInterval>: how frequently screen will be updated (in seconds)
        Default is 1
-d<disappearTimeout>: for how long inactive (no more traf) lines
        will be preserved on screen
        Default is 10 seconds

-c: sort lines by CPS
-s: sort lines by total bytes transferred
-t: sort lines by time of last packet detected
        Toggled by corresponding key
        Default is 't'


Note: this script could be easy compiled to executable using PAR.

Precompiled windows version available from http://trafshow.narod.ru/

=head1 PREREQUISITES

C<strict>,
 C<threads>,
 C<threads::shared>,
 C<Config>,
 C<Socket>,
 C<Net::Pcap 0.03>,
 C<Net::PcapUtils>,
 C<NetPacket::Ethernet>,
 C<NetPacket::IP>,
 C<NetPacket::UDP>,
 C<NetPacket::TCP>,
 C<Getopt::Std>,
 C<Text::ParseWords>,
 C<Time::HiRes>

=head1 COREQUISITES

None

=head1 OSNAMES

C<any>, tested on FreeBSD 6.0 i386, FedoraCore 4 amd64, RedHat 4 AS amd64, Windows XP Pro i386

=pod SCRIPT CATEGORIES

Networking
Win32/Utilities

=cut