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

#
# NetPacket - Base class for NetPacket::* object hierarchy.
#
# Checksumming added by Stephanie Wehner, [e-mail]
#

package NetPacket;
BEGIN {
  $NetPacket::AUTHORITY = 'cpan:YANICK';
}
# ABSTRACT: assemble/disassemble network packets at the protocol level
$NetPacket::VERSION = '1.5.0';

use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);


BEGIN {
    @ISA = qw(Exporter);

# Items to export into callers namespace by default
# (move infrequently used names to @EXPORT_OK below)

    @EXPORT = qw(
    );

# Other items we are prepared to export if requested

    @EXPORT_OK = qw(in_cksum htons htonl ntohs ntohl
    );

# Tags:

    %EXPORT_TAGS = (
    ALL         => [@EXPORT, @EXPORT_OK],
);

}

#
# Utility functions useful for all modules
#

# Calculate IP checksum

sub in_cksum {

    my ($packet) = @_;
    my ($plen, $short, $num,  $count, $chk);

    $plen = length($packet);
    $num = int($plen / 2);
    $chk = 0;
    $count = $plen;

    foreach $short (unpack("S$num", $packet)) {
        $chk += $short;
        $count = $count - 2;
    }

    if($count == 1) {
        $chk += unpack("C", substr($packet, $plen -1, 1));
    }

    # add the two halves together (CKSUM_CARRY -> libnet)
    $chk = ($chk >> 16) + ($chk & 0xffff);
    return(~(($chk >> 16) + $chk) & 0xffff);
}

# Network/host byte order conversion routines.  Network byte order is
# defined as being big-endian.

sub htons
{
    my ($in) = @_;

    return(unpack('n*', pack('S*', $in)));
}

sub htonl
{
    my ($in) = @_;

    return(unpack('N*', pack('L*', $in)));
}

sub ntohl
{
    my ($in) = @_;

    return(unpack('L*', pack('N*', $in)));
}

sub ntohs
{
    my ($in) = @_;

    return(unpack('S*', pack('n*', $in)));
}

#
# Module initialisation
#

1;

__END__