mirror of
https://github.com/solemnwarning/ipxwrapper
synced 2024-12-30 16:45:37 +01:00
129 lines
2.7 KiB
Perl
129 lines
2.7 KiB
Perl
|
use strict;
|
||
|
use warnings;
|
||
|
|
||
|
package NetPacket::IPXWrapper;
|
||
|
use parent qw(NetPacket);
|
||
|
|
||
|
use Carp;
|
||
|
|
||
|
sub new
|
||
|
{
|
||
|
my ($class, %packet) = @_;
|
||
|
|
||
|
foreach my $key(qw(type dest_network dest_node dest_socket
|
||
|
src_network src_node src_socket data))
|
||
|
{
|
||
|
croak("Missing $key argument") unless(defined($packet{$key}));
|
||
|
}
|
||
|
|
||
|
croak("Invalid type argument") unless($packet{type} =~ m/^\d+$/ && $packet{type} <= 255);
|
||
|
|
||
|
_check_address("destination", $packet{dest_network}, $packet{dest_node}, $packet{dest_socket});
|
||
|
_check_address("source", $packet{src_network}, $packet{src_node}, $packet{src_socket});
|
||
|
|
||
|
return bless(\%packet, $class);
|
||
|
}
|
||
|
|
||
|
sub _check_address
|
||
|
{
|
||
|
my ($direction, $network, $node, $socket) = @_;
|
||
|
|
||
|
my $OCTET = qr/[0-9A-F][0-9A-F]?/i;
|
||
|
|
||
|
croak("Invalid $direction network") unless($network =~ m/^$OCTET(:$OCTET){3}$/);
|
||
|
croak("Invalid $direction node") unless($node =~ m/^$OCTET(:$OCTET){5}$/);
|
||
|
croak("Invalid $direction socket") unless($socket =~ m/^\d+$/ && $socket <= 65535);
|
||
|
}
|
||
|
|
||
|
#
|
||
|
# Decode the packet
|
||
|
#
|
||
|
|
||
|
sub decode
|
||
|
{
|
||
|
my ($class, $pkt, $parent) = @_;
|
||
|
|
||
|
my $self = bless({
|
||
|
_parent => $parent,
|
||
|
_frame => $pkt,
|
||
|
}, $class);
|
||
|
|
||
|
if(defined($pkt))
|
||
|
{
|
||
|
# Use array slices to capture the appropriate number of bytes
|
||
|
# from each address field.
|
||
|
|
||
|
my (
|
||
|
$type,
|
||
|
@dst_network, @dst_node, $dst_socket,
|
||
|
@src_network, @src_node, $src_socket,
|
||
|
$length,
|
||
|
);
|
||
|
|
||
|
(
|
||
|
$type,
|
||
|
@dst_network[0..3], @dst_node[0..5], $dst_socket,
|
||
|
@src_network[0..3], @src_node[0..5], $src_socket,
|
||
|
$length,
|
||
|
) = unpack("C C4C6n C4C6n n", $pkt);
|
||
|
|
||
|
$self->{type} = $type;
|
||
|
|
||
|
$self->{dest_network} = _addr_to_string(@dst_network);
|
||
|
$self->{dest_node} = _addr_to_string(@dst_node);
|
||
|
$self->{dest_socket} = $dst_socket;
|
||
|
|
||
|
$self->{src_network} = _addr_to_string(@src_network);
|
||
|
$self->{src_node} = _addr_to_string(@src_node);
|
||
|
$self->{src_socket} = $src_socket;
|
||
|
|
||
|
$self->{data} = substr($pkt, 27);
|
||
|
|
||
|
return undef if($length != length($self->{data}));
|
||
|
}
|
||
|
|
||
|
return $self;
|
||
|
}
|
||
|
|
||
|
#
|
||
|
# Strip header from packet and return the data contained in it
|
||
|
#
|
||
|
|
||
|
sub strip {
|
||
|
my ($pkt) = @_;
|
||
|
return NetPacket::IPX->decode($pkt)->{data};
|
||
|
}
|
||
|
|
||
|
#
|
||
|
# Encode a packet
|
||
|
#
|
||
|
|
||
|
sub encode
|
||
|
{
|
||
|
my ($self) = @_;
|
||
|
|
||
|
return pack("C", $self->{type})
|
||
|
._addr_from_string($self->{dest_network})
|
||
|
._addr_from_string($self->{dest_node})
|
||
|
.pack("n", $self->{dest_socket})
|
||
|
._addr_from_string($self->{src_network})
|
||
|
._addr_from_string($self->{src_node})
|
||
|
.pack("n", $self->{src_socket})
|
||
|
.pack("n", length($self->{data}))
|
||
|
.$self->{data};
|
||
|
}
|
||
|
|
||
|
sub _addr_to_string
|
||
|
{
|
||
|
my (@bytes) = @_;
|
||
|
return join(":", map { sprintf("%02X", $_) } @bytes);
|
||
|
}
|
||
|
|
||
|
sub _addr_from_string
|
||
|
{
|
||
|
my ($string) = @_;
|
||
|
return join("", map { pack("C", hex($_)) } split(m/:/, $string));
|
||
|
}
|
||
|
|
||
|
1;
|