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

144 lines
3.3 KiB
Perl

# IPXWrapper test suite
# Copyright (C) 2014 Daniel Collins <solemnwarning@solemnwarning.net>
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License version 2 as published by
# the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
# more details.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc., 51
# Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
use strict;
use warnings;
package IPXWrapper::SPX;
use Exporter qw(import);
our @EXPORT = qw(
perform_spxlookup
connect_to_spx_socket
pack_spxlookup_req
);
use IO::Socket::INET;
use Socket qw(pack_sockaddr_in inet_aton unpack_sockaddr_in inet_ntoa);
sub perform_spxlookup
{
my ($local_ip, $bcast_ip, $network, $node, $socket) = @_;
my $fmt_addr = sub
{
return join(":", map { sprintf("%02X", $_) } @_);
};
my $req = NetPacket::IPXWrapper->new(
type => 1,
dest_network => "00:00:00:00",
dest_node => "00:00:00:00:00:00",
dest_socket => 0,
src_network => "00:00:00:00",
src_node => "00:00:00:00:00:00",
src_socket => 0,
data => pack_spxlookup_req($network, $node, $socket),
)->encode();
my $sock = IO::Socket::INET->new(
Proto => "udp",
Broadcast => 1,
LocalAddr => $local_ip,
Blocking => 0,
) or die("Can't create socket: $!");
$sock->send($req, 0, pack_sockaddr_in(54792, inet_aton($bcast_ip)))
or die("Can't send data: $!");
sleep(1);
my @replies = ();
my $buffer;
while(defined(my $addr = $sock->recv($buffer, 256)))
{
my ($recv_port, $recv_ip) = unpack_sockaddr_in($addr);
my %reply = ();
if(length($buffer) == 32)
{
my (@network, @node, $socket, $port);
(@network[0..3], @node[0..5], $socket, $port)
= unpack("C4C6nn", $buffer);
$reply{network} = $fmt_addr->(@network);
$reply{node} = $fmt_addr->(@node);
$reply{socket} = $socket;
$reply{port} = $port;
$reply{ip} = inet_ntoa($recv_ip);
}
push(@replies, \%reply);
}
return @replies;
}
sub connect_to_spx_socket
{
my ($local_ip, $bcast_ip, $network, $node, $socket) = @_;
my @replies = perform_spxlookup($local_ip, $bcast_ip,
$network, $node, $socket);
die("Couldn't determine remote TCP port number")
if((scalar @replies) != 1);
my $sock = IO::Socket::INET->new(
Proto => "tcp",
LocalAddr => $local_ip,
PeerAddr => $replies[0]->{ip},
PeerPort => $replies[0]->{port},
Blocking => 0,
) or die("Can't connect: $!");
$sock->send(_pack_spxinit($network, $node, $socket))
or die("Can't send spxinit: $!");
return $sock;
}
sub pack_spxlookup_req
{
my ($network, $node, $socket) = @_;
return _pack_addr->($network)
._pack_addr->($node)
.pack("n", $socket)
.pack("C*", map { 0 } (1 .. 20)),
}
sub _pack_spxinit
{
my ($network, $node, $socket) = @_;
return _pack_addr->($network)
._pack_addr->($node)
.pack("n", $socket)
.pack("C*", map { 0 } (1 .. 20)),
}
sub _pack_addr
{
return pack("C*", map { hex($_) } split(m/:/, $_[0]));
}