#!/usr/bin/perl

# pcaputil - list contents and carve streams from pcap files

# Copyright 2009 Lou Arminio (lou <dot> arminio <at> gmail <dot> com)

#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.

use strict;
use Getopt::Long;
use Pod::Usage;

use Net::Pcap;
use NetPacket::Ethernet;
use NetPacket::Ethernet qw(:strip);
use NetPacket::IP;
use NetPacket::IP qw(:strip);
use NetPacket::TCP;
use NetPacket::TCP qw(:strip);

# Vars for processing

my $err;
my @Range;
my $range_digits = 0;
my $index_filter = 'tcp[13] & 0x3f = 0x02';  #Default to finding tcp syn pkts
my %CACHE; # used to cache dns lookups

# Vars for input options

my $verbose = 0;
my $pcap_in = "";
my $file_out = "";
my $dir = "./";
my $dump_range = "";
my $lookup = 0;
my $help = 0;


Getopt::Long::Configure ('no_ignore_case');

GetOptions ("verbose|v" => \$verbose,
            "read|r=s" => \$pcap_in,
            "prefix|p=s" => \$file_out,
            "dir|D=s" => \$dir,
            "dump|d=s" => \$dump_range,
            "lookup|l" => \$lookup,
            "help|h" => \$help) or shorthelp(2);

if ($help) {
    pod2usage(-verbose => 2);
}

# Check inputs

if ($dir) {
    if (! -d $dir) {
        print "\nCreating directory \"$dir\" for output\n";
        mkdir ($dir) or die "Can't create directory $dir: $!\n";
    }
    else {
        print "\nUsing directory $dir for output\n";
    }
     # Make sure $dir is terminated with path separator
    $dir =~ /(\/|\\)$/ or $dir .= '/';
}

if ($file_out) {
    $file_out =~ /^[a-zA-Z0-9-_:\.]+$/ or
        die "Only 'a-zA-Z0-9-_:.' characters allowed in prefix\n";
}

if ($dump_range) {
    $dump_range =~ /^[0-9\-,]+$/ or
        die "Only digits, '-' and ',' allowed in dump range\n";
}

if (! $pcap_in) {
    shorthelp(1);
}

if (! -r $pcap_in) {
    print "File does not exist: $pcap_in\n";
    exit 1;
}

if ($dump_range) {
    # split range into a list
    @Range = split_range($dump_range);

    $range_digits = index_digits($Range[(scalar @Range) -1]);
    if ($range_digits < 2) { $range_digits = 2; } 

    for my $i (@Range) {
        dump_stream($pcap_in, $i);
    }
}
else {
    # List index of pcap file
    print_index($pcap_in, $index_filter, $verbose);
}

exit;

# Subroutines

# print_index - print index of tcp streams
sub print_index {
    my ($pcap_file, $filter, $verbose) = @_;
    my $pcap;
    my $filter_c;
    my $packet;
    my $index = 1;
    my $eth;
    my $ip;
    my $tcp;
    my %header;
    my $time0 = 0;

    $pcap = pcap_open($pcap_file);

    Net::Pcap::compile ($pcap, \$filter_c, $filter, 1, undef);
    Net::Pcap::setfilter ($pcap, $filter_c);

    while (1) {
        $packet = Net::Pcap::next ($pcap, \%header) or last;

        $eth = NetPacket::Ethernet->decode($packet);
        $ip = NetPacket::IP->decode($eth->{'data'});
        $tcp = NetPacket::TCP->decode($ip->{'data'});

        if ($verbose && $time0 == 0) {
            # Track time
            $time0 = $header{'tv_sec'};
        }

        if ($index == 1) {
            # Print out some headers
            print "\nPcap Index: $pcap_file\n";
            print 'Capture Start Time: ' . gmtime($time0) . 
                " GMT \n" if ($verbose);
            print 'INDEX ';
            print '(SRC MAC ADDR)' if ($verbose);
            print '         SOURCE.PORT     ';
            print '(DST MAC ADDR)' if ($verbose);
            print '    DESTINATION.PORT ';
            print 'TIMEVALUE' if ($verbose);
#            print ' PKTLEN/CAPTURELEN' if ($verbose);
            print "\n";
        }
        my $src_name = 
            ($lookup) ? reverse_dns($ip->{'src_ip'}) : $ip->{'src_ip'};
        my $dest_name = 
            ($lookup) ? reverse_dns($ip->{'dest_ip'}) : $ip->{'dest_ip'};
        my $src_svc = 
            ($lookup) ? reverse_svc($tcp->{'src_port'}, 'tcp') : $tcp->{'src_port'};
        my $dest_svc = 
            ($lookup) ? reverse_svc($tcp->{'dest_port'}, 'tcp') : $tcp->{'dest_port'};

        printf ("[%3d] ", $index);
        print '(' . $eth->{'src_mac'} . ')' if ($verbose);
        printf ("%15s.%-5s -> ", $src_name, $src_svc);
        print '(' . $eth->{'dest_mac'} . ')' if ($verbose);
        printf ("%15s.%-5s", $dest_name, $dest_svc);
        printf (" %d.%d", $header{'tv_sec'}-$time0, $header{'tv_usec'}) 
                                                                 if ($verbose);
#        printf (" %d/%d", $header{'len'}, $header{'caplen'}) if ($verbose);
        print "\n";

        $index++;
    }
}

