mirror of
https://github.com/solemnwarning/ipxwrapper
synced 2024-12-30 16:45:37 +01:00
Dump most of the old "unit" tests which were more system tests and only tested a small amount of functionality against the host. The new test suite is a lot more thorough and tests an arbitrary Windows version over the network rather than testing within the host's WinSock environment. More documentation detailing how to run this will follow.
254 lines
4.9 KiB
Perl
254 lines
4.9 KiB
Perl
use strict;
|
|
use warnings;
|
|
|
|
package NetPacket::IPX;
|
|
use parent qw(NetPacket);
|
|
|
|
use Carp;
|
|
|
|
sub new
|
|
{
|
|
my ($class, %packet) = @_;
|
|
|
|
foreach my $key(qw(tc type dest_network dest_node dest_socket
|
|
src_network src_node src_socket data))
|
|
{
|
|
croak("Missing $key argument") unless(defined($packet{$key}));
|
|
}
|
|
|
|
croak("Invalid tc argument") unless($packet{tc} =~ m/^\d+$/ && $packet{tc} <= 255);
|
|
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))
|
|
{
|
|
if(length($pkt) < 30)
|
|
{
|
|
carp("Truncated packet (incomplete header)");
|
|
return $self;
|
|
}
|
|
|
|
# Use array slices to capture the appropriate number of bytes
|
|
# from each address field.
|
|
|
|
my (
|
|
$checksum, $length, $tc, $type,
|
|
@dst_network, @dst_node, $dst_socket,
|
|
@src_network, @src_node, $src_socket,
|
|
);
|
|
|
|
(
|
|
$checksum, $length, $tc, $type,
|
|
@dst_network[0..3], @dst_node[0..5], $dst_socket,
|
|
@src_network[0..3], @src_node[0..5], $src_socket,
|
|
) = unpack("nnCC C4C6n C4C6n", $pkt);
|
|
|
|
$self->{tc} = $tc;
|
|
$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;
|
|
|
|
if($length < 30)
|
|
{
|
|
carp("Invalid packet (length < 30)");
|
|
return $self;
|
|
}
|
|
|
|
if(length($pkt) < $length)
|
|
{
|
|
carp("Truncated packet (data truncated)");
|
|
$self->{data} = substr($pkt, 30);
|
|
}
|
|
else{
|
|
$self->{data} = substr($pkt, 30, ($length - 30));
|
|
}
|
|
}
|
|
|
|
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("nnCC", 0xFFFF, 30 + length($self->{data}), $self->{tc}, $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})
|
|
.$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;
|
|
|
|
__END__
|
|
|
|
=pod
|
|
|
|
=head1 NAME
|
|
|
|
NetPacket::IPX - Assemble and disassemble IPX packets.
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use NetPacket::IPX;
|
|
|
|
my $ipx = NetPacket::IPX->decode($raw_pkt);
|
|
|
|
my $raw_pkt = $ipx->encode();
|
|
|
|
my $ipx = NetPacket::IPX->new(
|
|
tc => 0,
|
|
type => 1,
|
|
|
|
dest_network => "00:00:00:01",
|
|
dest_node => "FF:FF:FF:FF:FF:FF",
|
|
dest_socket => 1234,
|
|
|
|
src_network => "00:00:00:01",
|
|
src_node => "12:34:56:78:90:AB",
|
|
src_socket => 5678,
|
|
|
|
data => "...",
|
|
);
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
C<NetPacket::IPX> is a C<NetPacket> class for encoding and decoding IPX packets.
|
|
|
|
=head1 METHODS
|
|
|
|
=head2 decode($raw_pkt)
|
|
|
|
Decode a packet and return a C<NetPacket::IPX> instance.
|
|
|
|
=head2 encode()
|
|
|
|
Return the encoded form of a C<NetPacket::IPX> instance.
|
|
|
|
=head2 new(%options)
|
|
|
|
Construct a C<NetPacket::IPX> instance with arbitrary contents. All arguments
|
|
listed in the SYNOPSIS are mandatory.
|
|
|
|
Throws an exception on missing/invalid arguments.
|
|
|
|
=head1 INSTANCE DATA
|
|
|
|
The following fields are available in a C<NetPacket::IPX> instance:
|
|
|
|
=over
|
|
|
|
=item tc
|
|
|
|
Traffic Control field, the number of routers an IPX packet has passed through.
|
|
|
|
=item type
|
|
|
|
Type field.
|
|
|
|
=item dest_network
|
|
|
|
Destination network number, in the format C<XX:XX:XX:XX>.
|
|
|
|
=item dest_node
|
|
|
|
Destination node number, in the format C<XX:XX:XX:XX:XX:XX>.
|
|
|
|
=item dest_socket
|
|
|
|
Destination socket number.
|
|
|
|
=item src_network
|
|
|
|
Source network number, in the format C<XX:XX:XX:XX>.
|
|
|
|
=item dest_node
|
|
|
|
Source node number, in the format C<XX:XX:XX:XX:XX:XX>.
|
|
|
|
=item dest_socket
|
|
|
|
Source socket number.
|
|
|
|
=item data
|
|
|
|
Packet payload.
|
|
|
|
=back
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (C) 2014 Daniel Collins
|
|
|
|
This module is free software. You can redistribute it and/or
|
|
modify it under the same terms as Perl itself.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Daniel Collins E<lt>solemnwarning@solemnwarning.netE<gt>
|
|
|
|
=cut
|