backup/ipxwrapper
1
0
Fork 0
mirror of https://github.com/solemnwarning/ipxwrapper synced 2024-12-30 16:45:37 +01:00
Code Issues Projects Releases Activity

Retry starting DOSBox during tests.

Browse Source
This commit is contained in:
Daniel Collins 2023-09-13 00:24:50 +01:00
parent 435df05496
commit 59d2bbd2b7
1 changed files with 91 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

140
tests/lib/IPXWrapper/DOSBoxServer.pm
View File

@ -29,6 +29,42 @@ 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} <<EOF;
[ipx]
@ -45,68 +81,74 @@ EOF
note(join(" ", @command));
# No need for error checking here - open3 throws on failure.
my $pid = open3(my $in, my $out, undef, @command);
my $self = bless({
xvfb_run_pid => $pid,
}, $class);
$self->{xvfb_run_pid} = open3(my $in, my $out, undef, @command);
my $output = "";
while(defined(my $line = <$out>))
# 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;
$line =~ s/[\r\n]//g;
if($line =~ m/^IPX: Connected to server\./)
{
# 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, $pid)
// die "Couldn't find DOSBox PID";
return $self;
}
}
die("Didn't get expected output from xvfb-run/dosbox:\n$output");
# 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) = @_;
# Kill DOSBox, then wait for xvfb-run to clean up.
kill(SIGTERM, $self->{dosbox_pid});
waitpid($self->{xvfb_run_pid}, 0);
$self->_stop();
}
1;