split-pcap.pl - A Perl script to separate the TCP flows in a pcap file

 
#!/usr/bin/perl
#
# split-pcap.pl
#
# version 1.0 2015-01-25
# version 1.1 2015-02-07 added sll frame type processing
# version 1.2 2016-03-03 added evlan frame type for an Ethernet frame with VLAN tags
#
# Usage:
#    perl split-pcap.pl TYPE PCAP-FILE
#
# This script will read the PCAP-FILE and for each Ethernet (TYPE == ether)
# SLL (TYPE = sll), or Ethernet with VLAN tags (type == evlan) frame containing
# an IP/TCP packet will write a file named PCAP-FILE-IPx:TCP_PORTx-IPy:TCP_PORTy.pcap.
# The IPx:TCP_PORTx:IPy:TCP_PORTy is ordered based on the lowest TCP PORT value so
# TCP_PORTx < TCP_PORTy. Files are written in the same directory as PCAP-FILE. Status
# information is written as the PCAP-FILE is read but the percentage complete value
# is approximate.
#
# Known limitations
# 1. The split into spearate file is based on the 4 tuple
#    
#    if port numbers are resued packets from all streams will be combined
#    in the one file.
# 2. As a 4-tuple is recognized a new file is opened to write the
#    corresponding packets. It is possible that the number of file descriptors
#    can be exceeded and no new files can be created. This state is flagged
#    and a count kept of 4-tuples not written. In addition a "missed" file
#    is created listing the 4-tuples
# 3. The 4-tuple is managed with a hash, it is possible that there are so
#    many 4-tuples that the ablity to write to the hash is execeeded.
#
# Testing
# This script has been tested only on Red Hat Enterprise Linux 6x
#
use Net::Pcap;
use strict;
use warnings;

my $type;
my $length;
my $header;
my $size;
my $bytes = 0;
my %fourTuple;
my $fourTupleKey;
my $fourTupleSavedCount = 0;
my $fourTupleNotSavedCount = 0;
my $okToOpen = 1;
my $dumpFile;

if ($#ARGV lt 1)  {
    print "Usage: pcap.pl [ether | sll | evlan] \n";
    exit;
}
if ($#ARGV gt 1 ) {
    print "Usage: pcap.pl [ether | sll | evlan] \n";
    exit;
}

open(INFILE, $ARGV[1]) || die "Can't open $ARGV[1]. $!\n";
$length = read(INFILE,$header,8);
die "Can't read from " . $ARGV[1] . ", $length < 8\n" if $length < 8;
$size = -s $ARGV[1];
close(INFILE);

$type = $ARGV[0];

my ($pcap, $err);
$pcap = Net::Pcap::open_offline ($ARGV[1], \$err) || die "Could not open file " . $ARGV[1] . ". $!";

Net::Pcap::loop ($pcap, -1, \&processPacket, 0);


foreach (sort keys %fourTuple) {
    if ($fourTuple{$_} >0) {
     Net::Pcap::pcap_dump_close ($fourTuple{$_});
    }
  }

open (OUTFILE, ">", $ARGV[1] . "-missed-4-tuples") or die $!;
foreach (sort keys %fourTuple) {
    if ($fourTuple{$_} == -1) {
     print OUTFILE "$_\n";
    }
  }
close (OUTFILE);

