mdeweerd/Multipcap.pl

## README.md

      
    Raw
  

              README.md
            
          
    multipcap.pl

This programs duplicates and joins one or more input pcap fifos into one or more output fifos, a combined log files or a "rotating" log file.
The input pcap types must be of the same type (the header must match).
You must install 'File::Write::Rotate' for perl.
Installation under debian:
    sudo apt-get install file-write-rotate-perl
    sudo cpan install Tie::Handle::FileWriteRotate
Other packet(s) that may be needed:
sudo apt-get install -y libdatetime-format-dateparse-perl
Example for zigbee using the cc2531 extcap interface.
First, launch the script:
./multipcap.pl -o ${HOME}/pcappipe -o sample -b logs -duration 60 -debug -file fulllog.pcap

This:

Output pipe in ${HOME} directory (absolute path) - pcappipe
Output pipe sample (in default pipes subdirectory)
"Rotating" log file (timestamp in filename) logs_YYYYMMDD_HHmmSS.pcap
Full log file "fulllog.pcap" (contains the full capture)
Default input pipe in default subdirectory (pipes/inpipe0)

In any order, at any time:
Launch the extcap filter, give the input pipe path:
/usr/lib/x86_64-linux-gnu/wireshark/extcap/cc2531 --channel 11 --fifo pipes/inpipe0

Launch wireshark locally:
wireshark -k -i ${HOME}/pcappipe

Launch wireshark remotely:
wireshark

Configure sshdump in wireshark, then launch the sshdump setup:

⚠️ Point exactly to the black cogwheel - the rest of the line will only propose Start Capture ...

Open a partial log (using parameters above, file must exist):
wireshark logs_01200610_171714.pcap

Open the full log:
wireshark fulllog.pcap

Link to script: https://gist.github.com/mdeweerd/4bf3375b2ec56b5492a7a4695e19e92e

  
## license.txt
MIT License Modified

Copyright (c) 2020 Mario DE WEERD

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
Any article (blog, site, documentaiont, etc) should link back to this page.
Link : https://gist.github.com/mdeweerd/4bf3375b2ec56b5492a7a4695e19e92e

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

## Multipcap.pl
#!/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;

## sshdumpConfig.png

      
    Raw
  

              sshdumpConfig.png
            
          
## SSHDumpSetting.png

      
    Raw
  

              SSHDumpSetting.png
	MIT License Modified

	Copyright (c) 2020 Mario DE WEERD

	Permission is hereby granted, free of charge, to any person obtaining a copy
	of this software and associated documentation files (the "Software"), to deal
	in the Software without restriction, including without limitation the rights
	to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
	copies of the Software, and to permit persons to whom the Software is
	furnished to do so, subject to the following conditions:

	The above copyright notice and this permission notice shall be included in all
	copies or substantial portions of the Software.
	Any article (blog, site, documentaiont, etc) should link back to this page.
	Link : https://gist.github.com/mdeweerd/4bf3375b2ec56b5492a7a4695e19e92e

	THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
	IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
	FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
	AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
	LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
	OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
	SOFTWARE.
	#!/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 => 110241024, # 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;