#!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, 0, \$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);