sub processPacket {
    my($user_data, $hdr, $pkt) = @_;

    my($etherTypeLoc) = 12;     # start of the Protocol Type for Ethernet frame
    my($sllTypeLoc) = 14;       # start of the Protocol Type for SLL (Linux cooked) frame
    my($etherVlanTypeLoc) = 18;      # start of the Protocol Type for an Ethernet Frame with a VLAN tag
    my($typeOffset);
    my($protoType);
    my($ipHeaderLen);
    my($ipProto);
    my($ipSrcAddr);
    my($ipDstAddr);
    my($tcpSrcPort);
    my($tcpDstPort);
    my($dumpFileName);

    if ($type eq "ether") {
       $typeOffset = 12;
    } elsif ($type eq "sll") {
       $typeOffset = 14;
    } else {
       $typeOffset = 16;
    }

    $protoType = ord (substr($pkt, $typeOffset, 1)) * 256 +
            ord (substr($pkt, $typeOffset+1, 1));

    if ($protoType == 0x0800) {   # Frame type is IP
       $ipHeaderLen = (ord (substr($pkt, $typeOffset+2, 1)) & 0x0F) * 4;
       $ipProto = ord ( substr($pkt, $typeOffset+11, 1));
       if ($ipProto == 6) {   # frame type is TCP
          $ipSrcAddr = sprintf("%d.%d.%d.%d",
             ord( substr($pkt, $typeOffset+14, 1) ),
             ord( substr($pkt, $typeOffset+15, 1) ),
             ord( substr($pkt, $typeOffset+16, 1) ),
             ord( substr($pkt, $typeOffset+17, 1) ));
          $ipDstAddr = sprintf("%d.%d.%d.%d",
             ord( substr($pkt, $typeOffset+18, 1) ),
             ord( substr($pkt, $typeOffset+19, 1) ),
             ord( substr($pkt, $typeOffset+20, 1) ),
             ord( substr($pkt, $typeOffset+21, 1) ));
          $tcpSrcPort = ord (substr($pkt,
                             $typeOffset+2+$ipHeaderLen, 1)) * 256 +
                        ord (substr($pkt, $typeOffset+2+$ipHeaderLen+1, 1));
          $tcpDstPort = ord (substr($pkt,
                             $typeOffset+2+$ipHeaderLen+2, 1)) * 256 +
                        ord (substr($pkt, $typeOffset+2+$ipHeaderLen+3, 1));

          if ($tcpSrcPort < $tcpDstPort) {
             $fourTupleKey = $ipSrcAddr . ":" . $tcpSrcPort . "-" .
                             $ipDstAddr . ":" . $tcpDstPort;
          } else {
             $fourTupleKey = $ipDstAddr . ":" . $tcpDstPort . "-" .
                             $ipSrcAddr . ":" . $tcpSrcPort;
          }

          if ($fourTuple{$fourTupleKey}) {   # file for 4 tuple already open ?
             $dumpFile = $fourTuple{$fourTupleKey};
             if ($dumpFile > 0) {
                Net::Pcap::pcap_dump ($dumpFile, $hdr, $pkt);
             }
          } else {   # else file for 4 tuple already open ?
            if ($okToOpen) { # we haven't had an open error yet
               $dumpFileName = $ARGV[1] . "-" . $fourTupleKey . ".pcap";
               $dumpFile = Net::Pcap::pcap_dump_open ($pcap, $dumpFileName);
               if ($dumpFile) { # did we opened a new dump file
                  $fourTuple{$fourTupleKey} = $dumpFile;
                  Net::Pcap::pcap_dump ($fourTuple{$fourTupleKey}, $hdr, $pkt);
                  $fourTupleSavedCount++;
               } else {   # else did we opened a new dump file
                 print "Could not open outfile file for 4 tuple " . $fourTupleKey .
                       ". $!\n";
                 print "Countinuing to process.\n";
                 $okToOpen = 0;
                 $fourTupleNotSavedCount = 1;
                 $fourTuple{$fourTupleKey} = -1;
               }   # end else did we opened a new dump file
            } else {   # else we haven't had an open error yet
                   $fourTupleNotSavedCount++;
                   $fourTuple{$fourTupleKey} = -1;
            }   # end else we haven't had an open error yet
          }   # end else file for 4 tuple already open ?
       }   # end Frame type is TCP
    }   # end Frame type is IP

    $bytes += (length ($hdr) + length ($pkt));
    if ($okToOpen) {
       printf("%s %2.0f%% (%d/%d) 4-tuple Saved/No Saved count is %d/%d\n",
          "                  ", (100*$bytes/$size), $bytes, $size,
          $fourTupleSavedCount, $fourTupleNotSavedCount);
    } else {
       printf("%s %2.0f%% (%d/%d) 4-tuple Saved/No Saved count is %d/%d\n",
          "File limit reached", (100*$bytes/$size), $bytes, $size,
          $fourTupleSavedCount, $fourTupleNotSavedCount);
    }
}