# IPXWrapper test suite # Copyright (C) 2023 Daniel Collins # # 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::DOSBoxServer; use File::Temp; use IPC::Open3; use POSIX qw(:signal_h); use Proc::ProcessTable; use Test::Spec; sub new { my ($class, $port) = @_; my $self = bless({ xvfb_run_pid => undef, dosbox_pid => undef, }, $class); # For some reason DOSBox sometimes fails to start under Xvfb... so # retry a few times if that happens. for(my $i = 0; $i < 5; ++$i) { eval { $self->_start($port); }; if($@ eq "") { return $self; } elsif($@ !~ m/Couldn't open X11 display/) { last; } note("DOSBox startup failed, trying again."); note("Error was:\n$@"); $self->_stop(); } die $@; } sub _start { my ($self, $port) = @_; my $dosbox_conf = File::Temp->new(); print {$dosbox_conf} < "/dev/stdout", "stdbuf", "-i0", "-o0", "-e0", "dosbox", "-conf" => "$dosbox_conf"); note(join(" ", @command)); # No need for error checking here - open3 throws on failure. $self->{xvfb_run_pid} = open3(my $in, my $out, undef, @command); my $output = ""; # Read from child until we see what we expected or the pipe gets closed. while($output !~ m/^IPX: Connected to server\./m && defined(my $line = <$out>)) { $output .= $line; } # We can't kill DOSBox by sending a signal to xvfb-run since it doesn't # catch any signals and just dies, leaving orphan Xvfb and dosbox processes # running. # # So we have to walk the process table and find the dosbox process owned by # our xvfb-run process, which we can then directly kill and xvfb-run will # clean up the Xvfb instance. my @procs = @{ Proc::ProcessTable->new()->table() }; my $find_dosbox = sub { my ($find_dosbox, $ppid) = @_; foreach my $child(grep { $_->ppid() == $ppid } @procs) { # if($child->cmdline->[0] eq "dosbox") if($child->cmndline =~ m/^dosbox /) { return $child->pid; } my $dosbox_pid = $find_dosbox->($find_dosbox, $child->pid); return $dosbox_pid if(defined $dosbox_pid); } return; }; $self->{dosbox_pid} = $find_dosbox->($find_dosbox, $self->{xvfb_run_pid}); if($output =~ m/^IPX: Connected to server\./m) { die "Couldn't find DOSBox PID - did it crash?" unless(defined $self->{dosbox_pid}); return; } die "Didn't get expected output from xvfb-run/dosbox:\n$output"; } sub _stop { my ($self) = @_; # Kill DOSBox, then wait for xvfb-run to clean up. kill(SIGTERM, $self->{dosbox_pid}) if(defined $self->{dosbox_pid}); waitpid($self->{xvfb_run_pid}, 0) if(defined $self->{xvfb_run_pid}); $self->{dosbox_pid} = undef; $self->{xvfb_run_pid} = undef; } sub DESTROY { my ($self) = @_; $self->_stop(); } 1;