File Coverage

blib/lib/Net/Frame/Layer/IPv4.pm
Criterion Covered Total %
statement 162 192 84.3
branch 9 32 28.1
condition 2 4 50.0
subroutine 46 50 92.0
pod 10 10 100.0
total 229 288 79.5


line stmt bran cond sub pod time code
1             #
2             # $Id: IPv4.pm,v 7609c9d085d3 2018/03/15 15:17:19 gomor $
3             #
4             package Net::Frame::Layer::IPv4;
5 2     2   6769 use strict;
  2         11  
  2         62  
6 2     2   10 use warnings;
  2         4  
  2         61  
7              
8 2     2   507 use Net::Frame::Layer qw(:consts :subs);
  2         7  
  2         613  
9             require Exporter;
10             our @ISA = qw(Net::Frame::Layer Exporter);
11              
12             our %EXPORT_TAGS = (
13             consts => [qw(
14             NF_IPv4_HDR_LEN
15             NF_IPv4_PROTOCOL_ICMPv4
16             NF_IPv4_PROTOCOL_IGMP
17             NF_IPv4_PROTOCOL_IPIP
18             NF_IPv4_PROTOCOL_TCP
19             NF_IPv4_PROTOCOL_EGP
20             NF_IPv4_PROTOCOL_IGRP
21             NF_IPv4_PROTOCOL_CHAOS
22             NF_IPv4_PROTOCOL_UDP
23             NF_IPv4_PROTOCOL_IDP
24             NF_IPv4_PROTOCOL_DCCP
25             NF_IPv4_PROTOCOL_IPv6
26             NF_IPv4_PROTOCOL_IPv6ROUTING
27             NF_IPv4_PROTOCOL_IPv6FRAGMENT
28             NF_IPv4_PROTOCOL_IDRP
29             NF_IPv4_PROTOCOL_RSVP
30             NF_IPv4_PROTOCOL_GRE
31             NF_IPv4_PROTOCOL_ESP
32             NF_IPv4_PROTOCOL_AH
33             NF_IPv4_PROTOCOL_ICMPv6
34             NF_IPv4_PROTOCOL_EIGRP
35             NF_IPv4_PROTOCOL_OSPF
36             NF_IPv4_PROTOCOL_ETHERIP
37             NF_IPv4_PROTOCOL_PIM
38             NF_IPv4_PROTOCOL_VRRP
39             NF_IPv4_PROTOCOL_STP
40             NF_IPv4_PROTOCOL_SCTP
41             NF_IPv4_PROTOCOL_UDPLITE
42             NF_IPv4_MORE_FRAGMENT
43             NF_IPv4_DONT_FRAGMENT
44             NF_IPv4_RESERVED_FRAGMENT
45             )],
46             );
47             our @EXPORT_OK = (
48             @{$EXPORT_TAGS{consts}},
49             );
50              
51 2     2   18 use constant NF_IPv4_HDR_LEN => 20;
  2         13  
  2         140  
52 2     2   14 use constant NF_IPv4_PROTOCOL_ICMPv4 => 0x01;
  2         5  
  2         89  
53 2     2   12 use constant NF_IPv4_PROTOCOL_IGMP => 0x02;
  2         2  
  2         114  
54 2     2   13 use constant NF_IPv4_PROTOCOL_IPIP => 0x04;
  2         4  
  2         92  
55 2     2   12 use constant NF_IPv4_PROTOCOL_TCP => 0x06;
  2         4  
  2         94  
56 2     2   11 use constant NF_IPv4_PROTOCOL_EGP => 0x08;
  2         5  
  2         110  
57 2     2   15 use constant NF_IPv4_PROTOCOL_IGRP => 0x09;
  2         13  
  2         122  
58 2     2   14 use constant NF_IPv4_PROTOCOL_CHAOS => 0x10;
  2         11  
  2         116  
59 2     2   11 use constant NF_IPv4_PROTOCOL_UDP => 0x11;
  2         4  
  2         99  
60 2     2   12 use constant NF_IPv4_PROTOCOL_IDP => 0x16;
  2         5  
  2         80  
61 2     2   10 use constant NF_IPv4_PROTOCOL_DCCP => 0x21;
  2         4  
  2         110  
62 2     2   11 use constant NF_IPv4_PROTOCOL_IPv6 => 0x29;
  2         4  
  2         89  
63 2     2   10 use constant NF_IPv4_PROTOCOL_IPv6ROUTING => 0x2b;
  2         4  
  2         129  
