File Coverage

blib/lib/Net/TcpDumpLog.pm

Criterion	Covered	Total	%
statement	82	129	63.5
branch	16	42	38.1
condition	5	21	23.8
subroutine	6	14	42.8
pod	11	12	91.6
total	120	218	55.0

#!/bin/perl -w
#
# TcpDumpLog.pm - Net::TcpDumpLog library to read tcpdump/libpcap files.
#
# 17-Oct-2003   Brendan Gregg
# 19-Oct-2003	Brendan Gregg	Added code to check endian of files.

package Net::TcpDumpLog;

use strict;
use vars qw($VERSION);

$VERSION = '0.11';

# new - create the tcpdump object.
# 	An optional argument is the number of bits this OS uses to store
#	times. Without this argument, this will use whatever the OS thinks
#	it should use. By using this argument (32/64) you can force
#	behaviour, which may be useful when transferring logs from one
#	OS to another. Why this is so important is that the actual
#	tcpdump/libpcap file format changes depending on the bits.
#
sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self = {};

	my $bits = shift;
	my $skip = shift;

	$self->{major} = undef;
	$self->{minor} = undef;
	$self->{zoneoffset} = undef;
	$self->{accuracy} = undef;
	$self->{dumplength} = undef;
	$self->{linktype} = undef;
	$self->{bigendian} = undef;
	$self->{data} = [];
	$self->{length_orig} = [];
	$self->{length_inc} = [];
	$self->{drops} = [];
	$self->{seconds} = [];
	$self->{msecs} = [];
	$self->{count} = 0;
	$self->{sizeint} = length(pack("I",0));

	if (defined $bits && $bits == 64) {
		$self->{bits} = 64;
	} elsif (defined $bits && $bits == 32) {
		$self->{bits} = 32;
	} else {
		$self->{bits} = 0;	# Use native OS bits
	}

	if (defined $skip && $skip > 0) {
		$self->{skip} = $skip;
	}

	bless($self,$class);
	return $self;
}

