#!/usr/bin/perl
# Test of Net::IMP::ProtocolPinning

use strict;
use warnings;
use Net::IMP::ProtocolPinning;
use Net::IMP;
use Net::IMP::Debug;
use Data::Dumper;
use Test::More;

$DEBUG=0; # enable for extensiv debugging

# if you want to run only selected tests add test numbers to cmdline
my %only = map { $_ =>1 } @ARGV;
my @tests = (
    {
	rules => [
	    { dir => 0, rxlen => 4, rx => qr/affe/ },
	    { dir => 1, rxlen => 4, rx => qr/hund/ },
	    { dir => 0, rxlen => 2, rx => qr/ok/ }
	],
	in => [
	    [0,'affe'],
	    [1,'hund'],
	    [0,'ok' ]
	],
	rv => [
	    [ IMP_PASS,0,4 ],
	    [ IMP_PASS,1,4 ],
	    [ IMP_PASS,0,IMP_MAXOFFSET ],
	    [ IMP_PASS,1,IMP_MAXOFFSET ],
	],
    },{
	in => [
	    [1,'hund'],
	    [0,'affe'],
	    [0,'ok' ]
	],
	rv => [[IMP_DENY, 1, 'rule#0 data from wrong dir 1' ]],
    },{
	ignore_order => 1,
	rv => [
	    [ IMP_PASS,1,4 ],
	    [ IMP_PASS,0,4 ],
	    [ IMP_PASS,0,IMP_MAXOFFSET ],
	    [ IMP_PASS,1,IMP_MAXOFFSET ],
	],
    }, {
	rules => [
	    { dir => 1, rxlen => 7, rx => qr/SSH-2\.0/ }
	],
	in => [
	    [ 0,'huhu' ],
	    [ 1,"SSH-2.0-OpenSSH_5.9p1 Debian-5ubuntu1\n" ],
	],
	rv => [
	    [ IMP_PASS,0,IMP_MAXOFFSET ],
	    [ IMP_PASS,1,IMP_MAXOFFSET ],
	],
    }, {
	max_unbound => [4,], # "huhu" fits in 4 bytes
    }, {
	max_unbound => [0,],
	rv => [[IMP_DENY, 0, 'too much data outside rules for dir 0' ]],
    }, {
	max_unbound => [100,100],
	rules => [
	    { dir => 0, rxlen => 5, rx => qr/affe\n/ },
	    { dir => 1, rxlen => 5, rx => qr/hund\n/ },
	],
	in => [
	    [ 0,'affe' ],[0,"\njuppi"],
	    [ 1,'hu' ],[1,'nd'],[1,"\n"],
	],
	rv => [
	    [ IMP_PASS,0,5 ],
	    [ IMP_PASS,0,IMP_MAXOFFSET ],
	    [ IMP_PASS,1,IMP_MAXOFFSET ],
	],
    }, {
	max_unbound => [0,0],
	rules => [
	    { dir => 0, rxlen => 12, rx => qr/cloud(ella)?(ria)?/ },
	    { dir => 1, rxlen => 1, rx => qr/./ }
	],
	in => [
	    [ 0,'clou' ],
	    [ 0,'de' ],
	    [ 0,'llar' ],
	    [ 0,'iad' ],
	    [ 1,'foo' ],
	],
	rv => [
	    [ IMP_PASS,0,5 ],
	    [ IMP_PASS,0,9 ],
	    [ IMP_PASS,0,12 ],
	    [ IMP_PASS,0,IMP_MAXOFFSET ],
	    [ IMP_PASS,1,IMP_MAXOFFSET ],
	],
    },
    {
	rules => [ { dir => 0, rxlen => 8, rx => qr/(\w\w\w\w)\1/ } ],
	in => [[0,'toortoor']],
	rv => [
	    [ IMP_PASS,0,IMP_MAXOFFSET ],
	    [ IMP_PASS,1,IMP_MAXOFFSET ],
	],
    },
    {
	rules => [ { dir => 0, rxlen => 8, rx => qr/(\w\w\w\w)\1/ } ],
	in => [[0,'toorToor']],
	rv => [[IMP_DENY, 0, 'rule#0 did not match' ]],
    },
    {
	ignore_order => 0,
	rules => [ { dir => 1, rxlen => 1, rx => qr/./ } ],
	in => [[0,'foo']],
	rv => [[IMP_DENY, 0, 'rule#0 data from wrong dir 0' ]],
    },
    {
	rules => [ { dir => 1, rxlen => 2, rx => qr/../ } ],
	in => [[1,'X'],[1,'']],
	rv => [[IMP_DENY, 1, 'eof on 1 but unmatched rule#0' ]],
    },
    {
	ignore_order => 1,
	rules => [ 
	    { dir => 0, rxlen => 6, rx => qr/foo(?=bar)/ },
	    { dir => 1, rxlen => 6, rx => qr/bar(?=foo)/ } 
	],
	in => [
	    [ 0,'fo' ], [ 0,'o' ], [ 0,'ba' ], [ 0,'rff' ],
	    [ 1,'b' ], [ 1,'arf' ], [ 1,'oobb' ],
	],
	rv => [
	    [ IMP_PASS,0,3 ],             # foobar -> fwd 'foo'
	    [ IMP_PASS,0,IMP_MAXOFFSET ], # barfoo -> all done
	    [ IMP_PASS,1,IMP_MAXOFFSET ],
	]
    },
    {
	ignore_order => 0,
	rules => [ 
	    { dir => 0, rxlen => 20, rx => qr/a.*b/ },
	    { dir => 1, rxlen => 20, rx => qr/C.*D/ },
	    { dir => 0, rxlen => 20, rx => qr/e.*f/ },
	    { dir => 1, rxlen => 20, rx => qr/G.*H/ },
	],
	in => [
	    [ 0,'a.b' ],
	    [ 1,'C.D' ],
	    [ 0,'e.f' ],
	    [ 1,'G.' ],
	    [ 1,'H' ],
	],
	rv => [
	    [ IMP_PASS,0,3 ],
	    [ IMP_PASS,1,3 ],
	    [ IMP_PASS,0,6 ],
	    [ IMP_PASS,0,IMP_MAXOFFSET ],
	    [ IMP_PASS,1,IMP_MAXOFFSET ],
	]
    }

);

plan tests => @tests - keys(%only);

my (%test,$out);
for(my $i=0;$i<@tests;$i++) {
    %test = ( %test,%{$tests[$i]} ); # redefine parts of previous
    next if %only && ! $only{$i};

    my @rv;
    my $cb = sub {
	debug( "callback: ".Dumper(\@_));
	push @rv,@_
    };

    my %config = (
	rules        => $test{rules},
	max_unbound  => $test{max_unbound},
	ignore_order => $test{ignore_order},
    );
    if ( my @err = Net::IMP::ProtocolPinning->validate_cfg(%config) ) {
	fail("config[$i] not valid");
	diag("@err");
	next;
    }

    my $factory = Net::IMP::ProtocolPinning->new_factory(%config);
    my $analyzer = $factory->new_analyzer( cb => [$cb] );

    for( @{$test{in}} ) {
	my ($dir,$data) = @$_;
	debug("send '$data' to $dir");
	$analyzer->data($dir,$data);
    }

    if ( Dumper(\@rv) ne Dumper($test{rv})) {
	fail("protopin[$i]");
	diag( "--- expected---\n".Dumper($test{rv}).
	    "\n--- got ---\n".Dumper(\@rv));
    } else {
	pass("protopin[$i]");
    }
}