#!/usr/bin/env perluse warnings;use strict;use Carp;use Data::Dumper;use Getopt::Lazy 'help|h' => 'Show this help screen', 'file|f=s' => '[FILE] Read packets from this file', 'dir|d:s' => ['[DIRECTORY] Output split files in this directory', '.'],; Getopt::Lazy::GetOptions;Getopt::Lazy::show_help and exit 1 if @ARGV; # disallow other argumentsuse Cwd qw(abs_path);use File::Path qw(make_path);use File::Spec;use Net::Frame::Dump::Offline;use Net::Frame::Dump::Writer;use Net::Frame::Layer::8021Q qw(:consts);use Net::Frame::Layer::ETH qw(:consts);# make directories, resolve the path.make_path($dir);$dir = abs_path($dir) or croak "Couldn't resolve the path we just created";# find the basename of the capture filemy (undef, undef, $base_file) = File::Spec->splitpath($file);# mapping of vlans to N::F::Writer instancesmy %capfiles;END { # Close/stop all of the currently-running N::F::Writers while (my ($vlan, $writer) = each %capfiles) { $writer->stop if $writer->isRunning; }}my $read_packets = 0;my %capcounts;END { my $i = 0; for my $vlan (sort keys(%capcounts)) { $i += $capcounts{$vlan}; print "$vlan: $capcounts{$vlan}\n"; } print "\ntotal read: $read_packets\n"; print "total written: $i\n";}# given a vlan, return either an existing N::F::Writer, or, if not found, open and return a new N::F::Writer for that vlan.sub get_capfile { my $vlan = shift; defined $vlan || croak "no vlan"; my $pcap = $capfiles{$vlan}; if(!$pcap) { $pcap = $capfiles{$vlan} = Net::Frame::Dump::Writer->new( file => File::Spec->join($dir, "$vlan-$base_file"), firstLayer => 'ETH', # XXX Might be kinda botchy. ); $pcap->start; } return $pcap;}# Given a vlan tag, timestamp, and packet data, retrieve the N::F::Writer and write the frame out to the filesub write_to_cap { my $vlan = shift; my $timestamp = shift || croak "no timestamp"; my $packet = shift || croak "no packet"; defined($vlan) || croak "no vlan"; my $pcap = get_capfile($vlan); $pcap->write({timestamp => $timestamp, raw => $packet}); $capcounts{$vlan}++;}# Given packet data, return unknown (for non-802.1q frames), unframed (for frames that have an 802.1q type but don't parse somehow), or a vlan ID.sub discern_vlan { my $data = shift || croak "no data"; my $eth = Net::Frame::Layer::ETH->new(raw => $data); if(not $eth->unpack or $eth->type != NF_ETH_TYPE_8021Q) { carp "Not ethernet or 8021q"; return "unknown"; } # From here, the ethernet unpack succeeded. my $_8021q = Net::Frame::Layer::8021Q->new(raw => $eth->payload); if(not $_8021q->unpack) { carp "8021q didn't unpack"; return "unframed"; } else { return $_8021q->id; }}# Open a packet capture, keeping timestamps.my $dump = Net::Frame::Dump::Offline->new(file => $file, keepTimestamp => 1);$dump->start;# For each frame in the capture, figure out to which vlan it belongs and write it out.while (my $dump_frame = $dump->next) { $read_packets++; my $timestamp = $dump_frame->{timestamp}; my $data = $dump_frame->{raw}; my $vlan = discern_vlan($data); write_to_cap($vlan, $timestamp, $data);}$dump->stop;