1
0
mirror of https://github.com/solemnwarning/ipxwrapper synced 2024-12-30 16:45:37 +01:00
ipxwrapper/tests/lib/IPXWrapper/DOSBoxClient.pm

114 lines
2.2 KiB
Perl
Raw Permalink Normal View History

# IPXWrapper test suite
# Copyright (C) 2023 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::DOSBoxClient;
use IO::Select;
use IO::Socket::INET;
use NetPacket::IPX;
use Test::Spec;
sub new
{
my ($class, $host, $port) = @_;
my $sock = IO::Socket::INET->new(
Proto => "udp",
PeerAddr => $host,
PeerPort => $port,
) or die("Can't create socket: $!");
my $reg_req = NetPacket::IPX->new(
tc => 0,
type => 2,
src_network => "00:00:00:00",
src_node => "00:00:00:00:00:00",
src_socket => 2,
dest_network => "00:00:00:00",
dest_node => "00:00:00:00:00:00",
dest_socket => 2,
data => "",
);
$sock->send($reg_req->encode())
or die("Can't send data: $!");
my $buf;
$sock->recv($buf, 1024, 0);
my $reg_response = NetPacket::IPX->decode($buf);
my $self = bless({
sock => $sock,
net => $reg_response->{dest_network},
node => $reg_response->{dest_node},
}, $class);
return $self;
}
sub net
{
my ($self) = @_;
return $self->{net};
}
sub node
{
my ($self) = @_;
return $self->{node};
}
sub send
{
my ($self, %options) = @_;
my $packet = NetPacket::IPX->new(%options);
my $enc_packet = $packet->encode();
$self->{sock}->send($enc_packet)
or die("Can't send data: $!");
}
sub recv_any
{
my ($self) = @_;
my @packets = ();
my $select = IO::Select->new($self->{sock});
while($select->can_read(0))
{
my $buf;
$self->{sock}->recv($buf, 2048);
my $pkt = NetPacket::IPX->decode($buf);
push(@packets, $pkt);
}
return @packets;
}
1;