The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -T
use strict;
use Test::More;
use Net::Pcap;
use lib 't';
use Utils;

my $total = 10;  # number of packets to process

plan skip_all => "must be run as root" unless is_allowed_to_use_pcap();
plan skip_all => "no network device available" unless find_network_device();
plan tests => $total * 22 + 20;

my $has_test_exception = eval "use Test::Exception; 1";

my($dev,$pcap,$dumper,$dump_file,$err) = ('','','','');

# Find a device and open it
$dev = find_network_device();
$pcap = Net::Pcap::open_live($dev, 1024, 1, 100, \$err);

# Testing error messages
SKIP: {
    skip "Test::Exception not available", 10 unless $has_test_exception;

    # dump_open() errors
    throws_ok(sub {
        Net::Pcap::dump_open()
    }, '/^Usage: Net::Pcap::dump_open\(p, fname\)/', 
       "calling dump_open() with no argument");

    throws_ok(sub {
        Net::Pcap::dump_open(0, 0)
    }, '/^p is not of type pcap_tPtr/', 
       "calling dump_open() with incorrect argument type");

    # dump() errors
    throws_ok(sub {
        Net::Pcap::dump()
    }, '/^Usage: Net::Pcap::dump\(p, pkt_header, sp\)/', 
       "calling dump() with no argument");

    throws_ok(sub {
        Net::Pcap::dump(0, 0, 0)
    }, '/^p is not of type pcap_dumper_tPtr/', 
       "calling dump() with incorrect argument type for arg1");

    # dump_close() errors
    throws_ok(sub {
        Net::Pcap::dump_close()
    }, '/^Usage: Net::Pcap::dump_close\(p\)/', 
       "calling dump_close() with no argument");

    throws_ok(sub {
        Net::Pcap::dump_close(0)
    }, '/^p is not of type pcap_dumper_tPtr/', 
       "calling dump_close() with incorrect argument type");

    # dump_file() errors
    throws_ok(sub {
        Net::Pcap::dump_file()
    }, '/^Usage: Net::Pcap::dump_file\(p\)/', 
       "calling dump_file() with no argument");

    throws_ok(sub {
        Net::Pcap::dump_file(0)
    }, '/^p is not of type pcap_dumper_tPtr/', 
       "calling dump_file() with incorrect argument type");

    SKIP: {
        skip "pcap_dump_flush() is not available", 2 unless is_available('pcap_dump_flush');

        # dump_flush() errors
        throws_ok(sub {
            Net::Pcap::dump_flush()
        }, '/^Usage: Net::Pcap::dump_flush\(p\)/', 
            "calling dump_flush() with no argument");

        throws_ok(sub {
            Net::Pcap::dump_flush(0)
        }, '/^p is not of type pcap_dumper_tPtr/', 
            "calling dump_flush() with incorrect argument type");
    }
}

# Testing dump_open()
eval q{ use File::Temp qw(:mktemp); $dump_file = mktemp('pcap-XXXXXX') };
$dump_file ||= "pcap-$$.dmp";
my $user_text = "Net::Pcap test suite";
my $count = 0;
my $size = 0;

eval { $dumper = Net::Pcap::dump_open($pcap, $dump_file) };
is(   $@,   '', "dump_open()" );
ok( defined $dumper, " - dumper is defined" );

TODO: {
    todo_skip "Hmm.. when executed, dump_file() corrupts something somewhere, making this script dumps core at the end", 3;
    my $filehandle;
    eval { $filehandle = Net::Pcap::dump_file($dumper) };
    is( $@, '', "dump_file()" );
    ok( defined $filehandle, "returned filehandle is defined" );
    isa_ok( $filehandle, 'GLOB', "\$filehandle" );
}

# Testing error messages
SKIP: {
    skip "Test::Exception not available", 1 unless $has_test_exception;

    # dump() errors
    throws_ok(sub {
        Net::Pcap::dump($dumper, 0, 0)
    }, '/^arg2 not a hash ref/', 
       "calling dump() with incorrect argument type for arg2");

}

sub process_packet {
    my($user_data, $header, $packet) = @_;

    pass( "process_packet() callback" );
    is( $user_data, $user_text, " - user data is the expected text" );
    ok( defined $header,        " - header is defined" );
    isa_ok( $header, 'HASH',    " - header" );

    for my $field (qw(len caplen tv_sec tv_usec)) {
        ok( exists $header->{$field}, "    - field '$field' is present" );
        ok( defined $header->{$field}, "    - field '$field' is defined" );
        like( $header->{$field}, '/^\d+$/', "    - field '$field' is a number" );
    }

    ok( $header->{caplen} <= $header->{len}, "    - caplen <= len" );

    ok( defined $packet,        " - packet is defined" );
    is( length $packet, $header->{caplen}, " - packet has the advertised size" );

    eval { Net::Pcap::dump($dumper, $header, $packet) };
    is(   $@,   '', "dump()");

    SKIP: {
        skip "pcap_dump_flush() is not available", 2 unless is_available('pcap_dump_flush');
        my $r;
        eval { $r = Net::Pcap::dump_flush($dumper) };
        is(   $@,   '', "dump_flush()");
        is( $r, 0, " - result: $r" );
    }

    $size += $header->{caplen};
    $count++;
}

Net::Pcap::loop($pcap, $total, \&process_packet, $user_text);
is( $count, $total, "all packets processed" );

eval { Net::Pcap::dump_close($dumper) };
is(   $@,   '', "dump_close()" );
ok( -f $dump_file, "dump file created" );
ok( -s $dump_file >= $size, "dump file size" );

unlink($dump_file);
Net::Pcap::close($pcap);