xCAT/xcat-core
2
0
Fork 0
mirror of https://github.com/xcat2/xcat-core.git synced 2026-09-26 01:34:05 +00:00
Code Issues Releases Wiki Activity

Merge pull request #7853 from VersatusHPC/fix/installmon-per-node-fork

Browse Source 
fix(xcat-core): one node's request to the install monitor blocks every other node
This commit is contained in:
Daniel Hilst
2026-09-24 10:26:10 -03:00
committed by GitHub
parent b72fd46366 5ac62ebb51
commit a0dc423809
2 changed files with 826 additions and 80 deletions
Download Patch File Download Diff File Expand all files Collapse all files
xCAT-server/sbin/xcatd
+240 -80
View File
@@ -338,6 +338,97 @@ my $rescanwritepipe;
my $rescanrselect;
my $rescanrequest = "rescanplugins";
# The install monitor gives each connection its own handler process, so a slow request from one
# node does not hold up the others.
#
# Requests for one node are answered in the order they arrived, and the parent owns that
# ordering. %installm_busy names the handler serving a node and %installm_queue holds the
# connections accepted for that node meanwhile. The next one is forked when the handler ahead
# of it is reaped, so a handler that dies cannot release the one behind it early.
my %installm_kids; # handler pid -> node
my %installm_busy; # node -> handler pid
my %installm_queue; # node -> [ [ connection, peer address ], ... ]
my $installm_maxkids = 64;
# Under the systemd TimeoutStopSec of 30 seconds, so the drain finishes before the kill.
my $installm_drain_seconds = 20;
# How long the parent waits for a connection while it still holds queued ones. SIGCHLD only
# wakes a wait that is already running, so a handler that exits just before the wait begins
# interrupts nothing. The bound is the parent's own second look.
my $installm_wakeup_seconds = 1;
# One path, so a test can point the lifted routine somewhere else.
my $installm_pidfile = "/var/run/xcat/installservice.pid";
# Account for finished handlers. With $block set, wait for one to finish first.
sub reap_installm_kids {
my ($block) = @_;
my $pid = waitpid(-1, $block ? 0 : WNOHANG);
while ($pid > 0) {
my $node = delete $installm_kids{$pid};
if (defined $node and ($installm_busy{$node} || 0) == $pid) {
delete $installm_busy{$node};
}
$pid = waitpid(-1, WNOHANG);
}
# ECHILD is the only answer that means there is nothing left to account for. An interrupted
# wait answers -1 as well, and clearing on that loses track of live handlers.
if ($pid < 0 and $! == ECHILD) {
%installm_kids = ();
%installm_busy = ();
}
return;
}
# The next queued connection whose node has no handler running, as (node, connection, peer
# address), or the empty list. Fetch each queue into a variable: dereferencing the hash element
# creates an entry for a node that has none.
sub dequeue_installm_request {
foreach my $node (keys %installm_queue) {
next if exists $installm_busy{$node};
my $queued = $installm_queue{$node};
unless ($queued and @{$queued}) {
delete $installm_queue{$node};
next;
}
my $entry = shift @{$queued};
delete $installm_queue{$node} unless @{$queued};
return ($node, @{$entry});
}
return ();
}
# --------------------------------------------------------------------------------
=head3 wait_for_installm_connection
Descriptions:
Wait until the install monitor has a connection to accept.
Arguments:
socket: the listening socket
seconds: how long to wait, or undef to wait until a connection arrives
Returns:
1 - the socket has a connection to accept
0 - the wait ended without one, so the caller looks at its queue again
=cut
# --------------------------------------------------------------------------------
sub wait_for_installm_connection {
my ($socket, $seconds) = @_;
# USR2 closes the socket under the monitor. There is nothing to wait for then.
my $fd = fileno($socket);
return 0 unless defined $fd;
my $waiting = '';
vec($waiting, $fd, 1) = 1;
my $ready = select($waiting, undef, undef, $seconds);
return (defined $ready and $ready > 0) ? 1 : 0;
}
sub do_installm_service {
unless ($sport) { return; }
@@ -346,9 +437,13 @@ sub do_installm_service {
my $installpidfile;
my $retry = 1;
$SIG{TERM} = $SIG{INT} = 'DEFAULT';
# The monitor accounts for its own handlers, so this must not reap. It exists to interrupt
# the accept below: a handler that exits may have left a connection queued for its node,
# and without the interruption that connection waits for the next unrelated client.
$SIG{CHLD} = sub { };
$SIG{USR2} = sub {
if ($socket) { # do not mess with pid file except when we still have the socket.
unlink("/var/run/xcat/installservice.pid"); close($socket); $quit = 1;
unlink($installm_pidfile); close($socket); $quit = 1;
$udpctl = 0;
xCAT::MsgUtils->message("S", "xcatd install monitor $$ quiescing");
}
@@ -364,7 +459,7 @@ sub do_installm_service {
ReuseAddr => 1,
Listen => 8192);
}
if (not $socket and open($installpidfile, "<", "/var/run/xcat/installservice.pid")) { # if we couldn't get the socket, go to pid to figure out current owner
if (not $socket and open($installpidfile, "<", $installm_pidfile)) { # if we couldn't get the socket, go to pid to figure out current owner
# TODO: lsof or similar may be a more accurate measure
my $pid = <$installpidfile>;
if ($pid) {
@@ -396,7 +491,7 @@ sub do_installm_service {
}
# we have the socket, now we claim the pid file as our own
open($installpidfile, ">", "/var/run/xcat/installservice.pid"); # if here, everyone else has unlinked installservicepid or doesn't care
open($installpidfile, ">", $installm_pidfile); # if here, everyone else has unlinked installservicepid or doesn't care
print $installpidfile $$;
close($installpidfile);
xCAT::MsgUtils->trace(0, "I", "xcatd: install monitor process $$ start");
@@ -407,93 +502,150 @@ sub do_installm_service {
my $node;
my $validclient = 0;
next unless $conn = $socket->accept;
eval {
# check if a rescanplugins request has come in
my @rescans;
if (@rescans = $rescanrselect->can_read(0)) {
foreach my $rrequest (@rescans) {
my $rescan_request = fd_retrieve($rrequest);
if ($$rescan_request =~ /rescanplugins/) {
scan_plugins('', '1');
} else {
xCAT::MsgUtils->trace(0, "W", "xcatd: ignoring unrecognized pipe request received by install monitor from ssl listener: $rescan_request.");
# A handler that finished may have left a connection waiting for its node. SIGCHLD
# interrupts the accept below, so the parent comes back here to look.
reap_installm_kids(0);
($node, $conn, $conn_peer_addr) = dequeue_installm_request();
# Nothing was queued, so take a new connection and name its peer.
unless (defined $conn) {
# A handler can exit between the check above and the accept below, where the
# SIGCHLD has no accept to interrupt. Bound the wait while connections are queued,
# so the parent looks again instead of waiting for the next unrelated client.
next unless wait_for_installm_connection($socket,
%installm_queue ? $installm_wakeup_seconds : undef);
next unless $conn = $socket->accept;
eval {
# check if a rescanplugins request has come in
my @rescans;
if (@rescans = $rescanrselect->can_read(0)) {
foreach my $rrequest (@rescans) {
my $rescan_request = fd_retrieve($rrequest);
if ($$rescan_request =~ /rescanplugins/) {
scan_plugins('', '1');
} else {
xCAT::MsgUtils->trace(0, "W", "xcatd: ignoring unrecognized pipe request received by install monitor from ssl listener: $rescan_request.");
}
}
}
}
$conn_peer_addr = $conn->peerhost();
xCAT::MsgUtils->trace(0, "I", "xcatd: install monitor received a connection request from $conn_peer_addr");
$conn_peer_addr = $conn->peerhost();
xCAT::MsgUtils->trace(0, "I", "xcatd: install monitor received a connection request from $conn_peer_addr");
my $client_name;
my $client_aliases;
my @clients;
if ($inet6support) {
($client_name, $client_aliases) = gethostbyaddr($conn->peeraddr, AF_INET6);
unless ($client_name) {
my $client_name;
my $client_aliases;
my @clients;
if ($inet6support) {
($client_name, $client_aliases) = gethostbyaddr($conn->peeraddr, AF_INET6);
unless ($client_name) {
($client_name, $client_aliases) = gethostbyaddr($conn->peeraddr, AF_INET);
}
} else {
($client_name, $client_aliases) = gethostbyaddr($conn->peeraddr, AF_INET);
}
} else {
($client_name, $client_aliases) = gethostbyaddr($conn->peeraddr, AF_INET);
}
unless ($client_name) {
die "XCATUNKOWNCLIENT"; # use die instead of next to avoid 'Exiting eval via next' message
}
$clients[0] = $client_name;
if ($client_aliases) {
push @clients, split(/\s+/, $client_aliases);
}
my $domain;
my %handled_client=();
foreach my $client (@clients) {
next if (exists $handled_client{$client});
$handled_client{$client}=1;
my @ndn = ($client);
my $nd = xCAT::NetworkUtils->getNodeDomains(\@ndn);
my %nodedomains = %{$nd};
$domain = $nodedomains{$client};
$client =~ s/\..*//;
if ($domain) {
$client =~ s/\.$domain//;
} else {
$client =~ s/\..*//;
unless ($client_name) {
die "XCATUNKOWNCLIENT"; # use die instead of next to avoid 'Exiting eval via next' message
}
# ensure this is coming from a node IP at least
($node) = noderange($client);
if ($node) { # Means the source isn't valid
#$validclient = 1;
xCAT::MsgUtils->trace(0, "I", "xcatd: $conn_peer_addr is matched with node $node");
last;
$clients[0] = $client_name;
if ($client_aliases) {
push @clients, split(/\s+/, $client_aliases);
}
my $domain;
my %handled_client=();
foreach my $client (@clients) {
next if (exists $handled_client{$client});
$handled_client{$client}=1;
my @ndn = ($client);
my $nd = xCAT::NetworkUtils->getNodeDomains(\@ndn);
my %nodedomains = %{$nd};
$domain = $nodedomains{$client};
$client =~ s/\..*//;
if ($domain) {
$client =~ s/\.$domain//;
} else {
$client =~ s/\..*//;
}
# ensure this is coming from a node IP at least
($node) = noderange($client);
if ($node) { # Means the source isn't valid
#$validclient = 1;
xCAT::MsgUtils->trace(0, "I", "xcatd: $conn_peer_addr is matched with node $node");
last;
}
}
unless ($node) {
xCAT::MsgUtils->trace(0, "E", "xcatd: received a connection request from $conn_peer_addr($client_name), which can not be found in xCAT nodelist table. The connection request will be ignored");
}
};
if ($@) {
$node = undef;
if ($@ =~ /XCATUNKOWNCLIENT/) {
xCAT::MsgUtils->trace(0, "E", "xcatd: received a connection request from unknown host with ip address $conn_peer_addr, please check whether the reverse name resolution works correctly. The connection request will be ignored");
} else {
xCAT::MsgUtils->trace(0, "E", "xcatd: possible BUG encountered by xCAT install monitor service: " . $@);
}
}
unless ($node) {
xCAT::MsgUtils->trace(0, "E", "xcatd: received a connection request from $conn_peer_addr($client_name), which can not be found in xCAT nodelist table. The connection request will be ignored");
close($conn);
sleep 0.01;
next;
}
};
if ($@) {
$node = undef;
if ($@ =~ /XCATUNKOWNCLIENT/) {
xCAT::MsgUtils->trace(0, "E", "xcatd: received a connection request from unknown host with ip address $conn_peer_addr, please check whether the reverse name resolution works correctly. The connection request will be ignored");
} else {
xCAT::MsgUtils->trace(0, "E", "xcatd: possible BUG encountered by xCAT install monitor service: " . $@);
if (exists $installm_busy{$node}) {
# The node has a handler already. Hold the connection unread until that handler is
# reaped, so the greeting and the answer keep the order the node sent them in.
$installm_queue{$node} ||= [];
push @{ $installm_queue{$node} }, [ $conn, $conn_peer_addr ];
next;
}
}
unless ($node) {
# A thousand nodes netbooting must not become a thousand handlers. Anything over the
# limit waits in the listen backlog, where an unaccepted connection costs nothing.
while (scalar(keys %installm_kids) >= $installm_maxkids) {
reap_installm_kids(1);
}
my $handler = xCAT::Utils->xfork();
if ($handler) {
$installm_kids{$handler} = $node;
$installm_busy{$node} = $handler;
close($conn);
sleep 0.01;
next;
}
if (defined $handler) {
# This handler answers one node and exits. It must not hold the listening socket or
# the connections queued for other nodes, and USR2 belongs to the process that owns
# the pid file.
$SIG{USR2} = 'DEFAULT';
$SIG{CHLD} = 'DEFAULT';
close($socket);
close($_->[0]) for map { @{$_} } values %installm_queue;
%installm_queue = ();
%installm_kids = ();
%installm_busy = ();
} else {
xCAT::MsgUtils->trace(0, "W", "xcatd: install monitor cannot fork, serving $node in line");
}
my $tftpdir = xCAT::TableUtils->getTftpDir();
eval {
alarm(2);
print $conn "ready\n";
while (my $text = <$conn>) {
alarm(0);
print $conn "done\n";
$text =~ s/\r//g;
# "done" releases the node. Every request but a destiny advance is answered
# before it runs, because its result does not change what the node does next.
# A destiny advance decides what the node boots, so the node waits for it --
# which costs no other node anything now that each connection has a handler of
# its own, and which lets the node retry a request whose handler died.
print $conn "done\n" unless ($text =~ /next/);
# Clear IP-Name cache, Workaround (#4913) for IP changed cases.
xCAT::NetworkUtils->clearcache();
if ($text =~ /next/) {
@@ -503,13 +655,9 @@ sub do_installm_service {
arg => ['next'],
);
# node should be blocked, race condition may occur otherwise
#my $pid=xCAT::Utils->xfork();
#unless ($pid) { # fork off the nodeset and potential slowness
xCAT::MsgUtils->trace(0, "I", "xcatd: triggering \'nodeset $node next\'...");
plugin_command(\%request, undef, \&build_response);
#exit(0);
#}
print $conn "done\n";
close($conn);
} elsif ($text =~ /installstatus/) {
my @tmpa = split(' ', $text);
@@ -526,13 +674,7 @@ sub do_installm_service {
} elsif ($newstat eq 'netbooting') {
xCAT::MsgUtils->trace(0, "I", "xcat.updatestatus - $node: provisioning detected...");
}
# node should be blocked, race condition may occur otherwise
#my $pid=xCAT::Utils->xfork();
#unless ($pid) { # fork off the nodeset and potential slowness
plugin_command(\%request, undef, \&build_response);
#exit(0);
#}
}
close($conn);
} elsif ($text =~ /^unlocktftpdir/) { # TODO: only nodes in install state should be allowed
@@ -632,12 +774,30 @@ sub do_installm_service {
close($conn);
}
}
xexit(0) if (defined $handler);
}
if (open($installpidfile, "<", "/var/run/xcat/installservice.pid")) {
# Handlers accepted before the stand-down finish their work here. Without this they are
# orphaned into the systemd service cgroup, where anything still running at TimeoutStopSec
# is killed -- after its "done" was already on the wire, so the node never retries.
# A queued connection has had no greeting, so closing it makes the client retry, by which
# time the next monitor owns the port.
close($_->[0]) for map { @{$_} } values %installm_queue;
%installm_queue = ();
my $drain_until = time() + $installm_drain_seconds;
while (%installm_kids and time() < $drain_until) {
reap_installm_kids(0);
sleep 0.05 if %installm_kids;
}
if (%installm_kids) {
xCAT::MsgUtils->trace(0, "W", "xcatd: install monitor stopped waiting for the requests of "
. join(", ", sort values %installm_kids));
}
if (open($installpidfile, "<", $installm_pidfile)) {
my $pid = <$installpidfile>;
if ($pid == $$) { # if our pid, unlink the file, otherwise, we managed to see the pid after someone else created it
unlink("/var/run/xcat/installservice.pid");
unlink($installm_pidfile);
}
close($installpidfile);
}
xCAT-test/unit/xcatd_install_monitor_concurrency.t
+586
View File
@@ -0,0 +1,586 @@
#!/usr/bin/env perl
#
# The install monitor serves every installing node. It must not make one node wait for another.
#
# do_installm_service() used to accept a connection, resolve the peer to a node and dispatch the
# request in line. While it dispatched, nothing else was accepted, so a node whose 'nodeset
# next' takes three seconds cost every other node in the cluster three seconds, and a plugin
# that ended the process took the monitor with it.
#
# Each connection now has a handler process of its own. Requests for one node keep the order
# they arrived in, and the parent owns that order: it holds the later connections and forks the
# next one when it reaps the handler ahead of it. A handler that dies therefore cannot release
# the one behind it early.
#
# xcatd cannot be loaded here -- it needs the database, SSL, the plugin tree and /var/run/xcat,
# and it starts serving at the bottom of the file. So do_installm_service is lifted out of the
# program text and run in a scratch package against stand-in plugins, on a port of its own. The
# clients are real TCP clients and the times are wall-clock. die if the lift stops matching, so
# this fails loudly rather than quietly covering nothing.
use strict;
use warnings;
use File::Temp qw(tempdir);
use FindBin;
use IO::Socket::INET;
use POSIX ();
use Socket;
use Test::More;
use Time::HiRes qw(gettimeofday sleep time);
my $XCATD = "$FindBin::Bin/../../xCAT-server/sbin/xcatd";
die "xcatd not found at $XCATD\n" unless -r $XCATD;
my $SLOW = 3; # seconds one node's request spends in its plugin
my $SCRATCH = tempdir(CLEANUP => 1);
# One file per case. A handler left over from an earlier case outlives the monitor that forked
# it, and would otherwise append to the case that is running now.
my $EVENTS = "$SCRATCH/events";
my $src = do {
open my $fh, '<', $XCATD or die "cannot read $XCATD: $!";
local $/;
<$fh>;
};
# A named sub in xcatd, from "sub name {" to the closing brace in the first column.
sub lift_sub {
my ($name) = @_;
my ($body) = $src =~ /^(sub \s+ \Q$name\E \s* \{ .*? ^ \} )/msx;
return $body;
}
my $service = lift_sub('do_installm_service')
or die "cannot lift do_installm_service out of xcatd -- the lift needs updating";
my $reaper = lift_sub('reap_installm_kids')
or die "xcatd no longer defines reap_installm_kids";
my $dequeue = lift_sub('dequeue_installm_request')
or die "xcatd no longer defines dequeue_installm_request";
my $waiter = lift_sub('wait_for_installm_connection')
or die "xcatd no longer defines wait_for_installm_connection";
# Settings the lifted routine reads from file-scope variables xcatd declares but this file does
# not lift. Read the defaults out of the source, so a rename fails here instead of silently
# leaving the monitor with an undefined limit, no drain, or the host's pid file.
my ($MAXKIDS) = $src =~ /^my \s+ \$installm_maxkids \s* = \s* (\d+) ;/mx;
$MAXKIDS or die "xcatd no longer declares \$installm_maxkids";
my ($DRAIN) = $src =~ /^my \s+ \$installm_drain_seconds \s* = \s* (\d+) ;/mx;
$DRAIN or die "xcatd no longer declares \$installm_drain_seconds";
my ($WAKEUP) = $src =~ /^my \s+ \$installm_wakeup_seconds \s* = \s* ([\d.]+) ;/mx;
$WAKEUP or die "xcatd no longer declares \$installm_wakeup_seconds";
my ($PIDFILE) = $src =~ /^my \s+ \$installm_pidfile \s* = \s* "([^"]+)" ;/mx;
$PIDFILE or die "xcatd no longer declares \$installm_pidfile";
is($PIDFILE, '/var/run/xcat/installservice.pid',
'the monitor still claims the pid file xcatd and its restart handshake use');
# One variable, so pointing it at the scratch tree below redirects the whole routine. A path
# written out again inside the routine would reach the host file whatever this test sets.
unlike($service, qr{/var/run/},
'the monitor reaches its pid file only through $installm_pidfile');
# The monitor writes a pid file. Point it at the scratch tree: the live monitor's file is how a
# restarting xcatd tells the running one to let go of the port, and a test that runs as root
# would otherwise leave this process's pid in it.
my $SCRATCH_PIDFILE = "$SCRATCH/installservice.pid";
my @HOST_PIDFILE = stat($PIDFILE);
# Every test client connects from 127.0.0.1, so the monitor's own reverse lookup cannot tell
# them apart. Name them in accept order instead.
our @PEER_QUEUE;
# Each entry answers one xfork: true forks, false fails. Empty means fork normally. A case sets
# it before the monitor starts, so the monitor's fork-failure fallback can be exercised.
our @FORK_PLAN;
BEGIN { *CORE::GLOBAL::gethostbyaddr = sub { return (shift(@main::PEER_QUEUE) || 'unknown', '') } }
# Whole microseconds. A %.3f stamp rounds, so an event can be recorded at a time LATER than the
# moment it was taken -- and an assertion that the event precedes a reading taken after it then
# fails on the rounding instead of on the order. gettimeofday rounds nothing.
sub now_us {
my ($seconds, $micros) = gettimeofday();
return $seconds * 1_000_000 + $micros;
}
# One line per plugin entry and exit, appended by whichever process is running it.
sub note_event {
my ($what) = @_;
open my $fh, '>>', $EVENTS or return;
printf {$fh} "%s %d\n", $what, now_us();
close $fh;
return;
}
sub events {
open my $fh, '<', $EVENTS or return ();
my @lines = <$fh>;
close $fh;
chomp @lines;
return @lines;
}
# The index of the first event whose text matches, or -1.
sub event_index {
my ($want) = @_;
my @all = events();
for my $i (0 .. $#all) {
return $i if $all[$i] =~ /^\Q$want\E /;
}
return -1;
}
sub event_time {
my ($want) = @_;
my $i = event_index($want);
return undef if $i < 0;
my @all = events();
my ($t) = $all[$i] =~ /\s(\d+)$/;
return $t;
}
# Wait for an event, up to $limit seconds.
sub wait_for_event {
my ($want, $limit) = @_;
my $until = time() + ($limit || 10);
while (time() < $until) {
return 1 if event_index($want) >= 0;
sleep 0.05;
}
return 0;
}
{
my $scratch = join "\n",
'package t::installm;',
'no strict;',
'no warnings;',
'use Fcntl qw/:DEFAULT :flock/;',
'use File::Path qw(mkpath);',
'use IO::Socket::INET;',
'use POSIX qw(WNOHANG :errno_h);',
'use Socket;',
'use Time::HiRes qw(sleep time);',
'sub yield { }',
'sub build_response { }',
'sub fd_retrieve { return \"" }',
'sub xexit { while (wait() > 0) { } POSIX::_exit($_[0] || 0) }',
'sub noderange { return $_[0] }',
# The stand-in decides what to do from the node and from the request argument, so several
# requests for ONE node can behave differently: one slow, one fatal, one immediate.
'sub plugin_command {',
' my ($request) = @_;',
' my $node = $request->{node}->[0] || $request->{_xcat_clienthost}->[0] || q{unknown};',
' my $arg = ref($request->{arg}) ? ($request->{arg}->[0] || q{}) : q{};',
' main::note_event("start $node $arg");',
' POSIX::_exit(9) if $node eq q{diesnode} or $arg eq q{dieplease};',
' sleep ' . $SLOW . ' if $node =~ /^slow/ or $arg eq q{slow};',
' main::note_event("end $node $arg");',
' return { data => [] };',
'}',
$reaper,
$dequeue,
$waiter,
$service,
'1;';
eval $scratch or die "cannot compile the lifted install monitor: $@";
}
{
# Stand-ins for the xCAT modules the lifted routine calls through. None of them can reach a
# database from here.
no warnings 'once';
*xCAT::MsgUtils::trace = sub { };
*xCAT::MsgUtils::message = sub { };
*xCAT::NetworkUtils::clearcache = sub { };
*xCAT::NetworkUtils::getNodeDomains = sub { return {} };
*xCAT::TableUtils::getTftpDir = sub { return '/tmp' };
*xCAT::Utils::xfork = sub {
if (@main::FORK_PLAN) { return undef unless shift @main::FORK_PLAN }
return fork();
};
*t::rescan::new = sub { return bless {}, shift };
*t::rescan::can_read = sub { return () };
}
# A free port: bind one, read it back, release it. The monitor binds it again for itself.
sub free_port {
my $probe = IO::Socket::INET->new(LocalAddr => '127.0.0.1', LocalPort => 0,
Listen => 1, Proto => 'tcp', ReuseAddr => 1)
or die "cannot find a free port: $!";
my $port = $probe->sockport();
close $probe;
return $port;
}
# Start a monitor of its own on $port, naming its peers in accept order.
sub start_monitor {
my ($port, $maxkids, @peers) = @_;
@PEER_QUEUE = @peers;
my $pid = fork();
die "cannot fork the monitor: $!" unless defined $pid;
return $pid if $pid;
# Detach the monitor and every process it forks from the harness pipe: a lingering child
# that holds prove's stdout makes a failure look like a hang.
open STDOUT, '>', '/dev/null';
open STDERR, '>', '/dev/null';
no warnings 'once';
$t::installm::installm_maxkids = $maxkids;
$t::installm::installm_drain_seconds = $DRAIN;
$t::installm::installm_wakeup_seconds = $WAKEUP;
$t::installm::installm_pidfile = $SCRATCH_PIDFILE;
$t::installm::sport = $port;
$t::installm::quit = 0;
$t::installm::inet6support = 0;
$t::installm::rescanrselect = t::rescan->new();
t::installm::do_installm_service();
POSIX::_exit(0);
}
# Connect, send one request, and return the connection. The first connection to a monitor is
# what tells this test the port is bound, so it is retried.
sub talk_to {
my ($port, $request, $tries) = @_;
my $c;
for (1 .. ($tries || 1)) {
last if $c = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => $port,
Proto => 'tcp', Timeout => 30);
sleep 0.05;
}
return undef unless $c;
$c->autoflush(1);
print {$c} "$request\n";
return $c;
}
sub open_monitor {
my ($port, @peers) = @_;
my $pid = start_monitor($port, $MAXKIDS, @peers);
my $up = talk_to($port, 'installmonitor', 200)
or do { kill 'KILL', $pid; die "the lifted monitor never bound port $port" };
close $up;
return $pid;
}
sub stop_monitor {
my ($pid) = @_;
kill 'KILL', $pid;
waitpid($pid, 0);
return;
}
# --- one node's slow request must not delay another node ----------------------
{
$EVENTS = "$SCRATCH/events-slow-vs-other";
my $port = free_port();
my $mon = open_monitor($port, qw(portprobe slownode othernode));
my $first = talk_to($port, 'next');
ok($first, 'the monitor accepted the first connection');
wait_for_event('start slownode next', 10)
or diag('the first request never reached its plugin');
my $t0 = time();
my $second = talk_to($port, 'installstatus booted');
my $greeting = $second ? scalar <$second> : undef;
my $waited = time() - $t0;
is($greeting, "ready\n", 'the monitor greeted the second node');
cmp_ok($waited, '<', 1,
sprintf('a second node is greeted while the first is in its plugin (waited %.3fs)', $waited))
or diag('the monitor serialises its nodes, so one slow request costs every node');
close $first if $first;
close $second if $second;
stop_monitor($mon);
}
# --- requests for one node keep their order, even when a handler dies ---------
{
$EVENTS = "$SCRATCH/events-order";
my $port = free_port();
my $mon = open_monitor($port, qw(portprobe ordernode ordernode ordernode));
# Three connections from one node: the first slow, the second fatal to the process serving
# it, the third immediate. The third must not be served before the first has finished.
my $one = talk_to($port, 'installstatus slow');
wait_for_event('start ordernode slow', 10)
or diag('the first request never reached its plugin');
my $two = talk_to($port, 'installstatus dieplease');
my $three = talk_to($port, 'installstatus last');
ok(wait_for_event('end ordernode last', 30), 'the third request was served in the end');
# Wait for both sides of the comparison. An event that has not happened is index -1, and
# comparing against that would pass whatever the monitor did.
ok(wait_for_event('end ordernode slow', 30), 'the first request finished');
my $first_end = event_index('end ordernode slow');
my $third_start = event_index('start ordernode last');
cmp_ok($first_end, '>=', 0, 'the first request is recorded as finished');
cmp_ok($third_start, '>=', 0, 'the third request is recorded as started');
cmp_ok($third_start, '>', $first_end,
'the last request for a node starts only after the first one finished')
or diag('a handler that died released the request behind it, so the order was lost');
cmp_ok(event_index('start ordernode dieplease'), '>=', 0,
'the request whose handler died did run');
close $_ for grep { $_ } $one, $two, $three;
stop_monitor($mon);
}
# --- a queued connection whose client goes away keeps the order ---------------
# One request runs for a node and two more are queued for it. The client of the middle one gives
# up. The parent holds queued connections unread, so dropping one must not let the request
# behind it overtake the request that is still running.
{
$EVENTS = "$SCRATCH/events-abandoned";
my $port = free_port();
my $mon = open_monitor($port, qw(portprobe gonenode gonenode gonenode));
my $one = talk_to($port, 'installstatus slow');
wait_for_event('start gonenode slow', 10)
or diag('the first request never reached its plugin');
my $two = talk_to($port, 'installstatus middle');
my $three = talk_to($port, 'installstatus last');
close $two;
$two = undef;
ok(wait_for_event('end gonenode last', 30),
'the request behind the abandoned one was served in the end');
ok(wait_for_event('end gonenode slow', 30), 'the running request finished');
my $running_end = event_index('end gonenode slow');
my $last_start = event_index('start gonenode last');
cmp_ok($running_end, '>=', 0, 'the running request is recorded as finished');
cmp_ok($last_start, '>=', 0, 'the request behind the abandoned one is recorded as started');
cmp_ok($last_start, '>', $running_end,
'an abandoned queued connection does not release the request behind it')
or diag('a client that gave up let a later request for the node overtake the running one');
close $_ for grep { $_ } $one, $three;
stop_monitor($mon);
}
# --- the fork-failure fallback answers in line, in order ----------------------
# A monitor that cannot fork answers the node itself. The request must be answered rather than
# dropped, and the node's next request must wait for that answer.
{
$EVENTS = "$SCRATCH/events-nofork";
my $port = free_port();
@FORK_PLAN = (1, 0); # the port probe gets a handler; the first real request does not
my $mon = open_monitor($port, qw(portprobe forknode forknode));
@FORK_PLAN = ();
my $inline = talk_to($port, 'installstatus slow');
ok(wait_for_event('start forknode slow', 20),
'the monitor answered the request in line when it could not fork')
or diag('a monitor that cannot fork drops the request instead of answering it itself');
my $after = talk_to($port, 'installstatus after');
ok(wait_for_event('end forknode after', 30), 'the next request for the node was served');
my $inline_end = event_index('end forknode slow');
my $after_start = event_index('start forknode after');
cmp_ok($inline_end, '>=', 0, 'the in-line request is recorded as finished');
cmp_ok($after_start, '>', $inline_end,
'the request after an in-line one starts only once the in-line one has finished')
or diag('the fork-failure fallback released the next request before its own had finished');
close $_ for grep { $_ } $inline, $after;
stop_monitor($mon);
}
# --- a handler that dies must not take the monitor with it --------------------
{
$EVENTS = "$SCRATCH/events-dies";
my $port = free_port();
my $mon = open_monitor($port, qw(portprobe diesnode lastnode));
my $dies = talk_to($port, 'installstatus booted');
if ($dies) { scalar <$dies>; }
sleep 0.5;
my $after = talk_to($port, 'installstatus booted');
my $still = $after ? scalar <$after> : undef;
is($still, "ready\n", 'the monitor still serves nodes after a handler died')
or diag('the request that killed the process serving it killed the whole install monitor');
close $_ for grep { $_ } $dies, $after;
stop_monitor($mon);
}
# --- the answer to a destiny advance follows the advance ----------------------
{
$EVENTS = "$SCRATCH/events-advance";
my $port = free_port();
my $mon = open_monitor($port, qw(portprobe slownode));
my $c = talk_to($port, 'next');
ok($c, 'the monitor accepted the destiny advance');
my $ready = $c ? scalar <$c> : undef;
is($ready, "ready\n", 'the greeting comes first');
my $done = $c ? scalar <$c> : undef;
my $done_at = now_us();
is($done, "done\n", 'the advance is answered');
ok(wait_for_event('end slownode next', 30), 'the advance reached its plugin');
my $end_at = event_time('end slownode next');
cmp_ok($done_at, '>=', ($end_at || 0),
'the node is released only after the destiny advance finished')
or diag('the node is told to carry on before its boot target has been switched');
close $c if $c;
stop_monitor($mon);
}
# --- a request accepted before the stand-down is finished, not abandoned ------
{
$EVENTS = "$SCRATCH/events-stand-down";
my $port = free_port();
my $mon = open_monitor($port, qw(portprobe slownode));
my $c = talk_to($port, 'next');
ok($c, 'the monitor accepted the request');
wait_for_event('start slownode next', 10)
or diag('the request never reached its plugin');
kill 'USR2', $mon; # what xcatd sends the monitor when it is told to stop
my $exited_at;
my $until = time() + 30;
while (time() < $until) {
if (waitpid($mon, POSIX::WNOHANG()) == $mon) { $exited_at = now_us(); last }
sleep 0.05;
}
ok(defined $exited_at, 'the monitor stood down');
ok(wait_for_event('end slownode next', 30), 'the request in flight finished');
my $end_at = event_time('end slownode next');
cmp_ok(($exited_at || 0), '>=', ($end_at || 0),
'the monitor waits for the request it accepted before it exits')
or diag('the handlers are orphaned, and systemd kills whatever is left at the timeout');
close $c if $c;
stop_monitor($mon) unless defined $exited_at;
}
# --- the handlers must not multiply without bound ----------------------------
# A monitor allowed one handler at a time. Its second node must wait, because a thousand nodes
# netbooting must not become a thousand handlers; the rest of them wait in the listen backlog.
# On a monitor that forks without a limit this wait is gone.
{
$EVENTS = "$SCRATCH/events-cap";
my $port = free_port();
my $mon = start_monitor($port, 1, qw(portprobe slowcap nextcap));
my $up = talk_to($port, 'installmonitor', 200)
or do { kill 'KILL', $mon; die "the capped monitor never bound port $port" };
close $up;
my $busy = talk_to($port, 'installstatus booted');
if ($busy) { scalar <$busy>; scalar <$busy>; } # ready, done -- its handler is the only one
my $c0 = time();
my $queued = talk_to($port, 'installstatus booted');
my $hello = $queued ? scalar <$queued> : undef;
my $queued_waited = time() - $c0;
is($hello, "ready\n", 'the capped monitor served the queued node in the end');
cmp_ok($queued_waited, '>=', 1,
sprintf('a monitor at its handler limit leaves the next node in the backlog (waited %.3fs)',
$queued_waited))
or diag('the monitor accepted past its limit, so a netbooting cluster forks a handler per node');
close $_ for grep { $_ } $busy, $queued;
stop_monitor($mon);
}
# --- the wait before the accept must end on its own ---------------------------
# SIGCHLD only interrupts a wait that has already begun. A handler that exits between the queue
# check and the wait leaves nothing to interrupt, so a wait that ends only when a connection
# arrives strands the connection queued for that node until some other node calls in.
{
my $listen = IO::Socket::INET->new(LocalAddr => '127.0.0.1', LocalPort => 0,
Listen => 1, Proto => 'tcp', ReuseAddr => 1)
or die "cannot open a listening socket: $!";
my $bounded;
eval {
local $SIG{ALRM} = sub { die "BLOCKED\n" };
alarm 10;
$bounded = t::installm::wait_for_installm_connection($listen, 0.2);
alarm 0;
1;
} or alarm 0;
is($@, '', 'the wait before the accept ends on its own bound with nothing to accept')
or diag('the wait ends only when a connection arrives, so a SIGCHLD handled before it is lost');
is($bounded, 0, 'and it reports that there is nothing to accept');
my $client = IO::Socket::INET->new(PeerAddr => '127.0.0.1',
PeerPort => $listen->sockport(), Proto => 'tcp', Timeout => 10);
ok($client, 'a client reached the listening socket');
my $ready;
eval {
local $SIG{ALRM} = sub { die "BLOCKED\n" };
alarm 10;
$ready = t::installm::wait_for_installm_connection($listen, $WAKEUP);
alarm 0;
1;
} or alarm 0;
is($ready, 1, 'a waiting connection ends the wait at once')
or diag('the monitor waits out its bound before accepting a connection that is already there');
close $client if $client;
close $listen;
}
# --- the per-node queue does not outlive the requests in it -------------------
# An empty queue entry for every node ever served is a leak no behavioural assertion catches,
# so the parent's own bookkeeping is checked directly.
{
no warnings 'once';
%t::installm::installm_busy = ();
%t::installm::installm_queue = (n1 => [ [ 'conn', '10.0.0.1' ] ]);
my ($node, $conn, $peer) = t::installm::dequeue_installm_request();
is($node, 'n1', 'the queued connection is taken for its own node');
is($conn, 'conn', 'the connection comes back with it');
is($peer, '10.0.0.1', 'and the peer address it was accepted from');
is_deeply([ keys %t::installm::installm_queue ], [],
'the queue entry is removed when it empties');
%t::installm::installm_busy = (n2 => 4242);
%t::installm::installm_queue = ();
my @none = t::installm::dequeue_installm_request();
is(scalar @none, 0, 'a node with a live handler yields nothing to dequeue');
is_deeply([ keys %t::installm::installm_queue ], [],
'and asking about it creates no queue entry');
}
# The host's pid file is how a restarting xcatd tells the running monitor to let go of the
# port. Nothing here may have touched it.
{
my @now = stat($PIDFILE);
if (!@HOST_PIDFILE and !@now) {
pass('the host pid file was absent before and after');
} elsif (@HOST_PIDFILE and @now) {
is("$now[7] $now[9]", "$HOST_PIDFILE[7] $HOST_PIDFILE[9]",
'the host pid file is the size and age it was before');
} else {
fail('the host pid file was created or removed by this test');
}
}
ok(-e $SCRATCH_PIDFILE, 'the monitor claimed the scratch pid file instead')
or diag('the redirection is not reached, so the assertion above proves nothing');
done_testing();