1
0
mirror of https://github.com/solemnwarning/ipxwrapper synced 2024-12-30 16:45:37 +01:00
Daniel Collins 5ff0855485 Replace test suite.
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.
2014-10-04 14:46:11 +01:00

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