File Coverage

blib/lib/NetPacket.pm
Criterion Covered Total %
statement 24 31 77.4
branch 1 2 50.0
condition n/a
subroutine 6 9 66.6
pod 0 5 0.0
total 31 47 65.9


line stmt bran cond sub pod time code
1             package NetPacket;
2             BEGIN {
3 12     12   4931 $NetPacket::AUTHORITY = 'cpan:YANICK';
4             }
5             # ABSTRACT: assemble/disassemble network packets at the protocol level
6             $NetPacket::VERSION = '1.6.0';
7 12     12   67 use strict;
  12         17  
  12         325  
8 12     12   49 use warnings;
  12         16  
  12         307  
9              
10 12     12   50 use parent 'Exporter';
  12         14  
  12         70  
11              
12             our @EXPORT_OK = qw(in_cksum htons htonl ntohs ntohl);
13              
14             our %EXPORT_TAGS = ( ALL => \@EXPORT_OK );
15              
16             #
17             # Utility functions useful for all modules
18             #
19              
20             # Calculate IP checksum
21              
22             sub in_cksum {
23              
24 7     7 0 11 my ($packet) = @_;
25 7         8 my ($plen, $short, $num, $count, $chk);
26              
27 7         10 $plen = length($packet);
28 7         19 $num = int($plen / 2);
29 7         9 $chk = 0;
30 7         9 $count = $plen;
31              
32 7         40 foreach $short (unpack("S$num", $packet)) {
33 247         163 $chk += $short;
34 247         188 $count = $count - 2;
35             }
36              
37 7 50       29 if($count == 1) {
38 0         0 $chk += unpack("C", substr($packet, $plen -1, 1));
39             }
40              
41             # add the two halves together (CKSUM_CARRY -> libnet)
42 7         21 $chk = ($chk >> 16) + ($chk & 0xffff);
43 7         29 return(~(($chk >> 16) + $chk) & 0xffff);
44             }
45              
46             # Network/host byte order conversion routines. Network byte order is
47             # defined as being big-endian.
48              
49             sub htons
50             {
51 7     7 0 10 my ($in) = @_;
52              
53 7         44 return(unpack('n*', pack('S*', $in)));
54             }
55              
56             sub htonl
57             {
58 0     0 0   my ($in) = @_;
59              
60 0           return(unpack('N*', pack('L*', $in)));
61             }
62              
63             sub ntohl
64             {
65 0     0 0   my ($in) = @_;
66              
67 0           return(unpack('L*', pack('N*', $in)));
68             }
69              
70             sub ntohs
71             {
72 0     0 0   my ($in) = @_;
73              
74 0           return(unpack('S*', pack('n*', $in)));
75             }
76              
77             #
78             # Module initialisation
79             #
80              
81             1;
82              
83             __END__