64 2     2   14 use constant NF_IPv4_PROTOCOL_IPv6FRAGMENT => 0x2c;
  2         6  
  2         124  
65 2     2   13 use constant NF_IPv4_PROTOCOL_IDRP => 0x2d;
  2         3  
  2         136  
66 2     2   14 use constant NF_IPv4_PROTOCOL_RSVP => 0x2e;
  2         3  
  2         105  
67 2     2   13 use constant NF_IPv4_PROTOCOL_GRE => 0x2f;
  2         3  
  2         91  
68 2     2   12 use constant NF_IPv4_PROTOCOL_ESP => 0x32;
  2         3  
  2         93  
69 2     2   10 use constant NF_IPv4_PROTOCOL_AH => 0x33;
  2         3  
  2         108  
70 2     2   11 use constant NF_IPv4_PROTOCOL_ICMPv6 => 0x3a;
  2         4  
  2         97  
71 2     2   11 use constant NF_IPv4_PROTOCOL_EIGRP => 0x58;
  2         4  
  2         86  
72 2     2   12 use constant NF_IPv4_PROTOCOL_OSPF => 0x59;
  2         3  
  2         88  
73 2     2   13 use constant NF_IPv4_PROTOCOL_ETHERIP => 0x61;
  2         5  
  2         116  
74 2     2   15 use constant NF_IPv4_PROTOCOL_PIM => 0x67;
  2         5  
  2         170  
75 2     2   14 use constant NF_IPv4_PROTOCOL_VRRP => 0x70;
  2         4  
  2         95  
76 2     2   19 use constant NF_IPv4_PROTOCOL_STP => 0x76;
  2         4  
  2         90  
77 2     2   11 use constant NF_IPv4_PROTOCOL_SCTP => 0x84;
  2         3  
  2         107  
78 2     2   12 use constant NF_IPv4_PROTOCOL_UDPLITE => 0x88;
  2         3  
  2         116  
79 2     2   15 use constant NF_IPv4_MORE_FRAGMENT => 1;
  2         4  
  2         144  
80 2     2   17 use constant NF_IPv4_DONT_FRAGMENT => 2;
  2         5  
  2         130  
81 2     2   14 use constant NF_IPv4_RESERVED_FRAGMENT => 4;
  2         6  
  2         475  
82              
83             our @AS = qw(
84             id
85             ttl
86             src
87             dst
88             protocol
89             checksum
90             flags
91             offset
92             version
93             tos
94             length
95             hlen
96             options
97             noFixLen
98             );
99             __PACKAGE__->cgBuildIndices;
100             __PACKAGE__->cgBuildAccessorsScalar(\@AS);
101              
102             BEGIN {
103 2     2   22 my $osname = {
104             freebsd => [ \&_fixLenBsd, ],
105             netbsd => [ \&_fixLenBsd, ],
106             openbsd => [ \&_fixLenBsd, ],
107             darwin => [ \&_fixLenBsd, ],
108             };
109              
110 2   50     107 *_fixLen = $osname->{$^O}->[0] || \&_fixLenOther;
111             }
112              
113 2     2   18 no strict 'vars';
  2         33  
  2         95  
114              
115 2     2   28 use Carp;
  2         7  
  2         135  
116 2     2   1107 use Bit::Vector;
  2         2259  
  2         3867  
