mirror of
https://github.com/xcat2/xcat-dep.git
synced 2026-09-12 12:36:23 +00:00
3c6ec97417
Two real processes stand in for a worker and the build it runs. The probe fails when the handler forwards to nobody, which is what the orchestrators did.
287 lines
11 KiB
Perl
287 lines
11 KiB
Perl
#!/usr/bin/perl
|
|
# Behaviour test for the wall-clock bound on emulated build steps. It DRIVES run_bounded with a
|
|
# command that hangs and asserts that the call returns, fails, and prints the evidence -- it never
|
|
# reads the source of the thing it tests.
|
|
#
|
|
# Every call under test runs in a forked child whose stdio is detached to a file, and the parent
|
|
# bounds that child itself. Without the bound in run_bounded the child would block forever; a child
|
|
# holding this test's stdout would block prove instead of failing it, so the failure of the code
|
|
# under test must show up as a FAILED assertion here, never as a hung suite.
|
|
use strict;
|
|
use warnings;
|
|
|
|
use File::Temp qw(tempdir);
|
|
use FindBin;
|
|
use POSIX ();
|
|
use Test::More;
|
|
|
|
use lib "$FindBin::Bin/../lib", "$FindBin::Bin/..";
|
|
use XCAT::BuildUtils qw(run_bounded emulated_build_timeout);
|
|
use BuildUtils qw(chroot_build_timeout);
|
|
|
|
my $tmp = tempdir(CLEANUP => 1);
|
|
my @strays;
|
|
# waitpid on an already-gone child sets $? to -1, and Test::Builder's END reads $? as the exit
|
|
# status. Save it, or a clean run reports "exited with -1".
|
|
END { local $?; for my $p (@strays) { kill('KILL', $p); waitpid($p, 0); } }
|
|
|
|
# drive(): run one run_bounded call in a detached child and wait at most {deadline} seconds for it.
|
|
# Returns the child's result plus whether it finished on its own -- "did not finish" is the assertion
|
|
# that catches an unbounded run_bounded, which would otherwise hang this test.
|
|
sub drive {
|
|
my (%a) = @_;
|
|
my $out = "$tmp/$a{name}.out";
|
|
my $res = "$tmp/$a{name}.res";
|
|
my $t0 = time;
|
|
|
|
my $pid = fork();
|
|
die "fork: $!" unless defined $pid;
|
|
if ($pid == 0) {
|
|
open(STDIN, '<', '/dev/null');
|
|
open(STDOUT, '>', $out) or POSIX::_exit(90);
|
|
open(STDERR, '>&', \*STDOUT);
|
|
POSIX::setpgid(0, 0);
|
|
my $r = eval {
|
|
run_bounded(cmd => $a{cmd}, timeout => $a{timeout},
|
|
sample => $a{sample}, label => $a{name}, out => \*STDOUT);
|
|
} || { ec => -99, timed_out => 0, elapsed => -1 };
|
|
if (open(my $fh, '>', $res)) { print {$fh} "$r->{ec} $r->{timed_out} $r->{elapsed}\n"; close($fh); }
|
|
POSIX::_exit(0);
|
|
}
|
|
POSIX::setpgid($pid, $pid);
|
|
|
|
my $deadline = $t0 + $a{deadline};
|
|
my $finished = 0;
|
|
while (time < $deadline) {
|
|
if (waitpid($pid, POSIX::WNOHANG()) == $pid) { $finished = 1; last; }
|
|
select(undef, undef, undef, 0.2);
|
|
}
|
|
# Reap unconditionally: an unreaped child keeps its group alive and the next test inherits it.
|
|
unless ($finished) { kill('KILL', -$pid); waitpid($pid, 0); }
|
|
|
|
my ($ec, $timed_out, $elapsed) = (-1, 0, -1);
|
|
if (open(my $fh, '<', $res)) { ($ec, $timed_out, $elapsed) = split(' ', <$fh> // ''); close($fh); }
|
|
my $text = '';
|
|
if (open(my $fh, '<', $out)) { local $/; $text = <$fh> // ''; close($fh); }
|
|
return { finished => $finished, ec => $ec, timed_out => $timed_out,
|
|
elapsed => $elapsed, out => $text, wall => time - $t0 };
|
|
}
|
|
|
|
# --- the budget itself -----------------------------------------------------------------------
|
|
is(emulated_build_timeout('amd64', 'amd64'), 900, 'a native build gets the native budget');
|
|
is(emulated_build_timeout('riscv64', 'amd64'), 9000,
|
|
'an emulated build gets ten times the native budget');
|
|
{
|
|
local $ENV{XCAT_DEP_BUILD_TIMEOUT} = 42;
|
|
is(chroot_build_timeout('noble-riscv64-sbuild'), 42, 'XCAT_DEP_BUILD_TIMEOUT overrides the budget');
|
|
}
|
|
{
|
|
local %ENV = %ENV; delete $ENV{XCAT_DEP_BUILD_TIMEOUT};
|
|
is(chroot_build_timeout('noble-riscv64-sbuild'), 9000,
|
|
'a riscv64 chroot on this host derives the emulated budget');
|
|
}
|
|
|
|
# --- a command that exits normally is not touched --------------------------------------------
|
|
my $ok = drive(name => 'exit0', cmd => 'exit 0', timeout => 60, sample => 1, deadline => 30);
|
|
ok($ok->{finished}, 'a fast command returns');
|
|
is($ok->{ec}, 0, 'its exit status is 0');
|
|
is($ok->{timed_out}, 0, 'it is not reported as timed out');
|
|
|
|
my $bad = drive(name => 'exit3', cmd => 'exit 3', timeout => 60, sample => 1, deadline => 30);
|
|
is($bad->{ec}, 3, 'a failing command keeps its exit status');
|
|
|
|
# --- THE DEFECT: a build that hangs must fail, within the budget, with evidence ---------------
|
|
my $hang = drive(name => 'hang', cmd => 'exec sleep 600 >/dev/null 2>&1',
|
|
timeout => 4, sample => 2, deadline => 90);
|
|
ok($hang->{finished}, 'a hanging command does NOT hang the caller')
|
|
or BAIL_OUT('run_bounded never returned: the bound is missing, so a hung build has no failure');
|
|
is($hang->{timed_out}, 1, 'the hang is reported as a timeout');
|
|
is($hang->{ec}, 124, 'the timeout exit status is 124, as timeout(1) uses');
|
|
cmp_ok($hang->{wall}, '<', 60, 'it fails soon after the budget, not later');
|
|
like($hang->{out}, qr/exceeded its 4s budget/, 'the failure names the budget it exceeded');
|
|
like($hang->{out}, qr/stall report: process group \d+/, 'it prints the process group');
|
|
like($hang->{out}, qr/PID\s+PPID\s+STAT\s+TICKS\s+DELTA\s+WCHAN\s+CMD/, 'it prints the process tree');
|
|
like($hang->{out}, qr/sockets: \d+/, 'it prints the open socket count');
|
|
like($hang->{out}, qr/CPU ticks consumed by the whole group during the sample: 0/,
|
|
'it samples CPU ticks and finds none');
|
|
like($hang->{out}, qr/DEADLOCKED, not slow/, 'it says the build was deadlocked rather than slow');
|
|
|
|
# --- a busy build is reported differently, so the sample means something ----------------------
|
|
my $busy = drive(name => 'busy', cmd => 'exec bash -c "while :; do :; done" >/dev/null 2>&1',
|
|
timeout => 4, sample => 2, deadline => 90);
|
|
ok($busy->{finished}, 'a spinning command is also bounded');
|
|
is($busy->{timed_out}, 1, 'the spin is reported as a timeout');
|
|
like($busy->{out}, qr/still consumes CPU/, 'a spinning build is NOT called deadlocked');
|
|
unlike($busy->{out}, qr/DEADLOCKED/, 'the CPU sample distinguishes a slow build from a deadlock');
|
|
|
|
# --- the whole process group dies, not just the shell ----------------------------------------
|
|
my $pidfile = "$tmp/grandchild.pid";
|
|
my $tree = drive(name => 'tree',
|
|
cmd => "sleep 600 >/dev/null 2>&1 & echo \$! > $pidfile; wait",
|
|
timeout => 4, sample => 1, deadline => 90);
|
|
ok($tree->{finished}, 'a command with a child of its own is bounded too');
|
|
my $gpid = 0;
|
|
if (open(my $fh, '<', $pidfile)) { chomp($gpid = <$fh> // 0); close($fh); }
|
|
ok($gpid > 0, 'the grandchild recorded its pid');
|
|
push @strays, $gpid if $gpid > 0;
|
|
my $alive = 1;
|
|
for (1 .. 50) { $alive = (-d "/proc/$gpid") ? 1 : 0; last unless $alive; select(undef, undef, undef, 0.2); }
|
|
is($alive, 0, 'the grandchild is killed with the group, so nothing survives holding the pipe');
|
|
|
|
# A signal to the orchestrator must reach the build. Without forwarding, the wrapper dies and
|
|
# releases its locks while the build keeps running and writing into staging, so the next run races
|
|
# an orphan it cannot see. The child records its own pid, the wrapper is terminated, and the pid is
|
|
# probed afterwards.
|
|
{
|
|
my $dir = tempdir( CLEANUP => 1 );
|
|
my $pidfile = "$dir/child.pid";
|
|
|
|
my $wrapper = fork();
|
|
die "fork failed: $!" unless defined $wrapper;
|
|
if ( $wrapper == 0 ) {
|
|
# long budget: the bound must NOT be what ends this run -- the signal must be
|
|
run_bounded(
|
|
cmd => "echo \$\$ > '$pidfile'; exec sleep 300",
|
|
timeout => 600,
|
|
label => 'cancellation probe',
|
|
out => \*STDERR,
|
|
);
|
|
POSIX::_exit(0);
|
|
}
|
|
|
|
my $child;
|
|
for ( 1 .. 100 ) {
|
|
if ( -s $pidfile ) {
|
|
open my $fh, '<', $pidfile or last;
|
|
chomp( $child = <$fh> // '' );
|
|
close $fh;
|
|
last if $child;
|
|
}
|
|
select( undef, undef, undef, 0.1 );
|
|
}
|
|
|
|
SKIP: {
|
|
skip 'child never reported its pid', 2 unless $child;
|
|
ok( kill( 0, $child ), 'the build is running before the wrapper is signalled' );
|
|
|
|
kill 'TERM', $wrapper;
|
|
waitpid( $wrapper, 0 );
|
|
|
|
my $alive = 1;
|
|
for ( 1 .. 100 ) {
|
|
$alive = kill( 0, $child );
|
|
last unless $alive;
|
|
select( undef, undef, undef, 0.1 );
|
|
}
|
|
ok( !$alive, 'terminating the wrapper reaps the build it started' );
|
|
kill 'KILL', $child if $alive;
|
|
}
|
|
}
|
|
|
|
# The same must hold with no deadline. An unbounded run used to call system(), which leaves the
|
|
# build in the orchestrator's own process group: a directed signal then killed the orchestrator and
|
|
# left the build writing into staging.
|
|
{
|
|
my $dir = tempdir( CLEANUP => 1 );
|
|
my $pidfile = "$dir/child.pid";
|
|
|
|
my $wrapper = fork();
|
|
die "fork failed: $!" unless defined $wrapper;
|
|
if ( $wrapper == 0 ) {
|
|
run_bounded(
|
|
cmd => "echo \$\$ > '$pidfile'; exec sleep 300",
|
|
timeout => 0,
|
|
label => 'unbounded cancellation probe',
|
|
out => \*STDERR,
|
|
);
|
|
POSIX::_exit(0);
|
|
}
|
|
|
|
my $child;
|
|
for ( 1 .. 100 ) {
|
|
if ( -s $pidfile ) {
|
|
open my $fh, '<', $pidfile or last;
|
|
chomp( $child = <$fh> // '' );
|
|
close $fh;
|
|
last if $child;
|
|
}
|
|
select( undef, undef, undef, 0.1 );
|
|
}
|
|
|
|
SKIP: {
|
|
skip 'child never reported its pid', 2 unless $child;
|
|
ok( kill( 0, $child ), 'the unbounded build is running before the wrapper is signalled' );
|
|
|
|
kill 'TERM', $wrapper;
|
|
waitpid( $wrapper, 0 );
|
|
|
|
my $alive = 1;
|
|
for ( 1 .. 100 ) {
|
|
$alive = kill( 0, $child );
|
|
last unless $alive;
|
|
select( undef, undef, undef, 0.1 );
|
|
}
|
|
ok( !$alive, 'terminating the wrapper reaps an unbounded build too' );
|
|
kill 'KILL', $child if $alive;
|
|
}
|
|
}
|
|
|
|
# forward_signals_to_workers: the orchestrator forks its own workers, so run_bounded's forwarding
|
|
# never sees a signal sent to it. Two real processes stand in for a worker and the build it runs.
|
|
{
|
|
my $dir = tempdir( CLEANUP => 1 );
|
|
my $pidfile = "$dir/worker.pid";
|
|
|
|
my $wrapper = fork();
|
|
die "fork failed: $!" unless defined $wrapper;
|
|
if ( $wrapper == 0 ) {
|
|
my %kids;
|
|
my $worker = fork();
|
|
if ( defined $worker && $worker == 0 ) {
|
|
open my $fh, '>', $pidfile or POSIX::_exit(1);
|
|
print {$fh} "$$\n";
|
|
close $fh;
|
|
sleep 300;
|
|
POSIX::_exit(0);
|
|
}
|
|
$kids{$worker} = 1;
|
|
my $forward = XCAT::BuildUtils::forward_signals_to_workers(
|
|
pids => \%kids,
|
|
reap => sub { waitpid( $_, 0 ) for keys %kids },
|
|
);
|
|
local $SIG{TERM} = $forward;
|
|
sleep 300;
|
|
POSIX::_exit(0);
|
|
}
|
|
|
|
my $worker;
|
|
for ( 1 .. 100 ) {
|
|
if ( -s $pidfile ) {
|
|
open my $fh, '<', $pidfile or last;
|
|
chomp( $worker = <$fh> // '' );
|
|
close $fh;
|
|
last if $worker;
|
|
}
|
|
select( undef, undef, undef, 0.1 );
|
|
}
|
|
|
|
SKIP: {
|
|
skip 'worker never reported its pid', 2 unless $worker;
|
|
ok( kill( 0, $worker ), 'the worker is running before the orchestrator is signalled' );
|
|
|
|
kill 'TERM', $wrapper;
|
|
waitpid( $wrapper, 0 );
|
|
|
|
my $alive = 1;
|
|
for ( 1 .. 100 ) {
|
|
$alive = kill( 0, $worker );
|
|
last unless $alive;
|
|
select( undef, undef, undef, 0.1 );
|
|
}
|
|
ok( !$alive, 'signalling the orchestrator reaps its forked workers' );
|
|
kill 'KILL', $worker if $alive;
|
|
}
|
|
}
|
|
|
|
done_testing;
|