#!perl -T
use strict;
use Test::More;
use Net::Pcap;
use lib 't';
use Utils;
plan tests => 45;
my $has_test_exception = eval "use Test::Exception; 1";
my($dev,$net,$mask,$result,$err) = ('','','','','');
my @devs = ();
my %devs = ();
my %devinfo = ();
my $ip_regexp = '/^[12]?\d+\.[12]?\d+\.[12]?\d+\.[12]?\d+$/';
# Testing error messages
SKIP: {
skip "Test::Exception not available", 17 unless $has_test_exception;
# lookupdev() errors
throws_ok(sub {
Net::Pcap::lookupdev()
}, '/^Usage: Net::Pcap::lookupdev\(err\)/',
"calling lookupdev() with no argument");
throws_ok(sub {
Net::Pcap::lookupdev(0)
}, '/^arg1 not a hash ref/',
"calling lookupdev() with incorrect argument type");
SKIP: {
skip "pcap_findalldevs() is not available", 11 unless is_available('pcap_findalldevs');
# findalldevs() errors
throws_ok(sub {
Net::Pcap::findalldevs()
}, '/^Usage: pcap_findalldevs\(devinfo, err\)/',
"calling findalldevs() with no argument");
throws_ok(sub {
Net::Pcap::findalldevs(0, 0, 0)
}, '/^Usage: pcap_findalldevs\(devinfo, err\)/',
"calling findalldevs() with too many arguments");
throws_ok(sub {
Net::Pcap::findalldevs(0)
}, '/^Usage: pcap_findalldevs\(devinfo, err\)/',
"calling 1-arg findalldevs() with incorrect argument type");
throws_ok(sub {
Net::Pcap::findalldevs(\%devinfo)
}, '/^arg1 not a scalar ref/',
"calling 1-arg findalldevs() with incorrect argument type");
throws_ok(sub {
Net::Pcap::findalldevs(0, 0)
}, '/^Usage: pcap_findalldevs\(devinfo, err\)/',
"calling 2-args findalldevs() with incorrect argument type");
throws_ok(sub {
Net::Pcap::findalldevs(\@devs, 0)
}, '/^arg1 not a hash ref/',
"calling 2-args findalldevs() with incorrect argument type for arg1");
throws_ok(sub {
Net::Pcap::findalldevs(\$err, 0)
}, '/^arg2 not a hash ref/',
"calling 2-args findalldevs() with incorrect argument type for arg2");
throws_ok(sub {
Net::Pcap::findalldevs(\%devinfo, 0)
}, '/^arg2 not a scalar ref/',
"calling 2-args findalldevs() with incorrect argument type for arg2");
# findalldevs_xs() errors
throws_ok(sub {
Net::Pcap::findalldevs_xs()
}, '/^Usage: Net::Pcap::findalldevs_xs\(devinfo, err\)/',
"calling findalldevs_xs() with no argument");
throws_ok(sub {
Net::Pcap::findalldevs_xs(0, 0)
}, '/^arg1 not a hash ref/',
"calling findalldevs_xs() with incorrect argument type for arg1");
throws_ok(sub {
Net::Pcap::findalldevs_xs(\%devinfo, 0)
}, '/^arg2 not a scalar ref/',
"calling findalldevs_xs() with incorrect argument type for arg2");
}
# lookupnet() errors
throws_ok(sub {
Net::Pcap::lookupnet()
}, '/^Usage: Net::Pcap::lookupnet\(device, net, mask, err\)/',
"calling lookupnet() with no argument");
throws_ok(sub {
Net::Pcap::lookupnet('', 0, 0, 0)
}, '/^arg2 not a reference/',
"calling lookupnet() with incorrect argument type for arg2");
throws_ok(sub {
Net::Pcap::lookupnet('', \$net, 0, 0)
}, '/^arg3 not a reference/',
"calling lookupnet() with incorrect argument type for arg3");
throws_ok(sub {
Net::Pcap::lookupnet('', \$net, \$mask, 0)
}, '/^arg4 not a reference/',
"calling lookupnet() with incorrect argument type for arg4");
}
SKIP: {
# Testing lookupdev()
eval { $dev = Net::Pcap::lookupdev(\$err) };
is( $@, '', "lookupdev()" );
skip "error: $err. Skipping the rest of the tests", 27 if $err eq 'no suitable device found';
is( $err, '', " - \$err must be null: $err" ); $err = '';
isnt( $dev, '', " - \$dev isn't null: '$dev'" );
# Testing findalldevs()
# findalldevs(\$err), legacy from Marco Carnut 0.05
eval { @devs = Net::Pcap::findalldevs(\$err) };
is( $@, '', "findalldevs() - 1-arg form, legacy from Marco Carnut 0.05" );
is( $err, '', " - \$err must be null: $err" ); $err = '';
ok( @devs >= 1, " - at least one device must be present in the list returned by findalldevs()" );
%devs = map { $_ => 1 } @devs;
is( $devs{$dev}, 1, " - '$dev' must be present in the list returned by findalldevs()" );
# findalldevs(\$err, \%devinfo), legacy from Jean-Louis Morel 0.04.02
eval { @devs = Net::Pcap::findalldevs(\$err, \%devinfo) };
is( $@, '', "findalldevs() - 2-args form, legacy from Jean-Louis Morel 0.04.02" );
is( $err, '', " - \$err must be null: $err" ); $err = '';
ok( @devs >= 1, " - at least one device must be present in the list returned by findalldevs()" );
ok( keys %devinfo >= 1, " - at least one device must be present in the hash filled by findalldevs()" );
%devs = map { $_ => 1 } @devs;
is( $devs{$dev}, 1, " - '$dev' must be present in the list returned by findalldevs()" );
SKIP: {
is( $devinfo{'any'}, 'Pseudo-device that captures on all interfaces',
" - checking pseudo-device description" ) and last if exists $devinfo{'any'};
skip "Pseudo-device not available", 1;
}
SKIP: {
is( $devinfo{'lo' }, 'Loopback device', " - checking loopback device description" )
and last if exists $devinfo{'lo'};
is( $devinfo{'lo0'}, 'Loopback device', " - checking loopback device description" )
and last if exists $devinfo{'lo0'};
skip "Can't predict loopback device description", 1;
}
SKIP: {
skip "pcap_findalldevs() is not available", 7 unless is_available('pcap_findalldevs');
# findalldevs(\%devinfo, \$err), new, correct syntax, consistent with libpcap(3)
eval { @devs = Net::Pcap::findalldevs(\%devinfo, \$err) };
is( $@, '', "findalldevs() - 2-args form, new, correct syntax, consistent with libpcap(3)" );
is( $err, '', " - \$err must be null: $err" ); $err = '';
ok( @devs >= 1, " - at least one device must be present in the list returned by findalldevs()" );
ok( keys %devinfo >= 1, " - at least one device must be present in the hash filled by findalldevs()" );
%devs = map { $_ => 1 } @devs;
is( $devs{$dev}, 1, " - '$dev' must be present in the list returned by findalldevs()" );
SKIP: {
is( $devinfo{'any'}, 'Pseudo-device that captures on all interfaces',
" - checking pseudo-device description" ) and last if exists $devinfo{'any'};
skip "Pseudo-device not available", 1;
}
SKIP: {
is( $devinfo{'lo' }, 'Loopback device', " - checking loopback device description" )
and last if exists $devinfo{'lo'};
is( $devinfo{'lo0'}, 'Loopback device', " - checking loopback device description" )
and last if exists $devinfo{'lo0'};
skip "Can't predict loopback device description", 1;
}
}
# Testing lookupnet()
eval { $result = Net::Pcap::lookupnet($dev, \$net, \$mask, \$err) };
is( $@, '', "lookupnet()" );
SKIP: {
skip "error: $err. Skipping lookupnet() tests", 6 if $result == -1;
is( $err, '', " - \$err must be null: $err" ); $err = '';
is( $result, 0, " - \$result must be null: $result" );
isnt( $net, '', " - \$net isn't null: '$net' => ".dotquad($net) );
isnt( $mask, '', " - \$mask isn't null: '$mask' => ".dotquad($mask) );
like( dotquad($net), $ip_regexp, " - does \$net look like an IP address?" );
like( dotquad($mask), $ip_regexp, " - does \$mask look like an IP address?" );
}
}
sub dotquad {
my($na, $nb, $nc, $nd);
my($net) = @_ ;
$na = $net >> 24 & 255 ;
$nb = $net >> 16 & 255 ;
$nc = $net >> 8 & 255 ;
$nd = $net & 255 ;
return "$na.$nb.$nc.$nd"
}