# split_range - take a range of packets (single digit, comma sep, x-y range
# and break into list

sub split_range {
    my ($range) = @_;
    my $index;
    my $index2;
    my %Range;  # Hash being used to track indexes to ensure uniqueness

    while ($range) {
        $range =~ /^(\d+)(.*)/ and do {
            $index = $1; # save index before pushing to list
            $Range{$index}=1;
            $range = $2;
            next;
        };
        $range =~ /^,(.*)/ and do {
            $range = $1;
            next;
        };
        $range =~ /^-(\d+)(.*)/ and do {
            $index2 = $1;
            $range = $2;
            $index++; # $index already on the stack
            for (my $i=$index; $i<=$index2; $i++) {
                $Range{$i}=1;
            }
            next;
        };
    }
    return (sort keys %Range);
}

sub dump_stream {
    my ($pcap_file, $index) = @_;
    my $format;
    my $path_out;
    my $DATA; 
    my $pcap;
    my $filter;
    my $filter_c;
    my %header;
    my $packet;
    my $ip;
    my $tcp;
    my $i;

    $pcap = pcap_open($pcap_file);

    # Find stream with provided index

    $filter = 'tcp[13] & 0x3f = 0x02'; # Search for tcp syn packets

    Net::Pcap::compile ($pcap, \$filter_c, $filter, 1, undef);
    Net::Pcap::setfilter ($pcap, $filter_c);

    for ($i=0; $i<$index; $i++) {
        $packet = Net::Pcap::next ($pcap, \%header) or last;
    }

    if (! $packet) {
        # Didn't find $index stream in pcap file
        die "No index $index in $pcap_file\n";
    }

    # Found the stream

    $ip = NetPacket::IP->decode(NetPacket::Ethernet->decode($packet)->{'data'});
    $tcp = NetPacket::TCP->decode($ip->{'data'});

    # Determine output filename and Open output file

    if (! $file_out) {
        # Build filename based on stream data
        $path_out = $ip->{src_ip} . '.' . $tcp->{'src_port'} . '-' .
           $ip->{'dest_ip'} . '.' . $tcp->{'dest_port'}; 
    }
    else {
        $path_out = $file_out;
    }
    if ((scalar @Range) > 1) {
        # prepend filename with index number - index padded with 0's 
        $format = sprintf ('%%s%%s-%%0%dd', $range_digits);
        $path_out = sprintf ($format, $dir, $path_out, $index);
    }
    else {
        $path_out = $dir . $path_out;
   }

    open($DATA, ">$path_out") or die "Can't open output file $path_out: $!\n";
    binmode($DATA);

    $filter = 'tcp and (host ' . $ip->{'src_ip'} . ' and host ' .
        $ip->{'dest_ip'} . ') and (port ' . $tcp->{'dest_port'} . 
        ' and port ' . $tcp->{'src_port'} . ')';

    Net::Pcap::compile ($pcap, \$filter_c, $filter, 1, undef);
    Net::Pcap::setfilter ($pcap, $filter_c);

    Net::Pcap::loop ($pcap, -1, \&dump_data, $DATA);

    close($DATA);
    pcap_close($pcap);
}

