view release on metacpan or  search on metacpan

lib/Net/Packet/UDP.pm  view on Meta::CPAN

#
# $Id: UDP.pm 2002 2015-02-15 16:50:35Z gomor $
#
package Net::Packet::UDP;
use strict;
use warnings;

require Net::Packet::Layer4;
our @ISA = qw(Net::Packet::Layer4);

use Net::Packet::Utils qw(inetChecksum getRandomHighPort inetAton inet6Aton);
use Net::Packet::Consts qw(:udp :layer);

our @AS = qw(
   src
   dst
   length
   checksum
);
__PACKAGE__->cgBuildIndices;
__PACKAGE__->cgBuildAccessorsScalar(\@AS);

no strict 'vars';

sub new {
   shift->SUPER::new(
      src      => getRandomHighPort(),
      dst      => 0,
      length   => 0,
      checksum => 0,
      @_,
   );
}

sub recv {
   my $self = shift;
   my ($frame) = @_;

   my $env = $frame->env;

   for ($env->dump->framesFor($frame)) {
      return $_ if $_->timestamp ge $frame->timestamp;
   }

   my $l2Key = ($frame->l2 && $frame->l2->getKeyReverse($frame))  || 'all';
   my $l3Key = ($frame->l3 && $frame->l3->is.':'.$frame->l3->src) || 'all';
   my $l4Key = ($frame->l4 && 'ICMP')                             || 'all';

   my $href = $env->dump->framesSorted;
   for (@{$href->{$l2Key}{$l3Key}{$l4Key}}) {
      if (($_->timestamp ge $frame->timestamp)
      &&   $_->l4->error
      &&  ($_->l4->error->l4->src == $self->src)
      &&  ($_->l4->error->l4->dst == $self->dst)) {
         return $_;
      }
   }

   undef;
}

sub pack {
   my $self = shift;

   $self->[$__raw] = $self->SUPER::pack('nnnn',
      $self->[$__src],
      $self->[$__dst],
      $self->[$__length],
      $self->[$__checksum],
   ) or return undef;

lib/Net/Packet/UDP.pm  view on Meta::CPAN

sub unpack {
   my $self = shift;

   my ($src, $dst, $len, $checksum, $payload) =
      $self->SUPER::unpack('nnnn a*', $self->[$__raw])
         or return undef;

   $self->[$__src]      = $src;
   $self->[$__dst]      = $dst;
   $self->[$__length]   = $len;
   $self->[$__checksum] = $checksum;
   $self->[$__payload]  = $payload;

   1;
}

sub getLength { NP_UDP_HDR_LEN }

sub getPayloadLength {
   my $self = shift;
   my $len  = $self->[$__length];
   my $gLen = $self->getLength;
   ($len > $gLen) ? do { $len - $gLen } : 0;
}

sub _computeTotalLength {
   my $self = shift;
   my ($l7) = @_;

   my $totalLength = $self->getLength;
   $totalLength += $l7->getLength if $l7;
   $self->[$__length] = $totalLength;
}

sub computeLengths {
   my $self = shift;
   my ($env, $l2, $l3, $l4, $l7) = @_;

   $self->_computeTotalLength($l7);
   1;
}

sub computeChecksums {
   my $self = shift;
   my ($env, $l2, $l3, $l4, $l7) = @_;

   my $phpkt;
   if ($l3) {
      if ($l3->isIpv4) {
         $phpkt = $self->SUPER::pack('a4a4CCn',
            inetAton($l3->src),
            inetAton($l3->dst),
            0,
            $l3->protocol,
            $self->[$__length],
         ) or return undef;
      }
      elsif ($l3->isIpv6) {
         $phpkt = $self->SUPER::pack('a*a*NnCC',
            inet6Aton($l3->src),
            inet6Aton($l3->dst),
            $l3->payloadLength,
            0,
            0,
            $l3->nextHeader,
         ) or return undef;
      }
   }
   else {
      my $totalLength = $self->getLength;
      $totalLength += $l7->getLength if $l7;

      if ($env->desc->isFamilyIpv4) {
         $phpkt = $self->SUPER::pack('a4a4CCn',
            inetAton($env->ip),
            inetAton($env->desc->target),
            0,
            $env->desc->protocol,
            $totalLength,
         ) or return undef;
      }
      elsif ($env->desc->isFamilyIpv6) {
         $phpkt = $self->SUPER::pack('a*a*NnCC',
            inet6Aton($env->ip6),
            inet6Aton($env->desc->target),
            $totalLength,
            0,
            0,
            $env->desc->protocol,
         ) or return undef;
      }
   }

   # Reset the checksum if already filled by a previous pack
   $self->[$__checksum] = 0;

   $phpkt .= $self->SUPER::pack('nnnn',
      $self->[$__src],
      $self->[$__dst],
      $self->[$__length],
      $self->[$__checksum],
   ) or return undef;

   if ($l7 && $l7->data) {
      $phpkt .= $self->SUPER::pack('a*', $l7->data)
         or return undef;
   }

   $self->[$__checksum] = inetChecksum($phpkt);

   1;
}

sub encapsulate { shift->[$__payload] ? NP_LAYER_7 : NP_LAYER_NONE }

sub getKey {
   my $self = shift;
   $self->is.':'.$self->[$__src].'-'.$self->[$__dst];
}

sub getKeyReverse {
   my $self = shift;
   $self->is.':'.$self->[$__dst].'-'.$self->[$__src];
}

sub print {
   my $self = shift;

   my $i = $self->is;
   my $l = $self->layer;
   sprintf
      "$l:+$i: src:%d  dst:%d  length:%d  checksum:0x%02x",
         $self->[$__src], $self->[$__dst], $self->[$__length],
         $self->[$__checksum];
}

1;

__END__

=head1 NAME

Net::Packet::UDP - User Datagram Protocol layer 4 object

=head1 SYNOPSIS