Net-Frame
view release on metacpan or search on metacpan
lib/Net/Frame/Layer/UDP.pm view on Meta::CPAN
# Pad it if less than the required length
if (length($self->[$__raw]) < NF_UDP_HDR_LEN) {
$self->[$__raw] .= ("\x00" x (NF_UDP_HDR_LEN - length($self->[$__raw])));
}
my ($src, $dst, $len, $checksum, $payload) =
$self->SUPER::unpack('nnnn a*', $self->[$__raw])
or return;
$self->[$__src] = $src;
$self->[$__dst] = $dst;
$self->[$__length] = $len;
$self->[$__checksum] = $checksum;
$self->[$__payload] = $payload;
return $self;
}
sub getLength {
return NF_UDP_HDR_LEN;
}
sub computeLengths {
my $self = shift;
my ($layers) = @_;
my $len = $self->getLength;
my $start = 0;
my $last = $self;
for my $l (@$layers) {
$last = $l;
if (! $start) {
$start++ if $l->layer eq 'UDP';
next;
}
$len += $l->getLength;
}
if (defined($last->payload) && length($last->payload)) {
$len += length($last->payload);
}
$self->[$__length] = $len;
return 1;
}
sub computeChecksums {
my $self = shift;
my ($layers) = @_;
my $phpkt;
for my $l (@$layers) {
if ($l->layer eq 'IPv4') {
$phpkt = $self->SUPER::pack('a4a4CCn',
inetAton($l->src), inetAton($l->dst), 0, 17, $self->[$__length]);
}
elsif ($l->layer eq 'IPv6') {
$phpkt = $self->SUPER::pack('a*a*NnCC',
inet6Aton($l->src), inet6Aton($l->dst), $self->[$__length],
0, 0, 17);
}
}
$phpkt .= $self->SUPER::pack('nnnn',
$self->[$__src], $self->[$__dst], $self->[$__length], 0)
or return;
my $start = 0;
my $last = $self;
my $payload = '';
for my $l (@$layers) {
$last = $l;
if (! $start) {
$start++ if $l->layer eq 'UDP';
next;
}
$payload .= $l->pack;
}
if (defined($last->payload) && length($last->payload)) {
$payload .= $last->payload;
}
if (length($payload)) {
$phpkt .= $self->SUPER::pack('a*', $payload)
or return;
}
$self->[$__checksum] = inetChecksum($phpkt);
return 1;
}
our $Next = {
};
sub encapsulate {
my $self = shift;
return $Next->{$self->[$__dst]} || $Next->{$self->[$__src]}
|| $self->[$__nextLayer];
}
sub getKey {
my $self = shift;
return $self->layer.':'.$self->[$__src].'-'.$self->[$__dst];
}
sub getKeyReverse {
my $self = shift;
return $self->layer.':'.$self->[$__dst].'-'.$self->[$__src];
}
sub match {
my $self = shift;
my ($with) = @_;
return 1;
}
sub print {
( run in 0.591 second using v1.01-cache-2.11-cpan-e1769b4cff6 )