diff --git a/perl-xCAT/xCAT/RespawnUtils.pm b/perl-xCAT/xCAT/RespawnUtils.pm new file mode 100644 index 000000000..bd432228c --- /dev/null +++ b/perl-xCAT/xCAT/RespawnUtils.pm @@ -0,0 +1,157 @@ +# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html +package xCAT::RespawnUtils; + +# Backoff for a parent that re-forks a child when it dies; xcatd's install monitor is the +# caller. The delay doubles from min_interval to max_interval and holds there. +# +# There is no attempt limit. A spent budget cannot be refilled: with no child alive nothing +# resets it, and the resource stays dead until xcatd restarts. A child that ran `healthy` +# seconds served, so its death resets the delay. +# +# Every sub returns a new state and leaves its argument alone, so exited() can run in a +# SIGCHLD handler. +# +# The state is a plain hash; call the subs below for the next state. +# +# min_interval shortest wait, and what a healthy run resets the delay to +# max_interval longest wait; the delay doubles up to this +# healthy seconds a child must survive to count as having served +# delay the wait after the next failure +# next_at earliest time() at which another attempt is allowed +# started_at when the running child was forked, undef when none is running +# streak children in a row that died young +# reported whether the ceiling was already logged for this streak + +use strict; +use warnings; + +# The tunables reach policy() straight from %ENV, so they can be empty or misspelt. Anything +# that is not a whole number is treated as unset. +sub _tunable { + my ($value, $default) = @_; + return $default unless defined($value) && $value =~ /^\s*\d+\s*$/; + return $value + 0; +} + +sub policy { + my (%opt) = @_; + + my $min = _tunable($opt{min_interval}, 5); + my $max = _tunable($opt{max_interval}, 300); + my $healthy = _tunable($opt{healthy}, 60); + + $min = 1 if $min < 1; # 0 doubles to 0, which is a fork storm + $max = $min if $max < $min; + + return { + min_interval => $min, + max_interval => $max, + healthy => $healthy, + delay => $min, + next_at => 0, + started_at => undef, + streak => 0, + reported => 0, + }; +} + +sub due { + my ($state, $now) = @_; + return $now >= $state->{next_at} ? 1 : 0; +} + +# Call before forking: the child can die and be reaped before fork() returns to the parent. +sub forked { + my ($state, $now) = @_; + return { %$state, started_at => $now }; +} + +sub exited { + my ($state, $now) = @_; + + my %next = (%$state, started_at => undef); + + if (defined($state->{started_at}) + and ($now - $state->{started_at}) >= $state->{healthy}) { + + $next{delay} = $state->{min_interval}; + $next{next_at} = $now; + $next{streak} = 0; + $next{reported} = 0; + } else { + $next{streak} = $state->{streak} + 1; + $next{next_at} = $now + $state->{delay}; + $next{delay} = ($state->{delay} * 2 > $state->{max_interval}) + ? $state->{max_interval} + : $state->{delay} * 2; + } + + return \%next; +} + +# Keeps the log to one line per streak rather than one per attempt. +sub should_report { + my ($state) = @_; + return 0 if $state->{reported}; + return 0 if $state->{streak} < 1; + return $state->{delay} >= $state->{max_interval} ? 1 : 0; +} + +sub reported { + my ($state) = @_; + return { %$state, reported => 1 }; +} + +# --- Forking ----------------------------------------------------------------------------- +# The one impure sub. Everything above is arithmetic. + +# Fork a child, taking its body as a block: +# +# xCAT::RespawnUtils::supervise { ...child... } +# state => \$state, pid => \$pid, now => time(); +# +# `state` and `pid` are references to the caller's own variables. The reaper matches the dead +# child against that pid and folds the death into that state, so both have to be in place +# while SIGCHLD is still blocked; values assigned from a return would land after it is let +# back in, and a child dying in the gap would be compared against a pid still holding 0. +# +# The (&@) prototype needs this module loaded with `use`. Under `require` the sub is unknown +# when the call is compiled, the block is read as a bare block, and its value arrives as the +# first argument. +# +# The block runs only in the child and is not expected to return. Passing a live `pid` is a +# no-op. Returns the new pid. +sub supervise (&@) { + my ($child, %arg) = @_; + my ($stateref, $pidref, $now) = @arg{qw(state pid now)}; + + return $$pidref if $$pidref; + + require POSIX; + require xCAT::Utils; + + my $mask = POSIX::SigSet->new(POSIX::SIGCHLD()); + POSIX::sigprocmask(POSIX::SIG_BLOCK(), $mask); + + $$stateref = forked($$stateref, $now); + my $pid = xCAT::Utils->xfork; + + unless (defined $pid) { # could not fork: count it and back off + $$stateref = exited($$stateref, $now); + $$pidref = 0; + POSIX::sigprocmask(POSIX::SIG_UNBLOCK(), $mask); + return 0; + } + + unless ($pid) { # the child must not serve with SIGCHLD blocked + POSIX::sigprocmask(POSIX::SIG_UNBLOCK(), $mask); + $child->(); + POSIX::_exit(0); + } + + $$pidref = $pid; # in place before the reaper runs, or it matches a stale pid + POSIX::sigprocmask(POSIX::SIG_UNBLOCK(), $mask); + return $pid; +} + +1; diff --git a/xCAT-server/sbin/xcatd b/xCAT-server/sbin/xcatd index b8487f1b5..c8d08d887 100755 --- a/xCAT-server/sbin/xcatd +++ b/xCAT-server/sbin/xcatd @@ -50,9 +50,18 @@ use xCAT::TLSPolicy qw(resolve_xcatd_tls_settings); use xCAT::TableUtils; use xCAT::NetworkUtils; use xCAT::MsgUtils; +use xCAT::RespawnUtils; use xCAT::xcatd; use xCAT::CmdLog; use xCAT::State; + +# Pacing for re-forking the install monitor; see the main service loop below. +my $mon_respawn = xCAT::RespawnUtils::policy( + min_interval => $ENV{XCATD_MON_RESPAWN_MIN_INTERVAL}, + max_interval => $ENV{XCATD_MON_RESPAWN_MAX_INTERVAL}, + healthy => $ENV{XCATD_MON_RESPAWN_HEALTHY}, +); + my $os = xCAT::Utils->osver(); my $arch = `uname -p`; @@ -1022,11 +1031,24 @@ wait_db_process(); my $CHILDPID = 0; # Global for reapers my %immediatechildren; +# Both reapers call this. generic_reaper is the handler at startup and while connections are +# throttled, ssl_reaper for the rest of the service loop. A death reaped without this leaves +# $pid_MON holding a dead pid, and the service loop re-forks only when $pid_MON is clear. +sub reap_install_monitor { + my ($pid) = @_; + + return unless $pid_MON and $pid == $pid_MON; + $pid_MON = 0; + $mon_respawn = xCAT::RespawnUtils::exited($mon_respawn, time()); + return; +} + sub generic_reaper { local ($!); #print "generic_reaper in $$..."; while (($CHILDPID = waitpid(-1, WNOHANG)) > 0) { #print "reaper for $CHILDPID...\n"; + reap_install_monitor($CHILDPID); if ($CHILDPID == $pid_UDP) { if ($udpctl) { # got here because UDP child is gone @@ -1062,9 +1084,7 @@ sub ssl_reaper { if ($CHILDPID == $cmdlog_svrpid) { $cmdlog_svrpid = 0; } - if ($CHILDPID == $pid_MON) { - $pid_MON = 0; - } + reap_install_monitor($CHILDPID); } $SIG{CHLD} = \&ssl_reaper; } @@ -1189,17 +1209,17 @@ if (!(socketpair($rescanreadpipe, $rescanwritepipe, AF_UNIX, SOCK_STREAM, PF_UNS } $rescanrselect = new IO::Select; $rescanrselect->add($rescanreadpipe); -$pid_MON = xCAT::Utils->xfork; -if (!defined $pid_MON) { - xCAT::MsgUtils->message("S", "Unable to fork installmonitor"); - die; -} -unless ($pid_MON) { +xCAT::RespawnUtils::supervise { $$progname = "xcatd: install monitor"; $pid_UDP = 0; close($udpctl); $udpctl = 0; do_installm_service; xexit(0); +} state => \$mon_respawn, pid => \$pid_MON, now => time(); + +unless ($pid_MON) { + xCAT::MsgUtils->message("S", "Unable to fork installmonitor"); + die; } # ----used for command log start--------- @@ -1463,6 +1483,39 @@ my $udpalive = 1; until ($quit) { $SIG{CHLD} = \&ssl_reaper; # set here to ensure that signal handler is not corrupted during loop + # Nothing else re-forks the monitor; the reaper only clears $pid_MON. The pacing never + # stops allowing an attempt, so the monitor also comes back once whatever holds + # xcatiport lets go of it. + if (!$pid_MON && !$quit && $sport && xCAT::RespawnUtils::due($mon_respawn, time())) { + if (xCAT::RespawnUtils::should_report($mon_respawn)) { + xCAT::MsgUtils->message("S", + "xcatd: install monitor is not staying up ($mon_respawn->{streak} attempts);" + . " still retrying xcatiport $sport every $mon_respawn->{max_interval} seconds"); + $mon_respawn = xCAT::RespawnUtils::reported($mon_respawn); + } + xCAT::RespawnUtils::supervise { + $$progname = "xcatd: install monitor"; + $pid_UDP = 0; + close($listener); + close($udpctl); $udpctl = 0; + # This fork is further down the program than the one at startup, so it also + # inherits what the parent opened since: the rescanplugins channel. + close($chreadpipe); + close($chwritepipe); + # Client sockets the parent accepted and has not dispatched yet. The monitor + # outlives the worker that serves one. + close($_) for @pendingconnections; + do_installm_service; + xexit(0); + } state => \$mon_respawn, pid => \$pid_MON, now => time(); + + if ($pid_MON) { + xCAT::MsgUtils->trace(0, "I", + "xcatd: re-forked install monitor (pid $pid_MON) after it exited"); + } else { + xCAT::MsgUtils->message("S", "xcatd: unable to re-fork install monitor"); + } + } while ($udpalive and $udpwatcher->can_read(0)) { # take an intermission to broker some state requests from udp traffic control eval { my $msg = fd_retrieve($udpctl); @@ -1487,7 +1540,9 @@ until ($quit) { } else { # if select returned with no ready fds, there might be udpctl broken. - if (not $bothwatcher->can_read(30)) { + # The respawn at the top of this loop only gets a turn when this select returns, so + # wait in shorter hops while the monitor is down. + if (not $bothwatcher->can_read((!$pid_MON && $sport) ? 5 : 30)) { # if the errno is 'bad fd', check the health of the udpctl if ($! == EBADF) { diff --git a/xCAT-test/autotest/testcase/xcatd/case0 b/xCAT-test/autotest/testcase/xcatd/case0 index e9f92e648..079b4599f 100644 --- a/xCAT-test/autotest/testcase/xcatd/case0 +++ b/xCAT-test/autotest/testcase/xcatd/case0 @@ -187,3 +187,34 @@ cmd:if [ -d /run/systemd/system ] && command -v systemctl >/dev/null 2>&1; then check:rc==0 check:output!~Error|ERROR end + +start:xcatd_install_monitor_respawns +description:a killed install monitor comes back and reclaims xcatiport, without restarting xcatd +label:mn_only,ci_test,xcatd +#the process titles are matched anchored: an unanchored "pgrep -f" also matches this +#test's own command line, and the kill below would then take out the test itself +cmd:mkdir -p /tmp/xcatd_monitor_respawn; pgrep -f "^xcatd: install monitor$" > /tmp/xcatd_monitor_respawn/before.pid; test -s /tmp/xcatd_monitor_respawn/before.pid +check:rc==0 +cmd:pgrep -f "^xcatd: SSL listener$" > /tmp/xcatd_monitor_respawn/listener.pid; test -s /tmp/xcatd_monitor_respawn/listener.pid +check:rc==0 +cmd:kill -9 $(cat /tmp/xcatd_monitor_respawn/before.pid) +check:rc==0 +#it must return on its own. the respawn floor is 5s by default, so poll well past that +cmd:for i in $(seq 1 30); do sleep 2; pgrep -f "^xcatd: install monitor$" > /tmp/xcatd_monitor_respawn/after.pid; test -s /tmp/xcatd_monitor_respawn/after.pid && break; done; test -s /tmp/xcatd_monitor_respawn/after.pid +check:rc==0 +cmd:test "$(cat /tmp/xcatd_monitor_respawn/before.pid)" != "$(cat /tmp/xcatd_monitor_respawn/after.pid)" +check:rc==0 +#and it must have reclaimed the port, not merely be running again +cmd:XCATIPORT=$(lsdef -t site -i xcatiport 2>/dev/null | grep xcatiport | cut -d= -f2); XCATIPORT=${XCATIPORT:-3002}; ss -lntp | grep ":$XCATIPORT " | grep -q "pid=$(cat /tmp/xcatd_monitor_respawn/after.pid)" +check:rc==0 +#xcatd itself must not have been restarted -- surviving without a restart is the point +cmd:pgrep -f "^xcatd: SSL listener$" | diff -q - /tmp/xcatd_monitor_respawn/listener.pid +check:rc==0 +cmd:rm -rf /tmp/xcatd_monitor_respawn +check:rc==0 +#if the respawn did not happen, this MN is left with a dead xcatiport, and every later case +#in the bundle that provisions a node would fail for that reason instead of its own. a failed +#check does not stop the remaining cmds of a case, so restore the daemon unconditionally here +cmd:pgrep -f "^xcatd: install monitor$" >/dev/null || { if [ -d /run/systemd/system ] && command -v systemctl >/dev/null 2>&1; then XCATBYPASS=YES systemctl restart xcatd; else XCATBYPASS=YES service xcatd restart; fi; sleep 5; } +check:rc==0 +end diff --git a/xCAT-test/unit/xcatd_install_monitor.t b/xCAT-test/unit/xcatd_install_monitor.t new file mode 100644 index 000000000..d1202c401 --- /dev/null +++ b/xCAT-test/unit/xcatd_install_monitor.t @@ -0,0 +1,204 @@ +#!/usr/bin/env perl +# +# Unit test for the two things xcatd itself has to get right about the install monitor -- +# the child that listens on xcatiport for node install-status updates and the "next" +# boot-flip request. The pacing of the respawn is covered by xcatd_monitor_respawn.t; this +# file covers the daemon-side code that pacing depends on. +# +# 1. Every SIGCHLD handler that can be installed when the monitor dies has to account for +# the death. The monitor is forked at startup, while generic_reaper is the handler -- +# ssl_reaper is only installed once the main service loop starts, and generic_reaper +# comes back whenever connections are throttled. A death reaped by a handler that does +# not clear $pid_MON leaves the daemon holding a dead pid, so the respawn in the +# service loop never runs and xcatiport stays dead for the life of the daemon. +# +# 2. The respawned monitor must not carry the parent's other descriptors. It is forked +# from the middle of the service loop, so besides the SSL listener and the udpctl +# socket it also inherits the rescanplugins channel and any client connection the +# parent has accepted but not yet handed to a worker. The monitor serves none of +# those and outlives every one of them. +# +# 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 the routine and the +# fork block under test are lifted out of the program text and run in a scratch package +# against stand-in handles. BAIL_OUT if a lift stops matching, so this fails loudly rather +# than quietly covering nothing. + +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/../../perl-xCAT"; +use Test::More; +use POSIX (); +use Socket; + +use xCAT::RespawnUtils; + +my $XCATD = "$FindBin::Bin/../../xCAT-server/sbin/xcatd"; +plan skip_all => "xcatd not found at $XCATD" unless -r $XCATD; + +my $src = do { + open my $fh, '<', $XCATD or BAIL_OUT("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; +} + +# --- 1. whichever reaper is installed, a dead monitor is accounted for ------- + +my %reaper = map { $_ => lift_sub($_) } qw(generic_reaper ssl_reaper); +for my $name (sort keys %reaper) { + BAIL_OUT("cannot lift $name out of xcatd -- the lift needs updating") + unless $reaper{$name}; +} + +# reap_install_monitor is what this test asks xcatd to grow. Lift it when it is there, and +# supply a do-nothing stand-in when it is not, so the reapers still compile and the +# assertions below report a monitor death that went unnoticed -- which is the defect -- +# instead of a syntax error. +my $shared = lift_sub('reap_install_monitor') || 'sub reap_install_monitor { }'; + +{ + my $scratch = join "\n", + 'package t::xcatd;', + 'no strict;', + 'no warnings;', + 'sub yield { }', + $shared, + $reaper{generic_reaper}, + $reaper{ssl_reaper}, + '1;'; + eval $scratch or BAIL_OUT("cannot compile the lifted reapers: $@"); +} + +# Fork a child, let it exit, and hand it to $reaper as the install monitor. Returns the +# pacing state the reaper left behind, or undef when it did not notice the death at all. +sub reap_a_dead_monitor { + my ($reaper) = @_; + + my $pid = fork(); + BAIL_OUT("cannot fork: $!") unless defined $pid; + POSIX::_exit(0) unless $pid; + + my $now = time(); + { + no strict 'refs'; + ${'t::xcatd::pid_MON'} = $pid; + ${'t::xcatd::mon_respawn'} = xCAT::RespawnUtils::forked( + xCAT::RespawnUtils::policy(min_interval => 5, max_interval => 300), $now); + } + + # Wait for it to be reapable, then run the handler by hand rather than through the + # signal: what is under test is what the handler does with the death, not delivery. + local $SIG{CHLD} = 'DEFAULT'; + select(undef, undef, undef, 0.05) for 1 .. 4; + + no strict 'refs'; + &{"t::xcatd::$reaper"}(); + + return undef if ${'t::xcatd::pid_MON'}; + return ${'t::xcatd::mon_respawn'}; +} + +for my $reaper (qw(generic_reaper ssl_reaper)) { + subtest "$reaper accounts for a dead install monitor" => sub { + my $pace = reap_a_dead_monitor($reaper); + + ok($pace, "$reaper cleared \$pid_MON, so the service loop can re-fork the monitor") + or do { + diag("$reaper reaped the monitor and left \$pid_MON holding its pid;" + . " nothing will ever respawn it"); + return; + }; + ok(!defined $pace->{started_at}, + 'the pacing was told the monitor exited, so the next respawn is scheduled'); + cmp_ok($pace->{streak}, '>', 0, 'the death counts towards the backoff'); + }; +} + +# --- 2. the respawned monitor drops what it inherited ------------------------ + +# Both supervise() blocks in xcatd: the startup fork and the respawn in the service loop. +my @blocks = $src =~ /xCAT::RespawnUtils::supervise \s* \{ (.*?) ^\s* \} \s* state \s* =>/msgx; +BAIL_OUT("expected two supervise blocks in xcatd, found " . scalar(@blocks)) + unless @blocks == 2; +my ($respawn) = grep { /\$listener/ } @blocks; +BAIL_OUT("cannot tell the respawn block from the startup one -- the lift needs updating") + unless $respawn; + +{ + my $stubs = join "\n", + 'package t::monitor;', + 'no strict;', + 'no warnings;', + 'our $served = 0;', + 'sub do_installm_service { $served++ }', + 'sub xexit { die "xexit\n" }', + '1;'; + eval $stubs or BAIL_OUT("cannot compile the monitor stubs: $@"); + + my $body = "package t::monitor; no strict; no warnings; sub become_monitor { $respawn }; 1;"; + eval $body or BAIL_OUT("cannot compile the lifted respawn block: $@"); +} + +# A connected pair of descriptors, so close() has something real to close. +sub a_socket { + socketpair(my $near, my $far, AF_UNIX, SOCK_STREAM, PF_UNSPEC) + or BAIL_OUT("socketpair failed: $!"); + return ($near, $far); +} + +subtest 'a respawned monitor keeps none of the descriptors it inherited' => sub { + my %handle; + my @keep; + for my $name (qw(listener udpctl chreadpipe chwritepipe)) { + my ($near, $far) = a_socket(); + $handle{$name} = $near; + push @keep, $far; + } + my @pending; + for (1 .. 3) { + my ($near, $far) = a_socket(); + push @pending, $near; + push @keep, $far; + } + + { + no strict 'refs'; + ${"t::monitor::$_"} = $handle{$_} for keys %handle; + ${'t::monitor::progname'} = \(my $title = 'xcatd'); + ${'t::monitor::pid_UDP'} = 4242; + @{'t::monitor::pendingconnections'} = @pending; + } + $t::monitor::served = 0; + + eval { t::monitor::become_monitor(); 1 }; + my $left = $@; + + is($left, "xexit\n", 'the block ran to the end and left through xexit'); + cmp_ok($t::monitor::served, '==', 1, 'and it entered do_installm_service on the way'); + + for my $name (sort keys %handle) { + ok(!defined fileno($handle{$name}), "the monitor closed the inherited $name"); + } + + my @open = grep { defined fileno($pending[$_]) } 0 .. $#pending; + is_deeply(\@open, [], + 'the monitor closed the connections the parent had accepted but not yet dispatched') + or diag("a client socket the monitor holds stays open for the life of the daemon," + . " long after the worker that served it has gone"); + + no strict 'refs'; + is(${'t::monitor::pid_UDP'}, 0, 'and it no longer believes it owns the udp child'); + + close($_) for @keep; +}; + +done_testing(); diff --git a/xCAT-test/unit/xcatd_monitor_respawn.t b/xCAT-test/unit/xcatd_monitor_respawn.t new file mode 100644 index 000000000..1912c8fbf --- /dev/null +++ b/xCAT-test/unit/xcatd_monitor_respawn.t @@ -0,0 +1,392 @@ +#!/usr/bin/env perl +# +# Unit test for the pacing that keeps xcatd's install monitor alive -- the child that +# listens on xcatiport for node install-status updates and the "next" boot-flip request. +# +# The monitor used to be forked exactly once at daemon startup. When it died the SIGCHLD +# reaper only cleared $pid_MON and nothing re-forked it, so a single death of that child +# (a stray signal, or a lost socket takeover during an xcatd restart) left xcatiport dead +# while the main daemon kept running: installing nodes could no longer report booted or +# request the boot flip until the WHOLE daemon was restarted. +# +# Respawning has to be paced -- do_installm_service dies when it cannot bind the port, so +# while something else holds xcatiport every respawn is a fast, futile fork that also +# re-enters that function's USR2 socket-takeover handshake. But pacing must never become +# giving up: a retry budget that runs out cannot be refilled, because with no monitor +# alive nothing is left to reset it. The port would then stay dead until xcatd is +# restarted -- exactly the failure the respawn exists to remove, just reached more slowly. +# +# So the property under test is: the monitor comes back on its OWN, at a bounded rate, no +# matter how long it has been failing. xcatd cannot be run in a unit test (it needs the +# database, SSL, the plugin tree and /var/run/xcat), so the pacing lives in +# xCAT::RespawnUtils as pure functions -- given a state and a time they return the next +# state, touching no clock and no globals. This drives those functions directly: first +# over a virtual clock, for the schedule and the never-give-up property, and then for real +# against a genuinely held TCP port -- fail several times, release the port, and require +# that the monitor recovers by itself. + +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/../../perl-xCAT"; +use Test::More; +use POSIX qw(WNOHANG); +use IO::Socket::INET; + +use xCAT::RespawnUtils; # `use`, not `require`: the (&@) prototype must be known at compile time + +# Every monitor stand-in forked below is registered here, so a failed assertion that +# returns early out of the fork test cannot leave one sleeping on the port. The children +# leave via POSIX::_exit, which skips this block, so only the parent ever runs it. +my @spawned; +END { kill 'TERM', grep { $_ } @spawned if @spawned; } + +sub due { return xCAT::RespawnUtils::due(@_) } +sub forked { return xCAT::RespawnUtils::forked(@_) } +sub exited { return xCAT::RespawnUtils::exited(@_) } +sub should_rept { return xCAT::RespawnUtils::should_report(@_) } +sub mark_rept { return xCAT::RespawnUtils::reported(@_) } + +# Drive the pacing over a virtual clock in which every monitor dies the instant it is +# forked -- i.e. the port stays held for the whole window. Returns the times a respawn was +# allowed, which is the schedule the daemon would actually fork on. +sub attempts_while_failing { + my ( $pace, $seconds ) = @_; + my @at; + for my $now ( 0 .. $seconds ) { + next unless due( $pace, $now ); + push @at, $now; + $pace = forked( $pace, $now ); + $pace = exited( $pace, $now ); # could not bind: died at once + } + return @at; +} + +sub gaps_between { + my (@at) = @_; + return map { $at[$_] - $at[ $_ - 1 ] } 1 .. $#at; +} + +# --- the softlock the review caught ----------------------------------------- +subtest 'a monitor that keeps failing is still being retried much later' => sub { + my $pace = xCAT::RespawnUtils::policy( + min_interval => 1, + max_interval => 4, + healthy => 60, + ); + my @at = attempts_while_failing( $pace, 10_000 ); + + cmp_ok( scalar(@at), '>', 100, + 'the daemon is still forking monitors after ~3 hours of continuous failure' ); + cmp_ok( $at[-1], '>=', 9_990, + 'the last attempt is at the END of the window -- retrying never stopped' ); + + # ...and it is still paced while doing so: at the 4s ceiling the window admits ~2500 + # attempts, where an unpaced loop would fork as fast as fork() returns. + cmp_ok( scalar(@at), '<=', 10_000 / 4 + 5, + 'attempts stay spaced by the ceiling rather than becoming a fork storm' ); +}; + +# --- the shape of the pacing ------------------------------------------------ +subtest 'the delay doubles from the minimum up to a ceiling and stays there' => sub { + my $pace = xCAT::RespawnUtils::policy( + min_interval => 1, + max_interval => 8, + healthy => 60, + ); + my @gaps = gaps_between( attempts_while_failing( $pace, 200 ) ); + + is_deeply( [ @gaps[ 0 .. 5 ] ], [ 1, 2, 4, 8, 8, 8 ], + 'gaps back off 1,2,4,8 then hold at the 8s ceiling' ); + is( scalar( grep { $_ > 8 } @gaps ), 0, 'no gap ever exceeds the ceiling' ); +}; + +subtest 'a policy cannot be built with a delay that fails to back off' => sub { + my $zero = xCAT::RespawnUtils::policy( min_interval => 0, max_interval => 300 ); + cmp_ok( $zero->{min_interval}, '>=', 1, + 'a zero minimum is raised -- 0 doubles to 0, which is a fork storm' ); + + my $inverted = xCAT::RespawnUtils::policy( min_interval => 60, max_interval => 5 ); + cmp_ok( $inverted->{max_interval}, '>=', $inverted->{min_interval}, + 'a ceiling below the floor is raised to it' ); + + my $default = xCAT::RespawnUtils::policy(); + is( $default->{min_interval}, 5, 'unset options fall back to the default floor' ); + is( $default->{max_interval}, 300, '...and the default ceiling' ); + is( $default->{healthy}, 60, '...and the default healthy uptime' ); + + # These arrive straight from %ENV, so they can be empty or misspelt. xcatd runs under + # use warnings: comparing a non-numeric one would put "Argument isn't numeric" in the + # daemon log on every start. Anything that is not a plain non-negative integer is + # treated as unset. + my @warnings; + local $SIG{__WARN__} = sub { push @warnings, @_ }; + for my $junk ( '', 'abc', '-5', '3.5' ) { + is( xCAT::RespawnUtils::policy( min_interval => $junk )->{min_interval}, 5, + "a min_interval of '$junk' falls back to the default" ); + } + is( xCAT::RespawnUtils::policy( min_interval => ' 7 ' )->{min_interval}, 7, + 'a padded value is still read as a number' ); + is_deeply( \@warnings, [], 'no tunable produces a Perl warning' ); +}; + +subtest 'hitting the ceiling is reported once per failure streak' => sub { + my $pace = xCAT::RespawnUtils::policy( + min_interval => 1, + max_interval => 4, + healthy => 60, + ); + + my $reports = 0; + for my $now ( 0 .. 100 ) { + next unless due( $pace, $now ); + if ( should_rept($pace) ) { $reports++; $pace = mark_rept($pace); } + $pace = forked( $pace, $now ); + $pace = exited( $pace, $now ); + } + is( $reports, 1, 'a monitor that cannot start is logged once, not on every attempt' ); +}; + +# --- recovery, on the virtual clock ----------------------------------------- +subtest 'a monitor that served resets the backoff when it later dies' => sub { + my $pace = xCAT::RespawnUtils::policy( + min_interval => 1, + max_interval => 8, + healthy => 60, + ); + + # burn the backoff up to the ceiling against a held port + for my $now ( 0 .. 20 ) { + next unless due( $pace, $now ); + $pace = exited( forked( $pace, $now ), $now ); + } + is( $pace->{delay}, 8, 'the backoff is sitting at the ceiling' ); + + # then one gets the socket and serves for two minutes before dying + $pace = forked( $pace, 100 ); + $pace = exited( $pace, 220 ); + + ok( due( $pace, 220 ), + 'the death of a healthy monitor is retried at once, not after the old backoff' ); + is( $pace->{streak}, 0, 'the failure streak is cleared by a monitor that served' ); + + # and the streak starts over from the minimum rather than from the ceiling + $pace = exited( forked( $pace, 220 ), 220 ); + ok( !due( $pace, 220 ), 'the retry after that is paced again' ); + ok( due( $pace, 221 ), '...by the minimum interval, not by the old ceiling' ); +}; + +subtest 'the pacing functions are pure' => sub { + my $pace = xCAT::RespawnUtils::policy( min_interval => 1, max_interval => 8 ); + my %before = %$pace; + + my $after = exited( forked( $pace, 10 ), 11 ); + + is_deeply( $pace, \%before, 'exited()/forked() leave the state they were given alone' ); + isnt( $after, $pace, 'they return a new state rather than the same reference' ); + is( due( $pace, 0 ), due( $pace, 0 ), 'due() is free of side effects' ); + + # Each of the two has to be checked on a state it was handed DIRECTLY. Composing them as + # exited(forked($pace,...)) only ever lets exited() mutate forked()'s throwaway + # intermediate, so an exited() that wrote in place would leave $pace untouched and the + # assertion above green. + my $only_forked = xCAT::RespawnUtils::policy( min_interval => 1, max_interval => 8 ); + my %before_forked = %$only_forked; + my $forked_out = forked( $only_forked, 10 ); + is_deeply( $only_forked, \%before_forked, + 'forked() alone leaves the state it was given alone' ); + isnt( $forked_out, $only_forked, 'forked() returns a new state' ); + + my $only_exited = xCAT::RespawnUtils::policy( min_interval => 1, max_interval => 8 ); + my %before_exited = %$only_exited; + my $exited_out = exited( $only_exited, 5 ); + is_deeply( $only_exited, \%before_exited, + 'exited() alone leaves the state it was given alone' ); + isnt( $exited_out, $only_exited, 'exited() returns a new state' ); +}; + +# --- the window the reaper looks through ------------------------------------ +# The reaper matches the dead child against xcatd's $pid_MON and folds the death into the +# pacing state. Both therefore have to be in place before SIGCHLD is let back in: a child that +# died while the fork was in flight would otherwise be compared against a pid still holding 0, +# missed, and the caller would then write a dead pid back over the reaper's work -- believing a +# dead monitor alive, and never respawning it. That is the whole failure this file is about, +# reached through the respawn instead of through startup. +# +# Racing a real death into that window is not something a test can arrange reliably, so this +# arranges a certainty instead: a SIGCHLD is made pending BEFORE supervise() is called (a decoy +# child that exits while the signal is blocked). The handler is then guaranteed to run the +# moment supervise() unblocks -- inside supervise(), before it has returned to us -- and what it +# sees there is exactly what the real reaper would see. +subtest 'the pid and the pacing are in place before SIGCHLD is let back in' => sub { + my $pace = xCAT::RespawnUtils::policy( min_interval => 1, max_interval => 2, healthy => 60 ); + my $mon_pid = 0; + + my ( $ran, $pid_seen, $started_at_seen ); + local $SIG{CHLD} = sub { + $ran++; + $pid_seen = $mon_pid; + $started_at_seen = $pace->{started_at}; + }; + + my $mask = POSIX::SigSet->new( POSIX::SIGCHLD ); + POSIX::sigprocmask( POSIX::SIG_BLOCK, $mask ); + + my $decoy = fork(); + POSIX::_exit(0) if defined($decoy) && !$decoy; + unless ($decoy) { + POSIX::sigprocmask( POSIX::SIG_UNBLOCK, $mask ); + plan skip_all => "cannot fork here: $!"; + } + select( undef, undef, undef, 0.2 ); # it is gone, and its SIGCHLD is pending, not delivered + + xCAT::RespawnUtils::supervise { + sleep 3600; # a monitor that stays up; this one is about the parent + } + state => \$pace, pid => \$mon_pid, now => time(); + push @spawned, $mon_pid if $mon_pid; + + ok( $ran, 'the pending SIGCHLD was delivered while supervise() was still running' ); + ok( $mon_pid, 'supervise() forked' ); + is( $pid_seen, $mon_pid, + 'a reaper running at the unblock sees the live pid, not the stale 0 it would miss' ); + ok( defined $started_at_seen, + '...and a pacing state that already knows a child was forked' ); + + if ($mon_pid) { + kill 'TERM', $mon_pid; + waitpid( $mon_pid, 0 ); + @spawned = grep { $_ != $mon_pid } @spawned; + } + waitpid( $decoy, 0 ); + POSIX::sigprocmask( POSIX::SIG_UNBLOCK, $mask ); +}; + +# --- the real thing: fail several times, release the port, recover ---------- +subtest 'the monitor comes back on its own once the port is released' => sub { + my $holder = IO::Socket::INET->new( + LocalAddr => '127.0.0.1', + LocalPort => 0, + Proto => 'tcp', + ReuseAddr => 1, + Listen => 8, + ); + plan skip_all => "cannot bind a loopback port here: $!" unless $holder; + + my $port = $holder->sockport; + my $healthy = 2; + + # The ceiling is well above the promptness the last assertion asks for, on purpose: with a + # ceiling of 2 that assertion could not fail, since a backoff pinned at the ceiling would + # still land inside it, and dropping the healthy-run reset from exited() would leave the + # subtest green. At 8 the reset is the only thing that can produce a prompt respawn. + my $ceiling = 8; + my $pace = xCAT::RespawnUtils::policy( + min_interval => 1, + max_interval => $ceiling, + healthy => $healthy, + ); + + my ( $mon_pid, $mon_forked_at ) = ( 0, 0 ); + my ( @forks, @deaths ); + + # One turn of the daemon's service loop: reap the monitor if it died, then re-fork it + # if the pacing says a respawn is due. The child stands in for do_installm_service: + # the part of it the pacing reacts to is that it binds xcatiport or dies, and the rest + # needs the whole daemon to run at all. + my $pump = sub { + if ($mon_pid) { + if ( waitpid( $mon_pid, WNOHANG ) == $mon_pid ) { + @spawned = grep { $_ != $mon_pid } @spawned; # reaped: not ours to signal + push @deaths, [ $mon_pid, $mon_forked_at, time() ]; + $pace = exited( $pace, time() ); + $mon_pid = 0; + } + } + if ( !$mon_pid && due( $pace, time() ) ) { + my $now = time(); + + # Driven through supervise() -- the same call xcatd makes -- so this exercises the + # real fork-and-account sequence rather than a copy of it here. + xCAT::RespawnUtils::supervise { + close($holder) if $holder; # never hold the port from inside a child + my $sock = IO::Socket::INET->new( + LocalAddr => '127.0.0.1', + LocalPort => $port, + Proto => 'tcp', + ReuseAddr => 1, + Listen => 8, + ); + POSIX::_exit(1) unless $sock; # could not bind: died, as the real one does + sleep 3600; # bound the port and serve + } + state => \$pace, pid => \$mon_pid, now => $now; + + die "supervise did not fork" unless $mon_pid; + $mon_forked_at = $now; + push @forks, $now; + push @spawned, $mon_pid; + } + select( undef, undef, undef, 0.05 ); + }; + + # This subtest is the one place in the file that depends on real elapsed time. It + # normally finishes in well under ten seconds; the deadline is a runaway guard, not a + # timing assertion. Say so when it fires, so a loaded runner reports a timeout rather + # than an assertion that looks like a logic failure. + my $deadline = time() + 60; + my $timed_out = sub { time() >= $deadline }; + + # (1) the port is held: monitors must fail repeatedly, without a fork storm + $pump->() while ( @deaths < 3 && !$timed_out->() ); + if ( $timed_out->() && @deaths < 3 ) { + diag( "timed out waiting for three failed monitors (got " + . scalar(@deaths) . "); the runner is too loaded for this subtest" ); + } + cmp_ok( scalar(@deaths), '>=', 3, + 'the monitor is retried several times while the port is held' ) + or return; + cmp_ok( scalar(@forks), '<=', 12, + 'those retries are paced by the backoff, not forked as fast as fork() returns' ); + is( scalar( grep { $_->[2] - $_->[1] >= $healthy } @deaths ), 0, + 'every monitor so far died young -- none of them got the socket' ); + + # (2) release the port -- nothing else changes, the daemon is not restarted + my $released = time(); + close($holder); + undef $holder; + + # (3) it must recover by itself + $pump->() + while ( !( $mon_pid && time() - $mon_forked_at >= $healthy + 1 ) + && !$timed_out->() ); + diag("timed out waiting for the monitor to reclaim the freed port") + if $timed_out->() && !$mon_pid; + + ok( $mon_pid && time() - $mon_forked_at >= $healthy + 1, + 'a respawned monitor binds the freed port and stays up -- no xcatd restart' ) + or return; + cmp_ok( $mon_forked_at - $released, '<=', $ceiling + 1, + 'recovery lands within the backoff ceiling of the port becoming free' ); + + # (4) and after that healthy run the pacing is back to prompt + my $forks_before = scalar(@forks); + kill 'TERM', $mon_pid; + $pump->() while ( @forks == $forks_before && !$timed_out->() ); + + cmp_ok( scalar(@forks), '>', $forks_before, + 'killing the healthy monitor gets it replaced again' ); + cmp_ok( $deaths[-1][2] - $deaths[-1][1], '>=', $healthy, + 'the monitor that was killed had been up long enough to count as having served' ); + cmp_ok( $forks[-1] - $deaths[-1][2], '<=', 2, + 'that replacement is prompt: the healthy run reset the backoff off its ceiling' ); + + if ($mon_pid) { + kill 'TERM', $mon_pid; + waitpid( $mon_pid, 0 ); + @spawned = grep { $_ != $mon_pid } @spawned; + } +}; + +done_testing();