# read - read the tcpdump file into memory
#
sub read {
        my $self = shift;
        my $file = shift;
        my ($header,$length,$ident,$version,$linktype,$header_rec,
         $zoneoffset,$accuracy,$frame_length_inc,$frame_length_orig,
	 $frame_drops,$frame_seconds,$frame_msecs,$frame_data,
	 $pad,$major,$minor,$dumplength,$rest,$more);
        $self->{count} = 0;
        my $num = 0;

        ### Open tcpdump file
        open(TCPDUMPFILE,"$file") ||
         die "ERROR: Can't read log $file: $!\n";
	binmode(TCPDUMPFILE);		# backward OSs

        ### Fetch tcpdump header
        $length = read(TCPDUMPFILE,$header,24);
        die "ERROR: Can't read from log $file\n" if $length < 24;

        ### Check file really is a tcpdump file
	($ident,$rest) = unpack('a4a20',$header);

	if ($ident !~ /^\241\262\303\324/ &&
	    $ident !~ /^\324\303\262\241/ &&
	    $ident !~ /^\241\262\315\064/ &&
	    $ident !~ /^\064\315\262\241/){
	        die "ERROR: Not a tcpdump file (or unknown version) $file\n";
	}

	### Find out what type of tcpdump file it is
        if ($ident =~ /^\241\262\303\324/) {
		#
		#  Standard format big endian, header "a1b2c3d4"
		#  Seen from:
		#	Solaris tcpdump
		#	Solaris Ethereal "libpcap" format
		#
		$self->{style} = "standard1";
		$self->{bigendian} = 1;
        	($ident,$major,$minor,$zoneoffset,$accuracy,$dumplength,
		 $linktype) = unpack('a4nnNNNN',$header);
	}
        if ($ident =~ /^\324\303\262\241/) {
		#
		#  Standard format little endian, header "d4c3b2a1"
		#  Seen from:
		#	Windows Ethereal "libpcap" format
		#
		$self->{style} = "standard2";
		$self->{bigendian} = 0;
        	($ident,$major,$minor,$zoneoffset,$accuracy,$dumplength,
		 $linktype) = unpack('a4vvVVVV',$header);
	}
        if ($ident =~ /^\241\262\315\064/) {
		#
		#  Modified format big endian, header "a1b2cd34"
		#  Seen from:
		#	Solaris Ethereal "modified" format
		#
		$self->{style} = "modified1";
		$self->{bigendian} = 1;
        	($ident,$major,$minor,$zoneoffset,$accuracy,$dumplength,
		 $linktype) = unpack('a4nnNNNN',$header);
	}
        if ($ident =~ /^\064\315\262\241/) {
		#
		#  Modified format little endian, header "cd34a1b2"
		#  Seen from:
		#	Red Hat tcpdump
		#	Windows Ethereal "modified" format
		#
		$self->{style} = "modified2";
		$self->{bigendian} = 0;
        	($ident,$major,$minor,$zoneoffset,$accuracy,$dumplength,
		 $linktype) = unpack('a4vvVVVV',$header);
	}

        ### Store values
        $self->{version} = $version;
        $self->{major} = $major;
        $self->{minor} = $minor;
        $self->{zoneoffset} = $zoneoffset;
        $self->{accuracy} = $accuracy;
        $self->{dumplength} = $dumplength;
        $self->{linktype} = $linktype;

        #
        #  Read all packets into memory
        #
        $num = 0;
        while (1) {

		if ($self->{bits} == 64) {
			#
			#  64-bit timestamps, quads
			#

       		        ### Fetch record header
			$length = read(TCPDUMPFILE,$header_rec,24);

                	### Quit loop if at end of file
                	last if $length < 24;

			### Unpack header
                	($frame_seconds,$frame_msecs,$frame_length_inc,
			 $frame_length_orig) = unpack('QQLL',$header_rec);

		} elsif ($self->{bits} == 32) {
			#
			#  32-bit timestamps, big-endian
			#

	                ### Fetch record header
	                $length = read(TCPDUMPFILE,$header_rec,16);

	                ### Quit loop if at end of file
                	last if $length < 16;

			### Unpack header
			if ($self->{bigendian}) {
				($frame_seconds,$frame_msecs,
				 $frame_length_inc,$frame_length_orig)
				 = unpack('NNNN',$header_rec);
			} else {
				($frame_seconds,$frame_msecs,
				 $frame_length_inc,$frame_length_orig)
				 = unpack('VVVV',$header_rec);
			}

		} else {
			#
			#  Default to OS native timestamps
			#

	                ### Fetch record header
	                $length = read(TCPDUMPFILE,$header_rec,
			 ($self->{sizeint} * 2 + 8) );

	                ### Quit loop if at end of file
                	last if $length < ($self->{sizeint} * 2 + 8);

			### Unpack header
			if ($self->{sizeint} == 4) {	# 32-bit
				if ($self->{bigendian}) {
					($frame_seconds,$frame_msecs,
					 $frame_length_inc,$frame_length_orig)
					 = unpack('NNNN',$header_rec);
				} else {
					($frame_seconds,$frame_msecs,
					 $frame_length_inc,$frame_length_orig)
					 = unpack('VVVV',$header_rec);
				}
			} else {			# 64-bit?
				if ($self->{bigendian}) {
					($frame_seconds,$frame_msecs,
					 $frame_length_inc,$frame_length_orig)
					 = unpack('IINN',$header_rec);
				} else {
					($frame_seconds,$frame_msecs,
					 $frame_length_inc,$frame_length_orig)
					 = unpack('IIVV',$header_rec);
				}
			}

		}

		### Fetch extra info if in modified format
		if ($self->{style} =~ /^modified/) {
			$length = read(TCPDUMPFILE,$more,8);
		}

		### Check for skip bytes
		if (defined $self->{skip}) {
			$length = read(TCPDUMPFILE,$more,$self->{skip});
		}

		### Fetch the data
		$length = read(TCPDUMPFILE,$frame_data,$frame_length_inc);

		$frame_drops = $frame_length_orig - $frame_length_inc;

                ### Store values in memory
                $self->{data}[$num] = $frame_data;
                $self->{length_orig}[$num] = $frame_length_orig;
                $self->{length_inc}[$num] = $frame_length_inc;
                $self->{drops}[$num] = $frame_drops;
                $self->{seconds}[$num] = $frame_seconds;
                $self->{msecs}[$num] = $frame_msecs;
                $self->{count}++;
                $num++;
        }

        close TCPDUMPFILE;
}

# indexes - return a list of index numbers for the packets.
#               indexes start at "0"
#
sub indexes {
        my $self = shift;
        my $max = $self->{count} - 1;
        return (0..$max);
}

# maxindex - return the index number for the last packet.
#               indexes start at "0"
#
sub maxindex {
        my $self = shift;
        my $max = $self->{count} - 1;
        return $max;
}

# header - return header data for a given index
#
sub header {
        my $self = shift;
        my $num = shift;
        return ($self->{length_orig}[$num],
                $self->{length_inc}[$num],
                $self->{drops}[$num],
                $self->{seconds}[$num],
                $self->{msecs}[$num]);
}

# data - return packet data for a given index
#
sub data {
        my $self = shift;
        my $num = shift;
        return $self->{data}[$num];
}

# version - return log file version
#
sub version {
        my $self = shift;
        return sprintf("%u.%u",$self->{major},$self->{minor});
}

# linktype - return linktype
#
sub linktype {
	my $self = shift;
	return sprintf("%u",$self->{linktype});
}

# zoneoffset - return zoneoffset
#
sub zoneoffset {
	my $self = shift;
	return sprintf("%u",$self->{zoneoffset});
}

# accuracy - return accuracy
#
sub accuracy {
	my $self = shift;
	return sprintf("%u",$self->{accuracy});
}

# dumplength - return dumplength
#
sub dumplength {
	my $self = shift;
	return sprintf("%u",$self->{dumplength});
}

# clear - clear tcpdump file from memory
#
sub clear {
        my $self = shift;
        delete $self->{data};
        $self
}


1;
__END__