Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/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__

In reply to Packet Capture IP Accounting by rob_au

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others studying the Monastery: (13)
    As of 2014-12-18 21:52 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Is guessing a good strategy for surviving in the IT business?





      Results (66 votes), past polls