File Coverage

blib/lib/NetPacket.pm
Criterion Covered Total %
statement 25 32 78.1
branch 1 2 50.0
condition n/a
subroutine 6 9 66.6
pod 0 5 0.0
total 32 48 66.6


line stmt bran cond sub pod time code
1             #
2             # NetPacket - Base class for NetPacket::* object hierarchy.
3             #
4             # Checksumming added by Stephanie Wehner, atrak@itsx.com
5             #
6              
7             package NetPacket;
8             BEGIN {
9 10     10   927 $NetPacket::AUTHORITY = 'cpan:YANICK';
10             }
11             # ABSTRACT: assemble/disassemble network packets at the protocol level
12             $NetPacket::VERSION = '1.5.0';
13              
14 10     10   57 use strict;
  10         25  
  10         316  
15 10     10   50 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  10         17  
  10         1113  
16              
17              
18             BEGIN {
19 10     10   205 @ISA = qw(Exporter);
20              
21             # Items to export into callers namespace by default
22             # (move infrequently used names to @EXPORT_OK below)
23              
24 10         44 @EXPORT = qw(
25             );
26              
27             # Other items we are prepared to export if requested
28              
29 10         34 @EXPORT_OK = qw(in_cksum htons htonl ntohs ntohl
30             );
31              
32             # Tags:
33              
34 10         3442 %EXPORT_TAGS = (
35             ALL => [@EXPORT, @EXPORT_OK],
36             );
37              
38             }
39              
40             #
41             # Utility functions useful for all modules
42             #
43              
44             # Calculate IP checksum
45              
46             sub in_cksum {
47              
48 7     7 0 16 my ($packet) = @_;
49 7         10 my ($plen, $short, $num, $count, $chk);
50              
51 7         14 $plen = length($packet);
52 7         21 $num = int($plen / 2);
53 7         47 $chk = 0;
54 7         15 $count = $plen;
55              
56 7         50 foreach $short (unpack("S$num", $packet)) {
57 247         214 $chk += $short;
58 247         294 $count = $count - 2;
59             }
60              
61 7 50       39 if($count == 1) {
62 0         0 $chk += unpack("C", substr($packet, $plen -1, 1));
63             }
64              
65             # add the two halves together (CKSUM_CARRY -> libnet)
66 7         17 $chk = ($chk >> 16) + ($chk & 0xffff);
67 7         185 return(~(($chk >> 16) + $chk) & 0xffff);
68             }
69              
70             # Network/host byte order conversion routines. Network byte order is
71             # defined as being big-endian.
72              
73             sub htons
74             {
75 7     7 0 18 my ($in) = @_;
76              
77 7         103 return(unpack('n*', pack('S*', $in)));
78             }
79              
80             sub htonl
81             {
82 0     0 0   my ($in) = @_;
83              
84 0           return(unpack('N*', pack('L*', $in)));
85             }
86              
87             sub ntohl
88             {
89 0     0 0   my ($in) = @_;
90              
91 0           return(unpack('L*', pack('N*', $in)));
92             }
93              
94             sub ntohs
95             {
96 0     0 0   my ($in) = @_;
97              
98 0           return(unpack('S*', pack('n*', $in)));
99             }
100              
101             #
102             # Module initialisation
103             #
104              
105             1;
106              
107             __END__