#!/usr/bin/perl -w

use strict;

#use Net::Gen;			# optional
#use Net::Inet;
use Socket;
use Net::Pcap;
#use Data::HexDump;

my $err = '';
my $dev;
#my $dev = Net::Pcap::lookupdev(\$err);  # find a device
$dev = "vr0";
$dev or die "Net::Pcap::lookupdev failed.  Error war $err";
#print "lookupdev: $dev\n";

# open the device for live listening
my $pcap = Net::Pcap::open_live($dev, 1500, 0, 0, \$err);
die $err if not defined($pcap);

# Determine the network number and netmask
my ($net, $mask);
if (Net::Pcap::lookupnet($dev, \$net, \$mask, \$err) == -1)
{
    die "Net::Pcap::lookupnet failed.  Error was $err";
}

# compile the filter string
my $ip_src = "any";
my $ip_dst = "any";
my $srv = "80";
my $filter = 'ether proto \ip and ip proto \tcp';
$filter .= " and (";
$filter .= "(".join(" and ", map { $_ or (); }
		    ($ip_src ne "any" && "src_host $ip_src" || undef,
		     $ip_dst ne "any" && "dst host $ip_dst" || undef,
		     "dst port $srv" )).")";
$filter .= " or ";
$filter .= "(".join(" and ", map { $_ or (); }
		    ($ip_dst ne "any" && "src host $ip_dst" || undef,
		     $ip_src ne "any" && "dst host $ip_src" || undef,
		     "src port $srv" )).")";
$filter .= ")";
#$filter = "port 80";
print "$filter\n";
my $filter_t;
if (Net::Pcap::compile($pcap, \$filter_t, $filter, 0, $net) == -1)
{
    die "Unable to compile filter string '$filter'\n";
}

# Associate the compiled filter
Net::Pcap::setfilter($pcap, $filter_t);

# loop over next 10 packets
Net::Pcap::loop($pcap, -1, \&process_packet, {});

# close the device
Net::Pcap::close($pcap);

sub ntohs($)
{
    return unpack("n", pack("S", $_[0]));
}

sub process_packet {
    my ($user_data, $header, $packet) = @_;
    # do something
    my ($v_ihl, $ip_length, $protocol, $src_ip, $dst_ip) = unpack "x14axSx5Cx2a4a4", $packet;
    $src_ip = inet_ntoa($src_ip);
    $dst_ip = inet_ntoa($dst_ip);
    my $version = vec $v_ihl, 1, 4;
    my $ihl = vec $v_ihl, 0, 4;
    $ip_length = ntohs($ip_length);
    my $skip = 14 + 4 * $ihl;
    print "len $header->{len} caplen $header->{caplen} ";
    print "ppkt src $src_ip dst $dst_ip ";
    print "version $version ihl $ihl protocol $protocol ip_length $ip_length skip $skip\n";
    my $data = unpack "x[".($skip)."]a*", $packet;
    &tcp_packet($src_ip, $dst_ip, $data, $user_data) if ($version == 4 && $protocol == 6);
    &udp_packet($src_ip, $dst_ip, $data, $user_data) if ($version == 4 && $protocol == 17);
}

sub tcp_packet($$$$)
{
    my ($src_ip, $dst_ip, $packet, $user_data) = @_;

    my ($src_port, $dst_port, $info) = unpack "SSx8a", $packet;
    $src_port = ntohs($src_port);
    $dst_port = ntohs($dst_port);
    my $offset = vec $info, 1, 4;
    my $skip = $offset * 4;
    my $data = unpack "x[".($skip)."]a*", $packet;
    print "len ".(length $packet)." src_port $src_port dst_port $dst_port offset $offset skip $skip\n";
#    print $data;
    print "\e[32m" if ($src_ip eq $ip_src || $dst_port eq $srv);
    print "\e[31m" if ($dst_ip eq $ip_src || $src_port eq $srv);
    HexStr($data, \$user_data->{$src_ip});
    print "\e[0m";
}

sub udp_packet($$$)
{
    my ($src_ip, $dst_ip, $packet, $user_data) = @_;

    my ($src_port, $dst_port) = unpack "SS", $packet;
    $src_port = ntohs($src_port);
    $dst_port = ntohs($dst_port);
    my $skip = 8;
    my $data = unpack "x[".($skip)."]a*", $packet;
    print "len ".(length $packet)." src_port $src_port dst_port $dst_port skip $skip\n";
#    print $data;
    print "\e[32m" if ($src_ip eq $ip_src || $dst_port eq $srv);
    print "\e[31m" if ($dst_ip eq $ip_src || $src_port eq $srv);
    HexStr($data, \$user_data->{$src_ip});
    print "\e[0m";
}

sub HexStr($$)
{
    my @data = split //, shift;
    my $offset = shift;
    $$offset ||= 0;

    my @tab;
    do 
    {
	@tab = splice @data, 0, 16;
	if (scalar @tab)
	{
	    my @hex;
	    my $str;
	    foreach (@tab)
	    {
		push @hex, unpack("H2", $_);
		if (ord $_ < 32)
		{
		    $str .= ".";
		}
		else
		{
		    $str .= $_;
		}
	    }
	    do { push @hex, "  " } for($#hex .. 14);
	    printf "%08x  %s  |%s|\n", $$offset, join(' ', @hex), $str;
	    $$offset += length $str;
	}
    }
    while (scalar @tab);
}