sub dump_data {
    my ($DATA, $header, $pkt) = @_;
    my $ip;
    my $tcp;

    $ip = NetPacket::IP->decode(NetPacket::Ethernet->decode($pkt)->{'data'});
    $tcp = NetPacket::TCP->decode($ip->{'data'});

    print $DATA $tcp->{'data'};

    return(1);
}

sub pcap_open {
    my ($pcap_file) = @_;
    my $err;
    my $pcap;

    $pcap = Net::Pcap::open_offline ($pcap_file, \$err) or 
        die "Can't open pcap file $pcap_file: $err\n"; 

    return($pcap);
}

sub pcap_close {
    my ($pcap) = @_;

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

sub index_digits {
    my ($max_index) = @_;
    my $digits = 1;

    for (my $i=$max_index; $i>=10; $i /= 10){$digits++;};

    return($digits);
}

sub reverse_dns {
    my ($ip) = @_;
    my @host;

    return $ip unless $ip=~/\d+\.\d+\.\d+\.\d+/;
    unless (exists $CACHE{$ip}) {
        eval {
            local $SIG{ALRM} = sub { die "alarm\n" };
            alarm (2);
            @host = gethostbyaddr(pack('C4',split('\.',$ip)),2);
            alarm 0;
        };
        if ($@) {
            die unless $@ eq "alarm\n";   # propagate unexpected errors
            # timed out
            return("timeout");
        }
        else {
            # didn't
            $CACHE{$ip} = $host[0] || undef;
        }
    }
    return $CACHE{$ip} || $ip;
}

sub reverse_svc {
    my ($port, $proto) = @_;

    my @svc = getservbyport($port, $proto);

    if (@svc) {
        return($svc[0]);
    }
    else {
        return($port);
    }
}

sub shorthelp {
    my ($exit) = @_;

    print "Usage: pcaputil --read|-r <pcap_file> [--lookup|-l]\n";
    print "       pcaputil --read|-r <pcap_file> --dump|-d <dump_range> ";
    print "[--prefix|-p <file_prefix> --dir|-D <dir_out>]\n";
    print "       pcaputil --help|-h\n";

    exit($exit);
}

0;

__END__

=pod

=head1 NAME

B<pcaputil> - list contents of and extract TCP streams from pcap files.

=head1 SYNOPSIS 

B<pcaputil> -r|--read PCAPFILE [-v|--verbose] [-l|--lookup]

B<pcaputil> -r|--read PCAPFILE -d|--dump DUMP_RANGE [-p|--prefix FILE_PREFIX] [-D|--dir STREAM_DIRECTORY] 

B<pcaputil> -h|--help 

=head1 DESCRIPTION

B<pcaputil> reads packet capture (pcap) files and by with no options lists 
the streams contained within the file.  Source and destination IP addresses
and ports are displayed by default.  Several options enhance the default 
output.  B<pcaputil> will optionally extract TCP streams from the pcap file.

=head1 OPTIONS

=over 8

=item B<-r|--read PCAPSTREAM>

Specify the pcap file.  With no other options, B<pcaputil> will list the TCP 
streams found in the file.  Source and destination IPs and ports are displayed.

=item B<-v|--verbose>

The verbose option additionally lists source and destination MAC addresses, 
and the time value from the initial SYN packet at the beginning of the stream.

=item B<-l|--lookup>

B<lookup> will look up port numbers and attempt to resolve IP addresses.

=item B<-d|--dump DUMP_RANGE>

Extract the TCP streams as referenced by the index numbers displayed by the 
list returned by B<pcaputil> in display mode.  DUMP_RANGE can be a single 
index number, or a series of numbers separated by comma (i.e., 1,2,3), or as 
a range of indices specified as two numbers separated by a dash (i.e. 1-4).
any number of numbers separated by commas and dashes may appear in the range
(i.e., 2,5,7-9,11).

=item B<-p|--prefix MSGPREFIX>

The filename prefix of the extracted files.  Filenames will have their index
number appended to the end of the name.  If this option is not used, extracted
streams will be named using IP and port information.

=item B<-D|--dir MSGDIRECTORY>

The directory where extracted stream files should be saved.  If the directory 
does not exist it will be created.  The default directory for extracted 
messages is the current working directory.

=item B<-h|--help>

The -h and --help options print this help menu.  The calling B<pcaputil> with
no options will print a quick usage summary.

=back