1#!perl -T
2use strict;
3use Test::More;
4use Net::Pcap;
5use lib 't';
6use Utils;
7
8my $total = 10;  # number of packets to process
9
10plan skip_all => "must be run as root" unless is_allowed_to_use_pcap();
11plan skip_all => "no network device available" unless find_network_device();
12plan tests => $total * 19 * 2 + 23;
13
14my $has_test_exception = eval "use Test::Exception; 1";
15
16my($dev,$pcap,$dumper,$dump_file,$err) = ('','','','');
17
18# Find a device and open it
19$dev = find_network_device();
20$pcap = Net::Pcap::open_live($dev, 1024, 1, 100, \$err);
21
22# Testing error messages
23SKIP: {
24    skip "Test::Exception not available", 2 unless $has_test_exception;
25
26    # open_offline() errors
27    throws_ok(sub {
28        Net::Pcap::open_offline()
29    }, '/^Usage: Net::Pcap::open_offline\(fname, err\)/',
30       "calling open_offline() with no argument");
31
32    throws_ok(sub {
33        Net::Pcap::open_offline(0, 0)
34    }, '/^arg2 not a reference/',
35       "calling open_offline() with incorrect argument type for arg2");
36
37}
38
39# Testing open_offline()
40eval q{ use File::Temp qw(:mktemp); $dump_file = mktemp('pcap-XXXXXX'); };
41$dump_file ||= "pcap-$$.dmp";
42
43# calling open_offline() with a non-existent file name
44eval { Net::Pcap::open_offline($dump_file, \$err) };
45is(   $@,   '', "open_offline() with non existent dump file" );
46isnt( $err, '', " - \$err is not null: $err" ); $err = '';
47
48# creating a dump file
49$dumper = Net::Pcap::dump_open($pcap, $dump_file);
50
51my $user_text = "Net::Pcap test suite";
52my $count = 0;
53my @data1 = ();
54
55sub store_packet {
56    my($user_data, $header, $packet) = @_;
57
58    pass( "process_packet() callback" );
59    is( $user_data, $user_text, " - user data is the expected text" );
60    ok( defined $header,        " - header is defined" );
61    isa_ok( $header, 'HASH',    " - header" );
62
63    for my $field (qw(len caplen tv_sec tv_usec)) {
64        ok( exists $header->{$field}, "    - field '$field' is present" );
65        ok( defined $header->{$field}, "    - field '$field' is defined" );
66        like( $header->{$field}, '/^\d+$/',
67            "    - field '$field' is a number: $header->{$field}" );
68    }
69
70    ok( $header->{caplen} <= $header->{len}, "    - caplen <= len" );
71
72    ok( defined $packet,        " - packet is defined" );
73    is( length $packet, $header->{caplen}, " - packet has the advertised size" );
74
75    Net::Pcap::dump($dumper, $header, $packet);
76    push @data1, [$header, $packet];
77    $count++;
78}
79
80Net::Pcap::loop($pcap, $total, \&store_packet, $user_text);
81is( $count, $total, "all packets processed" );
82
83Net::Pcap::dump_close($dumper);
84
85# now opening this dump file
86eval { $pcap = Net::Pcap::open_offline($dump_file, \$err) };
87is(   $@,   '', "open_offline() with existent dump file" );
88is(   $err, '', " - \$err must be null: $err" ); $err = '';
89ok( defined $pcap, " - \$pcap is defined" );
90isa_ok( $pcap, 'SCALAR', " - \$pcap" );
91isa_ok( $pcap, 'pcap_tPtr', " - \$pcap" );
92
93my($major, $minor, $swapped);
94
95eval { $major = Net::Pcap::major_version($pcap) };
96is(   $@,   '', "major_version()" );
97like( $major, '/^\d+$/', " - major is a number: $major" );
98
99eval { $minor = Net::Pcap::minor_version($pcap) };
100is(   $@,   '', "minor_version()" );
101like( $minor, '/^\d+$/', " - minor is a number: $minor" );
102
103eval { $swapped = Net::Pcap::is_swapped($pcap) };
104is(   $@,   '', "is_swapped()" );
105like( $swapped, '/^[01]$/', " - swapped is 0 or 1: $swapped" );
106
107$count = 0;
108my @data2 = ();
109
110sub read_packet {
111    my($user_data, $header, $packet) = @_;
112
113    pass( "process_packet() callback" );
114    is( $user_data, $user_text, " - user data is the expected text" );
115    ok( defined $header,        " - header is defined" );
116    isa_ok( $header, 'HASH',    " - header" );
117
118    for my $field (qw(len caplen tv_sec tv_usec)) {
119        ok( exists $header->{$field}, "    - field '$field' is present" );
120        ok( defined $header->{$field}, "    - field '$field' is defined" );
121        like( $header->{$field}, '/^\d+$/',
122            "    - field '$field' is a number: $header->{$field}" );
123    }
124
125    ok( $header->{caplen} <= $header->{len}, "    - caplen <= len" );
126
127    ok( defined $packet,        " - packet is defined" );
128    is( length $packet, $header->{caplen}, " - packet has the advertised size" );
129
130    push @data2, [$header, $packet];
131    $count++;
132}
133
134Net::Pcap::loop($pcap, $total, \&read_packet, $user_text);
135is( $count, $total, "all packets processed" );
136
137TODO: {
138    local $TODO = "caplen is sometimes wrong, dunno why";
139    is_deeply( \@data1, \@data2, "checking data" );
140}
141
142Net::Pcap::close($pcap);
143unlink($dump_file);
144
145
146# Testing open_offline() using known samples
147$dump_file = File::Spec->catfile(qw(t samples ping-ietf-20pk-be.dmp));
148eval { $pcap = Net::Pcap::open_offline($dump_file, \$err) };
149is(   $@,   '', "open_offline() with existent dump file" );
150is(   $err, '', " - \$err must be null: $err" ); $err = '';
151ok( defined $pcap, " - \$pcap is defined" );
152isa_ok( $pcap, 'SCALAR', " - \$pcap" );
153isa_ok( $pcap, 'pcap_tPtr', " - \$pcap" );
154
155Net::Pcap::close($pcap);
156
157