File Coverage

blib/lib/NetPacket/UDP.pm

Criterion	Covered	Total	%
statement	40	41	97.5
branch	4	6	66.6
condition			n/a
subroutine	10	10	100.0
pod	2	5	40.0
total	56	62	90.3

package NetPacket::UDP;
our $AUTHORITY = 'cpan:YANICK';
# ABSTRACT: Assemble and disassemble UDP (User Datagram Protocol) packets.
$NetPacket::UDP::VERSION = '1.7.2';
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
#

sub udp_strip {
  goto \&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

    no warnings;

    my $packet;
    if ($ip->isa('NetPacket::IPv6')) {
        $packet = $ip->pseudo_header($self->{len}, $proto);
    } else {
        my $src_ip = gethostbyname($ip->{src_ip});
        my $dest_ip = gethostbyname($ip->{dest_ip});

        $packet = pack 'a4a4CCn' =>

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

    $packet .= pack 'nnnna*' =>

      # 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__