File Coverage

blib/lib/NetPacket/UDP.pm

Criterion	Covered	Total	%
statement	37	37	100.0
branch	3	4	75.0
condition			n/a
subroutine	10	10	100.0
pod	2	4	50.0
total	52	55	94.5

package NetPacket::UDP;
BEGIN {
  $NetPacket::UDP::AUTHORITY = 'cpan:YANICK';
}
# ABSTRACT: Assemble and disassemble UDP (User Datagram Protocol) packets.
$NetPacket::UDP::VERSION = '1.6.0';
use strict;
use warnings;

use parent 'NetPacket';
use NetPacket::IP;

our @EXPORT_OK = qw(udp_strip);

our %EXPORT_TAGS = (
    ALL         => [@EXPORT_OK],
    strip       => [qw(udp_strip)],
);

#
# Decode the packet
#

sub decode {
    my $class = shift;
    my($pkt, $parent) = @_;
    my $self = {};

    # Class fields

    $self->{_parent} = $parent;
    $self->{_frame} = $pkt;

    # Decode UDP packet

    if (defined($pkt)) {

	($self->{src_port}, $self->{dest_port}, $self->{len}, $self->{cksum},
	 $self->{data}) = unpack("nnnna*", $pkt);
    }

    # Return a blessed object

    bless($self, $class);
    return $self;
}

#
# Strip header from packet and return the data contained in it
#

undef &udp_strip;
*udp_strip = \&strip;

sub strip {
    return decode(__PACKAGE__,shift)->{data};
}

#
# Encode a packet
#

sub encode {
    my ($self, $ip) = @_;

    # Adjust the length accordingly
    $self->{len} = 8 + length($self->{data});

    # First of all, fix the checksum
    $self->checksum($ip);

    # Put the packet together
    return pack("nnnna*", $self->{src_port},$self->{dest_port},
                $self->{len}, $self->{cksum}, $self->{data});

}

#
# UDP Checksum
#

sub checksum {

    my( $self, $ip ) = @_;

    my $proto = NetPacket::IP::IP_PROTO_UDP;

    # Pack pseudo-header for udp checksum

    my $src_ip = gethostbyname($ip->{src_ip});
    my $dest_ip = gethostbyname($ip->{dest_ip});

    no warnings;

    my $packet = pack 'a4a4CCnnnnna*' =>

      # fake ip header part
      $src_ip, $dest_ip, 0, $proto, $self->{len},

      # proper UDP part
      $self->{src_port}, $self->{dest_port}, $self->{len}, 0, $self->{data};

    $packet .= "\x00" if length($packet) % 2;

    $self->{cksum} = NetPacket::htons(NetPacket::in_cksum($packet));

}

1;

__END__