|
#!/usr/bin/env perl |
|
|
|
# multipcap.pl |
|
# License MIT + Any article (blog, site, documentation, etc) |
|
# should link back to this page. |
|
# Link : https://gist.github.com/mdeweerd/4bf3375b2ec56b5492a7a4695e19e92e |
|
|
|
use strict; |
|
#use File::PCAP::Reader; # Needed to read the pcap file |
|
#use File::PCAP::Writer; # Needed to write the pcap file |
|
#use Net::Pcap; |
|
use IO::Select; |
|
use Fcntl; |
|
use POSIX; |
|
use Time::HiRes qw(gettimeofday) |
|
; # Needed to get usec precision for current time |
|
use Time::Piece |
|
; # May no longer be needed, possibly needed for date in Syslog message (disabled) |
|
use Time::Local; # needed for gmtime |
|
use Date::Parse |
|
; # May no longer be needed, possibly needed for date in Syslog message (disabled) |
|
#use Socket; # Needed for inet_aton, etc - could be avoided |
|
#use Scalar::Util qw(looks_like_number); # Need to test if argument is a number |
|
#use List::Util qw(sum); # Needed for the checksum which is not currently used |
|
use POSIX qw(locale_h); # Needed for locale type |
|
use locale; # Needed for setlocale |
|
|
|
# Make sure text is in English. |
|
setlocale(LC_CTYPE); |
|
use File::Temp qw(tempdir); |
|
use File::Basename qw(dirname); |
|
use File::Spec::Functions qw(catfile); |
|
use POSIX qw(mkfifo); |
|
use Fcntl; |
|
use FileHandle; |
|
|
|
|
|
use IO::Poll qw(POLLRDNORM POLLWRNORM POLLIN POLLHUP); |
|
|
|
use Data::Dumper; # Used for debug |
|
|
|
# Package to handle options |
|
use Getopt::Long qw(:config gnu_compat); |
|
|
|
use constant BASENAMEKEY => "basename"; # Hash key used for value related to basename parameter |
|
|
|
$| = 1; # Flush stdout immediately |
|
$/ = undef; |
|
|
|
my $OUTPIPEDIR = dirname($0) . "/pipes"; |
|
my $OUTPIPENAME = "outpipe"; |
|
|
|
#my $dir = tempdir(CLEANUP=>1,DIR=>$OUTPIPEDIR); |
|
our $dir = $OUTPIPEDIR; |
|
our %inpipes = (); # List of input pipes (label=>path) |
|
our %inpipedata = (); # Pending data for input pipes |
|
our %outpipes = (); # List of output pipes (label=>path) |
|
our %outpaths = (); # files and pipes (reference for output file opening) |
|
our %finpipes = (); # Opened input pipe handlers |
|
our %foutpipes = (); # Opened output pipe handlers |
|
our %inheaders = (); # Input headers |
|
our %outheaders = (); # Output headers |
|
our %counters = (); |
|
|
|
$SIG{'INT'} = $SIG{'QUIT'} = $SIG{'ABRT'} = $SIG{'TERM'} = \&cleanUp; |
|
|
|
# Command line parameters |
|
our @inPipePaths; |
|
our @outPipePaths; |
|
our $basename; |
|
our $filename; |
|
our $maxlogsize = 0; |
|
our $maxlogduration_s = 0; |
|
our $pidfile; |
|
our $starttime; |
|
our $debug=1; |
|
our $requireDir=0; |
|
our $logfilename="-"; |
|
|
|
GetOptions( |
|
"inpipe=s@" => \@inPipePaths, |
|
"outpipe=s@" => \@outPipePaths, |
|
"basename=s" => \$basename |
|
, # Basename to create outputfile "$basename_20200812_013025.pcap"; |
|
"filename=s" => \$filename |
|
, # Output filename without file rotation (undated file) "$filename" |
|
"logfilename=s" => \$logfilename, |
|
"pidfile=s" => \$pidfile, |
|
"dirpipe=s" => \$dir, # Directory to put relative pipes. |
|
"size=i" => \$maxlogsize, # Maximum log size for basenamed file |
|
"duration=i" => |
|
\$maxlogduration_s, # Maximum log period for basenamed file. |
|
"debug:1" => \$debug, # Debug level |
|
); |
|
|
|
|
|
our $hLog; # filehandle for logging |
|
if(!defined($logfilename)||$logfilename eq "-") { |
|
$hLog=\*STDOUT; |
|
} else { |
|
use Tie::Handle::FileWriteRotate; |
|
use File::Write::Rotate; |
|
use File::Basename; |
|
|
|
# my $base = basename($path); |
|
# my $dir = dirname($path); |
|
my ($base, $dir, $ext) = fileparse($logfilename); |
|
|
|
tie *FH, 'Tie::Handle::FileWriteRotate', |
|
dir => $dir, # required |
|
prefix => $base, # required |
|
suffix => $ext, # default is '' |
|
size => 1*1024*1024, # default is 10MB, unless period is set |
|
histories => 12, # default is 10 |
|
rotate_probability =>0.05, # limits number of checks for rotation |
|
lock_mode => 'exclusive' # 'none', 'exclusive' are faster than 'write' |
|
; |
|
$hLog=\*FH; |
|
}; |
|
|
|
print $hLog "$0\nStart@ ".scalar(localtime())."\n"; |
|
|
|
if(defined($pidfile)) { |
|
open PID, '>', $pidfile or die "can't write pid file: $!"; |
|
print PID $$; |
|
close PID; |
|
} |
|
|
|
if ( !defined($basename) && !defined($filename) && scalar(@outPipePaths) == 0 ) { |
|
# No output file and no output pipe defined |
|
# -> set default output pipes |
|
$outpipes{'outpipe0'} = catfile( $dir, "pipe0" ); |
|
$outpipes{'outpipe1'} = catfile( $dir, "pipe1" ); |
|
} |
|
|
|
if ( scalar(@inPipePaths) == 0 ) { |
|
# No input pipe defined |
|
# -> set default input pipes |
|
$inpipes{'inpipe0'} = catfile( $dir, "inpipe0" ); |
|
} |
|
|
|
# Set Up input and output pipes |
|
my $idx; |
|
$idx = 0; |
|
foreach my $pipe (@inPipePaths) { |
|
if ( !( $pipe =~ /^\// ) ) { |
|
$pipe = catfile( $dir, $pipe ) |
|
; # Pipe is relative path, add to pipe directory. |
|
} |
|
$inpipes{ 'inpipe' . $idx } = $pipe; |
|
$idx++; |
|
} |
|
|
|
$idx = 0; |
|
foreach my $pipe (@outPipePaths) { |
|
if ( !( $pipe =~ /^\// ) ) { |
|
# Pipe is relative path, add to pipe directory. |
|
$pipe = catfile( $dir, $pipe ); |
|
$requireDir=1; |
|
} |
|
$outpipes{ 'outpipe' . $idx } = $pipe; |
|
$idx++; |
|
} |
|
|
|
if($requireDir) { |
|
# Create directory only if pipes require it |
|
print $hLog "CREATE $dir Directory\n" if $debug; |
|
mkdir $dir; |
|
} |
|
|
|
foreach my $pipeKey ( keys %outpipes ) { |
|
my $pipe=$outpipes{$pipeKey}; |
|
print $hLog "CREATE $pipe output pipe\n" if $debug; |
|
mkfifo( $pipe, 0700 ); # or die "mkfifo($pipe) failed: $!"; |
|
$outpaths{$pipeKey}=$pipe; # add pipe to output paths |
|
} |
|
|
|
foreach my $pipeKey ( keys %inpipes ) { |
|
my $pipe=$inpipes{$pipeKey}; |
|
print $hLog "CREATE $pipe input pipe\n" if $debug; |
|
mkfifo( $pipe, 0700 ); # or die "mkfifo($pipe) failed: $!"; |
|
} |
|
|
|
# Setup output file (full log) |
|
if ( defined($filename) ) { |
|
$outpaths{'filename'} = $filename; |
|
} |
|
|
|
# Setup output file (timed log) |
|
if ( defined($basename) ) { |
|
$outpaths{::BASENAMEKEY} = getFileWithDate($basename); |
|
print $hLog "BASENAME $basename -> {$outpaths{::BASENAMEKEY}\n" if $debug; |
|
} |
|
|
|
# Event Management Object |
|
my $header; |
|
|
|
#$header=pack("L*",{ |
|
# 0xa1b2c3d4, #/* byte-order magic number */ |
|
# 0x00040002, #/* version major number (4) & minor number (2) */ |
|
# 0, #/* timezone correction (GMT) */ |
|
# 0, #/* timestamp accuracy (microseconds) */ |
|
# 127, #/* snapshot length (IEEE 802.15.4 PHY payload max size) */ |
|
# 195, #/* network link type (LINKTYPE_IEEE802_15_4_WITHFCS) */ |
|
#}); |
|
# |
|
#$header=pack("H*","d4c3b2a10200040000000000000000007f000000c3000000"); |
|
|
|
my $ioSelect=IO::Select->new(); |
|
|
|
# Main loop |
|
# -> Open pipes according to options or default |
|
# -> Attach a supervision to input pipes : react if data is coming or a pipe is closed |
|
while (1) { |
|
|
|
# Open inpipes if not open |
|
foreach my $inpipe ( values %inpipes ) { |
|
my $f = $finpipes{$inpipe}; |
|
if ( !defined($f) || fileno($f) == undef ) { |
|
print $hLog "OPEN $inpipe\n" if $debug; |
|
my $isOpen = 1; |
|
sysopen( $f, $inpipe, O_NONBLOCK | O_RDONLY ) or $isOpen = 0; |
|
|
|
#$f=File::PCAP::Reader->new( $inpipe, O_NONBLOCK | O_RDONLY ) or $isOpen = 0; |
|
#my $err; |
|
#$f=pcap_open_offline($inpipe, \$err) or die "Can't read '$inpipe': $err\n"; |
|
|
|
if ($isOpen) { |
|
$f->autoflush(1); |
|
$f->blocking(0); |
|
#$f->input_record_separator(0); |
|
binmode($f); |
|
$finpipes{$inpipe} = $f; |
|
$counters{$inpipe} = 1; |
|
delete $inheaders{$inpipe}; |
|
# Set blocking mode |
|
my $flags = fcntl( $f, F_GETFL, 0); |
|
fcntl( $f, F_SETFL, $flags & (~O_NONBLOCK) ); |
|
$ioSelect->add($f); |
|
print $hLog "OPENED $inpipe input pipe\n"; |
|
} |
|
# print $hLog "SYSOPEN DONE for $inpipe\n"; |
|
} |
|
} |
|
|
|
# Set polling event on input pipes - on a 250ms time basis |
|
my @inHasData; |
|
if ( $ioSelect->count() ) { |
|
@inHasData = $ioSelect->can_read(0.250); |
|
} else { |
|
@inHasData = (); |
|
sleep 0.250; |
|
} |
|
|
|
# Check for closed pipes (= HUP) |
|
my @inClosed = (); # $poll->handles( POLLHUP ); |
|
|
|
# Check for input pipes with new Data |
|
# my @inHasData = $poll->handles( POLLRDNORM | POLLIN ); |
|
|
|
foreach my $inpipe ( values @inHasData ) { |
|
my $newdata; |
|
sysread($inpipe,$newdata,10000); |
|
if ( $newdata eq "" ) { |
|
if(eof($inpipe)) { |
|
push @inClosed,$inpipe; |
|
} |
|
next; |
|
} |
|
my $pending = $inpipedata{$inpipe}; |
|
if($pending ne "") { |
|
# Clear pending data (if there is any) |
|
$inpipedata{$inpipe}=""; |
|
} |
|
my $data=$pending.$newdata; |
|
print $hLog "." if $debug; |
|
|
|
my $inpipeName = getInpipeName($inpipe); |
|
if ( !defined( $inheaders{$inpipeName} ) ) { |
|
|
|
#my $h = $inpipe->global_header(); |
|
#inheaders{$inpipeName}; |
|
my $hasHeader = defined($header); |
|
$header = substr( $data, 0, 6 * 4 ); |
|
$inheaders{$inpipeName} = $header; |
|
if (!$hasHeader && $header ne "") { |
|
writeToPipes($header); |
|
} |
|
$data = substr( $data, 6 * 4, -1 ); # Remove header for packet handling |
|
print $hLog "HEADER for $inpipeName Header:".unpack( "H*", $header )."\n" if $debug; |
|
} |
|
|
|
# Suggestion to read packet by packet for later development |
|
#my $data = $inpipe->next_packet(); |
|
|
|
print $hLog "DATA:'".unpack("H*",$data)."'\n" if $debug; |
|
#print $hLog "#DATA:'".length($data)."'\n"; |
|
if ( $newdata eq "" ) { next; } # data could have been stripped |
|
ANALYSE_DATA: |
|
my $len=length($data); |
|
if ( $len < 4*4 ) { |
|
$inpipedata{$inpipe}=$data; |
|
next; |
|
} # data does not have packet header. |
|
my @headerInts=unpack("V4",$data); # Get 4 int32 bytes from header |
|
print $hLog scalar(localtime($headerInts[0]))."\n" if $debug; |
|
print $hLog "TimeSecs:".$headerInts[0]."\n" if $debug; # Could check if time is reasonable vs. real time |
|
#print $hLog "TimeuSecs:".$headerInts[1]."\n" if $debug; |
|
print $hLog "#Bytes:".$headerInts[2]."\n" if $debug; # Number of bytes in file |
|
#print $hLog "Actual length:".$headerInts[3]."\n" if $debug; # Real number of bytes |
|
|
|
if( $headerInts[2]!=$headerInts[3] # Saved size is different from actual -> does not happen on Zena |
|
|| $headerInts[3]>128 # Packet is too big for Zigbee |
|
) { |
|
print $hLog "Skipping invalid data length".$headerInts[3].":".unpack("H*",$data)."\n"; |
|
if($pending ne "") { |
|
$data=$newdata; |
|
$newdata=""; |
|
$pending=""; |
|
goto ANALYSE_DATA; |
|
} |
|
next; |
|
} |
|
|
|
|
|
print $hLog "Actual length:".$headerInts[3]." Available:".$len."\n" if $debug; |
|
my $neededBytes=4*4+$headerInts[3]; |
|
if($len<$neededBytes) { |
|
# Not enough data, skip. |
|
$inpipedata{$inpipe}=$data; |
|
next; |
|
} |
|
print $hLog "=" if $debug; |
|
if($len>$neededBytes) { |
|
# More bytes than needed, send required bytes |
|
writeToPipes(substr($data,0,$neededBytes)); |
|
# Continue to process the next ones |
|
$data=substr($data,$neededBytes); |
|
goto ANALYSE_DATA; |
|
} |
|
# Just enough bytes, write them, then done |
|
writeToPipes($data); |
|
} |
|
|
|
foreach my $hupPipe ( @inClosed ) { |
|
print $hLog "HANDLE HUP\n" if $debug; |
|
# de-attach event scanning |
|
$ioSelect->remove($hupPipe); |
|
# close the handler |
|
$hupPipe->close(); |
|
|
|
foreach my $inpipe ( keys %finpipes ) { |
|
if ( $hupPipe eq $finpipes{$inpipe} ) { |
|
delete( $finpipes{$inpipe} ); |
|
} |
|
} |
|
} |
|
|
|
|
|
my $baselogName = $outpaths{::BASENAMEKEY}; |
|
my $baselogHandle = $foutpipes{$baselogName}; |
|
if ( defined($baselogHandle) ) { |
|
#print $hLog "SIZE $baselogName ".tell($baselogHandle)."\n"; |
|
my $currentlogduration=time()-$starttime; |
|
if ( ( $maxlogduration_s != 0 && $maxlogduration_s < $currentlogduration ) |
|
|| ( $maxlogsize != 0 && $maxlogsize < tell($baselogHandle) ) ) |
|
{ |
|
my $orgfile=$baselogName; |
|
# close basenamefile |
|
delete $foutpipes{$baselogName}; |
|
close $baselogHandle; |
|
|
|
# set new filename |
|
$outpaths{::BASENAMEKEY}=getFileWithDate($basename); |
|
print $hLog "ROTATED '$orgfile' as '$basename'\n" if $debug; |
|
} |
|
} |
|
|
|
# Open output pipes |
|
foreach my $pipeKey ( keys %outpaths ) { |
|
#print $hLog "CHECK $pipe\n"; |
|
my $pipe = $outpaths{$pipeKey}; |
|
my $f = $foutpipes{$pipe}; |
|
if ( (!defined($f) || fileno($f) == undef) # File/Pipe is not open |
|
&& ( |
|
$pipeKey ne ::BASENAMEKEY |
|
|| ( defined($header) && $header ne "" ) |
|
) # Must have something to write to file |
|
) { |
|
my $isOpen = 1; |
|
|
|
sysopen( $f, $pipe, O_NONBLOCK | O_WRONLY | O_CREAT ) or $isOpen = 0; |
|
|
|
#$f = File::PCAP::Writer->new($pipe); |
|
if($isOpen) { |
|
$f->autoflush(1); |
|
$foutpipes{$pipe} = $f; |
|
delete $outheaders{$pipe}; |
|
$counters{$pipe} = 1; |
|
if ( defined($header) ) { |
|
print $f $header; |
|
$f->flush(); |
|
} |
|
print $hLog "SYSOPEN DONE for $pipeKey=>$pipe Header:". unpack( "H*", $header )."\n"; |
|
print $hLog "SYSOPEN DONE for $pipe Header:". unpack( "H*", $header )."\n" if $debug; |
|
print $hLog "OPENED $pipe output pipe\n"; |
|
} else { |
|
if($pipeKey eq ::BASENAMEKEY) { |
|
print ::BASENAMEKEY."SYSOPEN FAILED for $pipeKey $pipe\n" if $debug; |
|
exit; |
|
} |
|
} |
|
} |
|
} |
|
#sleep 1; |
|
} |
|
|
|
sub writeToPipes { |
|
my $data=shift; |
|
foreach my $pipeKey ( keys %outpaths ) { |
|
my $pipe=$outpaths{$pipeKey}; |
|
|
|
#print $hLog "CHECK $pipe\n"; |
|
my $f = $foutpipes{$pipe}; |
|
|
|
if ( defined($f) && ( fileno($f) != undef ) ) { |
|
my $success = 0; |
|
{ |
|
local $SIG{PIPE} = sub { closeOutpipe($pipe); }; |
|
|
|
#print $hLog "WRITE to $pipe\n"; |
|
print $f $data; |
|
$f->flush(); |
|
|
|
#print $hLog $pipe." ". $data; |
|
$counters{$pipe}++; |
|
$success = 1; |
|
} |
|
if ( !$success ) { |
|
closeOutpipe($pipe); |
|
} |
|
} |
|
} |
|
} |
|
|
|
sub closeOutpipe { |
|
my $pipe=shift; |
|
close $foutpipes{$pipe}; |
|
delete $foutpipes{$pipe}; |
|
print $hLog "Closed $pipe\n"; |
|
} |
|
|
|
sub getFileWithDate { |
|
my $base = shift; |
|
my ( $sec, $min, $hour, $day, $month, $year, $wday, $yday ) = gmtime(); |
|
$year+=1900; |
|
$month+=1; |
|
$starttime=time(); |
|
return sprintf( "%s_%04u%02u%02u_%02u%02u%02u.pcap", |
|
$base, $year, $month, $day, $hour, $min, $sec ); |
|
} |
|
|
|
sub getInpipeName { |
|
my $pipeHandle = shift; # First parameter. |
|
foreach my $inpipe ( keys %finpipes ) { |
|
if ( $pipeHandle == $finpipes{$inpipe} ) { |
|
return $inpipe; |
|
} |
|
} |
|
return undef; |
|
} |
|
|
|
sub cleanUp { |
|
print $hLog "Delete pipes\n" if $debug; |
|
foreach my $f ( values %foutpipes ) { |
|
print $hLog "Close Pipe $f (foutpipes)\n" if $debug; |
|
close $f; |
|
} |
|
foreach my $pipe ( values %outpipes ) { |
|
print $hLog "Unlink Pipe $pipe (outpipes)\n" if $debug; |
|
unlink $pipe; |
|
} |
|
foreach my $pipe ( values %inpipes ) { |
|
print $hLog "Unlink Pipe $pipe (inpipes)\n" if $debug; |
|
unlink $pipe; |
|
} |
|
if($requireDir) { |
|
# We created the directory, remove it |
|
rmdir $dir; |
|
} |
|
exit; |
|
} |
|
|
|
cleanUp(); |
|
exit; |