#!/usr/bin/perl -Tw

use AppConfig;
use Carp;
use DBI;
use Net::Pcap;
use NetPacket::Ethernet;
use NetPacket::IP qw/ :protos /;
use NetPacket::TCP;
use NetPacket::UDP;

use strict;
use vars qw/ $CONFIG $VERSION /;


BEGIN {
    $CONFIG = AppConfig->new({
        'CASE'              =>  0,
        'GLOBAL'            =>  { 'ARGCOUNT' => 1 }
    },
        'configuration|c'   =>  { 'DEFAULT' => undef },
        'database|d'        =>  { 'DEFAULT' => 'DBI:mysql:database=dev
+elopment;host=localhost' },
        'filter|f'          =>  { 'DEFAULT' => 'none' },
        'interface|i'       =>  {
            'DEFAULT'           =>  eval {
                my $err;
                my $dev = Net::Pcap::lookupdev( \$err );
                if ( defined $err ) {
                    croak( 'Cannot determine network interface for pac
+ket capture - ', $err );
                }
                $dev;
            }
        },
        'mtu|m'             =>  { 'DEFAULT' => 1500 },
        'password'          =>  { 'DEFAULT' => undef },
        'table|t'           =>  { 'DEFAULT' => 'ipacct' },
        'username'          =>  { 'DEFAULT' => undef }
    );
    $CONFIG->args;
    if ( defined $CONFIG->get('configuration') ) {

        #   If the configuration file parameter is defined on the comm
+and line via
        #   the -c switch, attempt to load the specified configuration
+ file

        if ( $CONFIG->file( $CONFIG->get('configuration') ) ) {
            croak( 'Cannot open configuration file ', $CONFIG->get('co
+nfiguration'), ' - ', $! );
        } 

    }

    $VERSION = '0.3';
}


#   Create database handle for storage of captured packet information 
+in data
#   store for accounting and audit analysis

my $dbh;
unless ( $dbh = DBI->connect(
    $CONFIG->get('database'),
    $CONFIG->get('username'),
    $CONFIG->get('password'),
    { 'RaiseError' => 1 }
) ) {
    croak( 'Cannot connect to storage database - ', $! );
}


#   The $err variable is passed as a reference to libpcap library meth
+ods for
#   returning error messages from this library.

my $err;


#   The lookupnet method of the libpcap library is used to validate th
+e device 
#   argument specified for packet sniffing and capture.  This method a
+lso
#   returns the interface address and network mask for the device spec
+ified,
#   the latter of which is required for the compilation of a packet fi
+lter
#   should such a filter be specified.

my ( $address, $netmask );
if ( Net::Pcap::lookupnet( $CONFIG->get('interface'), \$address, \$net
+mask, \$err ) ) {
    croak( 'Unable to look up device information for ', $CONFIG->get('
+interface'), ' - ', $err );
}


#   The open_live method of the libpcap library will open the device $
+dev for
#   packet sniffing and capture.  The second argument passed to this m
+ethod
#   is intended to be the maximum number of bytes to capture from each
+ packet 
#   for which the maximal transmission unit for the interface is recom
+mended.
#   As this parameter cannot be reliably determined programmatically i
+n a 
#   portable fashion, this value can be specified in the configuration
+ file
#   via the 'mtu' configuration parameter.
#
#   Furthermore, this packet capture method will set the device in pro
+miscuous
#   mode for continuous packet capture.

my $pcap;
$pcap = Net::Pcap::open_live( $CONFIG->get('interface'), $CONFIG->get(
+'mtu'), 1, -1, \$err );
unless ( defined $pcap ) {
    croak( 'Unable to open device for packet capture - ', $err );
}


#   If the filter configuration parameter is set to anything other tha
+n 
#   'none', the default value for this parameter, then this parameter 
+is used
#   to build a filter for the packet sniffing and capture interface.
#
#   This is particularly useful if the storage database resides on ano
+ther 
#   host so that the network traffic generated from data storage is no
+t also
#   logged.

if ( $CONFIG->get('filter') ne 'none' ) {

    my $compile;
    if ( Net::Pcap::compile( $pcap, \$compile, $CONFIG->get('filter'),
+ 0, $netmask ) ) {
        croak( 'Unable to compile packet capture filter' );
    }
    if ( Net::Pcap::setfilter( $pcap, $compile ) ) {
        croak( 'Unable to set compiled packet capture filter on packet
+ capture device' );
    }

}


#   Initiate packet capture on the specified network device - All capt
+ured 
#   packets are passed to the &capture subroutine where packet decodin
+g and 
#   recording of pertinent traffic information to the accounting datab
+ase is
#   carried out.
#
#   The database handle is passed as the user data argument to the pac
+ket 
#   capture processing subroutine - This alleviates the requirement fo
+r a 
#   globally scoped database statement handle for the storage of captu
+red 
#   packet information.

unless ( Net::Pcap::loop( $pcap, -1, \&capture, $dbh ) ) {
    croak( 'Unable to initiate packet capture for device ', $CONFIG->g
+et('interface') );
}

Net::Pcap::close( $pcap );


sub capture {
    my ( $dbh, $header, $packet ) = @_;

    #   Strip ethernet encapsulation of captured network packet

    my $ether = NetPacket::Ethernet->decode( $packet );

    #   Decode contents of IP packet contained within stripped etherne
+t packet
    #   and decode the packet data contents if the encapsulated packet
+ is 
    #   either TCP or UDP

    my $proto;
    my $ip = NetPacket::IP->decode( $ether->{'data'} );
    if ( $ip->{proto} == IP_PROTO_TCP ) {

        $proto = NetPacket::TCP->decode( $ip->{'data'} );

    } elsif ( $ip->{proto} == IP_PROTO_UDP ) {

        $proto = NetPacket::UDP->decode( $ip->{'data'} );

    } else {
        
        #   Unsupported network packet protocol - Currently, only TCP 
+and UDP packets
        #   are decoded with all other packet types silently dropped b
+y this 
        #   accounting process.

    }

    #   If the network packet encapsulated within the ethernet frame h
+as been
    #   successfully recognised and decoded, insert relevant informati
+on with
    #   respect to source, destination and packet length into storage 
+database.

    if ( defined $proto ) {

        #   Insert the source, destination and packet length informati
+on into storage
        #   database - Note that $proto->{'flags'} is not defined for 
+NetPacket::UDP
        #   objects and in place the invalid flag value of -1 is inser
+ted.
        #   
        #   The database table structure is as follows:
        #   
        #       CREATE TABLE ipacct (
        #         src_ip varchar(16) NOT NULL default '0.0.0.0',
        #         src_port smallint(5) unsigned NOT NULL default '0',
        #         src_mac tinytext NOT NULL,
        #         dest_ip varchar(16) NOT NULL default '0.0.0.0',
        #         dest_port smallint(5) unsigned NOT NULL default '0',
        #         dest_mac tinytext NOT NULL,
        #         protocol tinyint(4) NOT NULL default '-1',
        #         length smallint(6) NOT NULL default '-1',
        #         flags tinyint(4) NOT NULL default '-1',
        #         timestamp timestamp(14) NOT NULL
        #       ) TYPE=MyISAM;
        #

        $dbh->do(qq/
            INSERT INTO / . $CONFIG->get('table') . qq/
                        (
                            src_ip,
                            src_port,
                            src_mac,
                            dest_ip,
                            dest_port,
                            dest_mac,
                            protocol,
                            length,
                            flags
                        )
                VALUES
                        ( ?, ?, ?, ?, ?, ?, ?, ?, ? )
        /,
            undef,
            $ip->{'src_ip'},
            $proto->{'src_port'},
            $ether->{'src_mac'},
            $ip->{'dest_ip'},
            $proto->{'dest_port'},
            $ether->{'dest_mac'},
            $ip->{'proto'},
            $ip->{'len'},
            ( exists $proto->{'flags'} ) ? $proto->{'flags'} : -1
        );

    }
}


__END__
[download]