117              
118 0     0   0 sub _fixLenBsd { pack('v', shift) }
119 1     1   6 sub _fixLenOther { pack('n', shift) }
120              
121             sub new {
122             shift->SUPER::new(
123 1     1 1 16 version => 4,
124             tos => 0,
125             id => getRandom16bitsInt(),
126             length => NF_IPv4_HDR_LEN,
127             hlen => 5,
128             flags => 0,
129             offset => 0,
130             ttl => 128,
131             protocol => NF_IPv4_PROTOCOL_TCP,
132             checksum => 0,
133             src => '127.0.0.1',
134             dst => '127.0.0.1',
135             options => '',
136             noFixLen => 0,
137             @_,
138             );
139             }
140              
141             sub pack {
142 1     1 1 502 my $self = shift;
143              
144             # Here, we pack in this order: version, hlen (4 bits each)
145 1         15 my $version = Bit::Vector->new_Dec(4, $self->[$__version]);
146 1         5 my $hlen = Bit::Vector->new_Dec(4, $self->[$__hlen]);
147 1         7 my $v8 = $version->Concat_List($hlen);
148              
149             # Here, we pack in this order: flags (3 bits), offset (13 bits)
150 1         4 my $flags = Bit::Vector->new_Dec(3, $self->[$__flags]);
151 1         4 my $offset = Bit::Vector->new_Dec(13, $self->[$__offset]);
152 1         3 my $v16 = $flags->Concat_List($offset);
153              
154 1 50       6 my $len = ($self->[$__noFixLen] ? _fixLenOther($self->[$__length])
155             : _fixLen($self->[$__length]));
156              
157 1 50       10 $self->[$__raw] = $self->SUPER::pack('CCa*nnCCna4a4',
158             $v8->to_Dec,
159             $self->[$__tos],
160             $len,
161             $self->[$__id],
162             $v16->to_Dec,
163             $self->[$__ttl],
164             $self->[$__protocol],
165             $self->[$__checksum],
166             inetAton($self->[$__src]),
167             inetAton($self->[$__dst]),
168             ) or return undef;
169              
170 1         3 my $opt;
171 1 50       3 if ($self->[$__options]) {
172 0 0       0 $opt = $self->SUPER::pack('a*', $self->[$__options])
173             or return undef;
174 0         0 $self->[$__raw] = $self->[$__raw].$opt;
175             }
176              
177 1         9 $self->[$__raw];
178             }
179              
180             sub unpack {
181 1     1 1 5 my $self = shift;
182              
183 1 50       6 my ($verHlen, $tos, $len, $id, $flagsOffset, $ttl, $proto, $cksum, $src,
184             $dst, $payload) = $self->SUPER::unpack('CCnnnCCna4a4 a*', $self->[$__raw])
185             or return undef;
186              
187 1         6 my $v8 = Bit::Vector->new_Dec(8, $verHlen);
188 1         4 my $v16 = Bit::Vector->new_Dec(16, $flagsOffset);
189              
190             # Here, we unpack in this order: hlen, version (4 bits each)
191 1         5 $self->[$__hlen] = $v8->Chunk_Read(4, 0);
192 1         3 $self->[$__version] = $v8->Chunk_Read(4, 4);
193 1         2 $self->[$__tos] = $tos;
194 1         2 $self->[$__length] = $len;
195 1         2 $self->[$__id] = $id;
196             # Here, we unpack in this order: offset (13 bits), flags (3 bits)
197 1         3 $self->[$__offset] = $v16->Chunk_Read(13, 0);
198 1         3 $self->[$__flags] = $v16->Chunk_Read( 3, 13);
199 1         2 $self->[$__ttl] = $ttl;
200 1         2 $self->[$__protocol] = $proto;
201 1         2 $self->[$__checksum] = $cksum;
202 1         3 $self->[$__src] = inetNtoa($src);
203 1         3 $self->[$__dst] = inetNtoa($dst);
204 1         3 $self->[$__payload] = $payload;
205              
206 1 50       4 my ($options, $payload2) = $self->SUPER::unpack(
207             'a'. $self->getOptionsLength. 'a*', $self->[$__payload]
208             ) or return undef;
209              
210 1         3 $self->[$__options] = $options;
211 1         2 $self->[$__payload] = $payload2;
212              
213 1         5 $self;
214             }
215              
216             sub getLength {
217 1     1 1 1 my $self = shift;
218 1 50       5 $self->[$__hlen] > 0 ? $self->[$__hlen] * 4 : 0;
219             }
220              
221             sub getPayloadLength {
222 0     0 1 0 my $self = shift;
223 0         0 my $gLen = $self->getLength;
224 0 0       0 $self->[$__length] > $gLen ? $self->[$__length] - $gLen : 0;
225             }
226              
227             sub getOptionsLength {
228 1     1 1 2 my $self = shift;
229 1         3 my $gLen = $self->getLength;
230 1         3 my $hLen = NF_IPv4_HDR_LEN;
231 1 50       7 $gLen > $hLen ? $gLen - $hLen : 0;
232             }
233              
234             sub computeLengths {
235 0     0 1 0 my $self = shift;
236 0         0 my ($layers) = @_;
237              
238 0         0 my $hLen = NF_IPv4_HDR_LEN;
239 0 0       0 $hLen += length($self->[$__options]) if $self->[$__options];
240 0         0 $self->[$__hlen] = $hLen / 4;
241              
242 0         0 my $len = $hLen;
243 0         0 my $last;
244             my $start;
245 0         0 for my $l (@$layers) {
246 0 0       0 if (! $start) {
247 0 0       0 $start++ if $l->layer eq 'IPv4';
248 0         0 next;
249             }
250 0         0 $len += $l->getLength;
251 0         0 $last = $l;
252             }
253 0 0       0 if (defined($last->payload)) {
254 0         0 $len += length($last->payload);
255             }
256              
257 0         0 $self->length($len);
258              
259 0         0 return 1;
260             }
261              
262             sub computeChecksums {
263 0     0 1 0 my $self = shift;
264 0         0 my ($layers) = @_;
265              
266             # Reset the checksum if already filled by a previous pack
267 0 0       0 if ($self->[$__checksum]) {
268 0         0 $self->[$__checksum] = 0;
269             }
270              
271 0         0 $self->[$__checksum] = inetChecksum($self->pack);
272              
273 0         0 return 1;
274             }
275              
276             our $Next = {
277             NF_IPv4_PROTOCOL_ICMPv4() => 'ICMPv4',
278             NF_IPv4_PROTOCOL_IGMP() => 'IGMP',
279             NF_IPv4_PROTOCOL_IPIP() => 'IPv4',
280             NF_IPv4_PROTOCOL_TCP() => 'TCP',
281             NF_IPv4_PROTOCOL_EGP() => 'EGP',
282             NF_IPv4_PROTOCOL_IGRP() => 'IGRP',
283             NF_IPv4_PROTOCOL_CHAOS() => 'CHAOS',
284             NF_IPv4_PROTOCOL_UDP() => 'UDP',
285             NF_IPv4_PROTOCOL_IDP() => 'IDP',
286             NF_IPv4_PROTOCOL_DCCP() => 'DCCP',
287             NF_IPv4_PROTOCOL_IPv6() => 'IPv6',
288             NF_IPv4_PROTOCOL_IPv6ROUTING() => 'IPv6Routing',
289             NF_IPv4_PROTOCOL_IPv6FRAGMENT() => 'IPv6Fragment',
290             NF_IPv4_PROTOCOL_IDRP() => 'IDRP',
291             NF_IPv4_PROTOCOL_RSVP() => 'RSVP',
292             NF_IPv4_PROTOCOL_GRE() => 'GRE',
293             NF_IPv4_PROTOCOL_ESP() => 'ESP',
294             NF_IPv4_PROTOCOL_AH() => 'AH',
295             NF_IPv4_PROTOCOL_ICMPv6() => 'ICMPv6',
296             NF_IPv4_PROTOCOL_EIGRP() => 'EIGRP',
297             NF_IPv4_PROTOCOL_OSPF() => 'OSPF',
298             NF_IPv4_PROTOCOL_ETHERIP() => 'ETHERIP',
299             NF_IPv4_PROTOCOL_PIM() => 'PIM',
300             NF_IPv4_PROTOCOL_VRRP() => 'VRRP',
301             NF_IPv4_PROTOCOL_STP() => 'STP',
302             NF_IPv4_PROTOCOL_SCTP() => 'SCTP',
303             NF_IPv4_PROTOCOL_UDPLITE() => 'UDPLite',
304             };
305              
306             sub encapsulate {
307 1     1 1 8 my $self = shift;
308              
309 1 50       4 return $self->[$__nextLayer] if $self->[$__nextLayer];
310              
311 1   50     6 return $Next->{$self->[$__protocol]} || NF_LAYER_UNKNOWN;
312             }
313              
314             sub print {
315 1     1 1 4 my $self = shift;
316              
317 1         6 my $l = $self->layer;
318 1         23 my $buf = sprintf
319             "$l: version:%d hlen:%d tos:0x%02x length:%d id:%d\n".
320             "$l: flags:0x%02x offset:%d ttl:%d protocol:0x%02x checksum:0x%04x\n".
321             "$l: src:%s dst:%s",
322             $self->[$__version], $self->[$__hlen], $self->[$__tos],
323             $self->[$__length], $self->[$__id], $self->[$__flags],
324             $self->[$__offset], $self->[$__ttl], $self->[$__protocol],
325             $self->[$__checksum], $self->[$__src], $self->[$__dst];
326              
327 1 50       5 if ($self->[$__options]) {
328 0         0 $buf .= sprintf "\n$l: optionsLength:%d options:%s",
329             $self->getOptionsLength,
330             CORE::unpack('H*', $self->[$__options]);
331             }
332              
333 1         42 $buf;
334             }
335              
336             1;
337              
338             __END__