#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
my $tests;
plan tests => $tests;
use Data::Dumper qw(Dumper);
use English qw( -no_match_vars );
use_ok 'Net::RawIP';
diag "Testing $Net::RawIP::VERSION";
{
my $rawip = Net::RawIP->new;
isa_ok($rawip, 'Net::RawIP');
#diag Dumper $rawip;
is($rawip->proto, 'tcp', 'default protocol is tcp');
ok($rawip->{pack});
isa_ok($rawip->{tcphdr}, 'Net::RawIP::tcphdr');
# TODO: is that empty element in the end really needed?
is_deeply($rawip->{tcphdr},
[0, 0, 0, 0, 5, 0, 0, 0, 0, 0, 0, 0, 0, 65535, 0, 0, ''],
'tcphdr is correct');
isa_ok($rawip->{iphdr}, 'Net::RawIP::iphdr');
is_deeply($rawip->{iphdr},
[4, 5, 16, 0, 0, 16384, 64, 6, 0, 0, 0],
'iphdr is correct');
#$rawip->ethnew('eth0');
#diag Dumper $rawip;
is_deeply([sort keys %$rawip], [qw(iphdr pack proto tcphdr)]);
BEGIN { $tests += 8; }
}
{
my $rawip = Net::RawIP->new({ udp => {} });
isa_ok($rawip, 'Net::RawIP');
is($rawip->proto, 'udp', 'protocol is set to udp');
my @iphdr_result = (4, 5, 16, 0, 0, 16384, 64, 17, 0, 0, 0);
my @udphdr_result = (0, 0, 0, 0, '');
isa_ok($rawip->{udphdr}, 'Net::RawIP::udphdr');
isa_ok($rawip->{iphdr}, 'Net::RawIP::iphdr');
#diag Dumper $rawip;
is_deeply($rawip->{udphdr}, \@udphdr_result);
is_deeply($rawip->{iphdr}, \@iphdr_result);
$rawip->set({
ip => {
saddr => 3,
daddr => 2,
},
udp => {
source => 55,
dest => 100,
data => 'payload',
},
});
@iphdr_result[9, 10] = (3, 2);
@udphdr_result[0, 1, 4] = (55, 100, 'payload');
is_deeply([sort keys %$rawip], [qw(iphdr pack proto udphdr)]);
is_deeply($rawip->{udphdr}, \@udphdr_result);
is_deeply($rawip->{iphdr}, \@iphdr_result);
$rawip->set({ ip => { saddr => 1, }, });
$iphdr_result[9] = 1;
is_deeply($rawip->{udphdr}, \@udphdr_result);
is_deeply($rawip->{iphdr}, \@iphdr_result);
my @array = $rawip->get();
is_deeply(\@array, [], 'empty get in list context');
my $request = {
ip => [qw(tos saddr daddr)],
tcp => [qw(psh syn urg ack rst fin)],
udp => [qw(source dest data)],
};
@array = $rawip->get($request);
is_deeply(\@array, [16, 1, 2, 55, 100, 'payload'], 'get in list context');
#diag Dumper \@array;
my $scalar = $rawip->get;
is_deeply($scalar, {}, 'empty get in scalar context');
$scalar = $rawip->get($request);
is_deeply($scalar, {
'tos' => 16,
'source' => 55,
'saddr' => 1,
'daddr' => 2,
'dest' => 100,
'data' => 'payload'
},
'get in scalar context');
#diag Dumper $scalar;
#$rawip->send(0,1);
BEGIN { $tests += 16; }
}
{
my $rawip = Net::RawIP->new({ udp => {} });
my $pack = $rawip->optset();
is($pack, $rawip->{pack});
my $data = 'load12345';
$pack = $rawip->optset(ip => {
type => [(7)],
data => [($data)],
});
is($pack, $rawip->{pack});
isa_ok($rawip->{optsip}, 'Net::RawIP::opt');
is_deeply($rawip->{optsip}, [[7], [11], ['load12345']]);
is_deeply($rawip->{udphdr}, [0, 0, 0, 0, '', [7, 11, 'load12345']]);
#diag Dumper $rawip;
my @res = $rawip->optget(ip => {});
is_deeply(\@res, [7, 11, 'load12345'], 'optget ip');
#diag Dumper \@res;
$rawip->optunset('ip');
#diag Dumper $rawip;
isnt(exists($rawip->{optsip}), 'optsip removed');
is_deeply($rawip->{udphdr}, [0, 0, 0, 0, '', 0], 'udphdr reset');
BEGIN { $tests += 8; }
}
{
my $rawip = Net::RawIP->new({ icmp => {} });
isa_ok($rawip, 'Net::RawIP');
is($rawip->proto, 'icmp', 'protocol is set to icmp');
#diag Dumper $rawip;
my @iphdr_result = (4, 5, 16, 0, 0, 16384, 64, 1, 0, 0, 0);
my @icmphdr_result = (0, 0, 0, 0, 0, 0, 0, 0, '');
isa_ok($rawip->{icmphdr}, 'Net::RawIP::icmphdr');
isa_ok($rawip->{iphdr}, 'Net::RawIP::iphdr');
#diag Dumper $rawip;
is_deeply($rawip->{icmphdr}, \@icmphdr_result);
is_deeply($rawip->{iphdr}, \@iphdr_result);
is_deeply([sort keys %$rawip], [qw(icmphdr iphdr pack proto)]);
BEGIN { $tests += 7; }
}
{
my $rawip = Net::RawIP->new({ generic => {} });
isa_ok($rawip, 'Net::RawIP');
is($rawip->proto, 'generic', 'protocol is set to generic');
#diag Dumper $rawip;
my @iphdr_result = (4, 5, 16, 0, 0, 16384, 64, 0, 0, 0, 0);
isa_ok($rawip->{generichdr}, 'Net::RawIP::generichdr');
isa_ok($rawip->{iphdr}, 'Net::RawIP::iphdr');
#diag Dumper $rawip;
is_deeply($rawip->{generichdr}, ['']);
is_deeply($rawip->{iphdr}, \@iphdr_result);
is_deeply([sort keys %$rawip], [qw(generichdr iphdr pack proto)]);
BEGIN { $tests += 7; }
}
{
eval {
Net::RawIP->new({ no_such => {} });
};
like($@, qr{'no_such' is not a valid key});
eval {
Net::RawIP->new({ generic => {}, tcp => {} });
};
like($@, qr{Duplicate protocols defined: 'tcp' and 'generic'});
BEGIN { $tests += 2; }
}
# TODO: pass constructor invalid fields
# TODO: test the content of the ->{pack} variable