diff --git a/xCAT-server/sbin/xcatd b/xCAT-server/sbin/xcatd index a2d3d3fec..53b247313 100755 --- a/xCAT-server/sbin/xcatd +++ b/xCAT-server/sbin/xcatd @@ -338,41 +338,64 @@ my $rescanwritepipe; my $rescanrselect; my $rescanrequest = "rescanplugins"; -# The install monitor gives each connection its own child, so a slow request from one node does -# not hold up the others. %installm_kids maps a live child to the node it serves. +# 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 still must not overlap: 'nodeset next' and 'installstatus' write the -# same chain row. %installm_gate holds, per node, the read end of a pipe whose write end only -# the newest child for that node has. The next child for the same node reads that pipe to end -# of file first, and so starts only when its predecessor has exited. -my %installm_kids; -my %installm_gate; -my %installm_gate_owner; +# 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; -# Account for finished children. With $block set, wait for one to finish first. +# Under the systemd TimeoutStopSec of 30 seconds, so the drain finishes before the kill. +my $installm_drain_seconds = 20; + +# 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_gate_owner{$node} || 0) == $pid) { - close($installm_gate{$node}); - delete $installm_gate{$node}; - delete $installm_gate_owner{$node}; + if (defined $node and ($installm_busy{$node} || 0) == $pid) { + delete $installm_busy{$node}; } $pid = waitpid(-1, WNOHANG); } - if ($pid < 0) { # no children at all, so no gate can still be held + + # 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 = (); - close($_) for values %installm_gate; - %installm_gate = (); - %installm_gate_owner = (); + %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 (); +} + sub do_installm_service { unless ($sport) { return; } @@ -381,10 +404,13 @@ sub do_installm_service { my $installpidfile; my $retry = 1; $SIG{TERM} = $SIG{INT} = 'DEFAULT'; - $SIG{CHLD} = 'DEFAULT'; # the monitor accounts for its own children + # 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"); } @@ -400,7 +426,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) { @@ -432,7 +458,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"); @@ -443,129 +469,128 @@ 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) { + 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) { - close($conn); - sleep 0.01; - next; - } - # A thousand nodes netbooting must not become a thousand children. Anything over the - # limit waits in the listen backlog, where an unaccepted connection costs nothing. - reap_installm_kids(0); - while (scalar(keys %installm_kids) >= $installm_maxkids) { - reap_installm_kids(1); - } - my $predecessor = delete $installm_gate{$node}; - my ($gate_read, $gate_write); - unless (pipe($gate_read, $gate_write)) { - xCAT::MsgUtils->trace(0, "E", "xcatd: install monitor cannot order requests for $node: $!"); - undef $gate_read; - undef $gate_write; + # 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; - if ($gate_read) { - $installm_gate{$node} = $gate_read; - $installm_gate_owner{$node} = $handler; - } - close($gate_write) if $gate_write; - close($predecessor) if $predecessor; + $installm_busy{$node} = $handler; close($conn); next; } if (defined $handler) { - # This child answers one node and exits. It must not hold the listening socket, and - # USR2 belongs to the process that owns the pid file. It keeps $gate_write, which - # closes when it exits and so releases the next request for the same node. + # 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($gate_read) if $gate_read; - if ($predecessor) { - my $ignored; - sysread($predecessor, $ignored, 1); # end of file when the last child exits - close($predecessor); - } + 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"); - close($gate_read) if $gate_read; - close($gate_write) if $gate_write; - close($predecessor) if $predecessor; } my $tftpdir = xCAT::TableUtils->getTftpDir(); @@ -574,8 +599,15 @@ sub do_installm_service { 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/) { @@ -585,13 +617,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); @@ -608,13 +636,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 @@ -716,10 +738,28 @@ sub do_installm_service { } 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); } diff --git a/xCAT-test/unit/xcatd_install_monitor_concurrency.t b/xCAT-test/unit/xcatd_install_monitor_concurrency.t index 0e6447046..c6122ef9e 100644 --- a/xCAT-test/unit/xcatd_install_monitor_concurrency.t +++ b/xCAT-test/unit/xcatd_install_monitor_concurrency.t @@ -2,11 +2,15 @@ # # The install monitor serves every installing node. It must not make one node wait for another. # -# do_installm_service() accepts a connection, resolves the peer to a node and dispatches the -# request. While it dispatches, nothing else is accepted, so a node whose 'nodeset next' takes -# three seconds costs every other node in the cluster three seconds. What the monitor does have -# to keep is the order within one node: a 'nodeset next' and an 'installstatus' for the same -# node write the same chain row, which is why an earlier per-request fork was reverted. +# 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 @@ -17,6 +21,7 @@ use strict; use warnings; +use File::Temp qw(tempdir); use FindBin; use IO::Socket::INET; use POSIX (); @@ -27,9 +32,9 @@ use Time::HiRes qw(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 $EVENTS = "/tmp/xcatd-installm-events.$$"; -my $PIDFILE = '/var/run/xcat/installservice.pid'; +my $SLOW = 3; # seconds one node's request spends in its plugin +my $SCRATCH = tempdir(CLEANUP => 1); +my $EVENTS = "$SCRATCH/events"; my $src = do { open my $fh, '<', $XCATD or die "cannot read $XCATD: $!"; @@ -46,22 +51,33 @@ sub lift_sub { 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"; -# reap_installm_kids is what this test asks xcatd to grow. Supply a stand-in when it is not -# there yet, so the lifted routine still compiles and the assertions below report a monitor -# that serializes its nodes -- which is the defect -- instead of a compile error. -my $reaper = lift_sub('reap_installm_kids') || 'sub reap_installm_kids { }'; +# 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 ($PIDFILE) = $src =~ /^my \s+ \$installm_pidfile \s* = \s* "([^"]+)" ;/mx; +$PIDFILE or die "xcatd no longer declares \$installm_pidfile"; -# The limit on live handlers is xcatd's, not this test's. Without it the scratch package holds -# an undefined limit, which reads as zero and stops the monitor accepting anything. -my ($MAXKIDS) = $src =~ /^my \$installm_maxkids \s* = \s* (\d+) ;/mx; -$MAXKIDS ||= 64; +is($PIDFILE, '/var/run/xcat/installservice.pid', + 'the monitor still claims the pid file xcatd and its restart handshake use'); + +# 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: one connection opens the port, the next two -# are one node, then a second node, then a node whose plugin kills the process serving it, then -# a last node to ask whether the monitor is still there. -our @PEER_QUEUE = qw(portprobe slownode slownode othernode diesnode lastnode); +# them apart. Name them in accept order instead. +our @PEER_QUEUE; BEGIN { *CORE::GLOBAL::gethostbyaddr = sub { return (shift(@main::PEER_QUEUE) || 'unknown', '') } } # One line per plugin entry and exit, appended by whichever process is running it. @@ -81,6 +97,36 @@ sub events { 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;', @@ -89,7 +135,7 @@ sub events { 'use Fcntl qw/:DEFAULT :flock/;', 'use File::Path qw(mkpath);', 'use IO::Socket::INET;', - 'use POSIX qw(WNOHANG);', + 'use POSIX qw(WNOHANG :errno_h);', 'use Socket;', 'use Time::HiRes qw(sleep time);', 'sub yield { }', @@ -97,16 +143,20 @@ sub events { '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};', - ' main::note_event("start $node");', - ' POSIX::_exit(9) if $node eq q{diesnode};', - ' sleep ' . $SLOW . ' if $node =~ /^slow/;', - ' main::note_event("end $node");', + ' 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, $service, '1;'; eval $scratch or die "cannot compile the lifted install monitor: $@"; @@ -150,11 +200,13 @@ sub start_monitor { open STDOUT, '>', '/dev/null'; open STDERR, '>', '/dev/null'; no warnings 'once'; - $t::installm::installm_maxkids = $maxkids; - $t::installm::sport = $port; - $t::installm::quit = 0; - $t::installm::inet6support = 0; - $t::installm::rescanrselect = t::rescan->new(); + $t::installm::installm_maxkids = $maxkids; + $t::installm::installm_drain_seconds = $DRAIN; + $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); } @@ -176,117 +228,229 @@ sub talk_to { return $c; } -my $PORT = free_port(); +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; +} -# The monitor writes its pid file to a fixed path it shares with a real xcatd. Put back -# whatever was there. -my $saved_pidfile; -if (open my $fh, '<', $PIDFILE) { local $/; $saved_pidfile = <$fh>; close $fh; } - -my $server = start_monitor($PORT, $MAXKIDS, @PEER_QUEUE); - -sub talk_to_monitor { return talk_to($PORT, $_[0]) } - -sub cleanup { - kill 'KILL', $server; - waitpid($server, 0); - unlink $EVENTS; - if (defined $saved_pidfile) { - if (open my $fh, '>', $PIDFILE) { print {$fh} $saved_pidfile; close $fh; } - } else { - unlink $PIDFILE; - } +sub stop_monitor { + my ($pid) = @_; + kill 'KILL', $pid; + waitpid($pid, 0); return; } -# Wait for the monitor to bind. This connection is the 'portprobe' peer. -my $up = talk_to($PORT, 'installmonitor', 200) - or do { kill 'KILL', $server; die "the lifted monitor never bound port $PORT" }; -close $up; - # --- one node's slow request must not delay another node ---------------------- -my $first = talk_to_monitor('next'); -unless ($first) { - fail('the monitor accepted the first connection'); - cleanup(); - done_testing(); - exit 0; +{ + unlink $EVENTS; + 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); } -pass('the monitor accepted the first connection'); -scalar <$first>; # ready -scalar <$first>; # done -- the request is now in the plugin -my $second = talk_to_monitor('next'); # the same node again -sleep 0.3; # let it be accepted before the next node connects +# --- requests for one node keep their order, even when a handler dies --------- -my $t0 = time(); -my $other = talk_to_monitor('next'); # a different node -my $greeting = $other ? scalar <$other> : undef; -my $waited = time() - $t0; +{ + unlink $EVENTS; + my $port = free_port(); + my $mon = open_monitor($port, qw(portprobe ordernode ordernode ordernode)); -is($greeting, "ready\n", 'the monitor greeted the second node'); -cmp_ok($waited, '<', 1, - sprintf('a second node is served while the first is busy (waited %.3fs)', $waited)) - or diag(sprintf('the monitor took %.3fs to greet a node that had nothing to do with the' - . ' %ds request already running, so every installing node waits for the slowest one', - $waited, $SLOW)); + # 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'); -# --- requests for one node must not run at the same time ---------------------- + ok(wait_for_event('end ordernode last', 30), 'the third request was served in the end'); -for (1 .. 300) { - last if scalar(grep { /^end slownode/ } events()) >= 2; - sleep 0.1; -} -my @ev = events(); -my @starts = sort { $a <=> $b } map { (split ' ')[2] } grep { /^start slownode/ } @ev; -my @ends = sort { $a <=> $b } map { (split ' ')[2] } grep { /^end slownode/ } @ev; -is(scalar @starts, 2, 'both requests for the busy node ran'); -is(scalar @ends, 2, 'and both finished'); -SKIP: { - skip 'the busy node did not run twice', 1 unless @starts == 2 and @ends == 2; - cmp_ok($starts[1], '>=', $ends[0], - 'the second request for the same node started only after the first finished') - or diag('two requests for one node ran at the same time; they write the same chain row'); + # 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 handler that dies must not take the monitor with it -------------------- -my $dies = talk_to_monitor('next'); -if ($dies) { scalar <$dies>; close $dies; } -sleep 0.5; -my $after = talk_to_monitor('next'); -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'); +{ + unlink $EVENTS; + my $port = free_port(); + my $mon = open_monitor($port, qw(portprobe diesnode lastnode)); -cleanup(); + 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 ---------------------- + +{ + unlink $EVENTS; + 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 = time(); + 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 ------ + +{ + unlink $EVENTS; + 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 = time(); 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 second monitor, allowed one handler at a time. Its second node must wait, because a -# thousand nodes netbooting must not become a thousand children; the rest of them wait in the -# listen backlog. On a monitor that forks without a limit this wait is gone. -my $capped_port = free_port(); -my $capped = start_monitor($capped_port, 1, qw(portprobe slowcap nextcap)); -my $capped_up = talk_to($capped_port, 'installmonitor', 200) - or do { kill 'KILL', $capped; die "the capped monitor never bound port $capped_port" }; -close $capped_up; +# 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. +{ + unlink $EVENTS; + 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($capped_port, 'next'); -if ($busy) { scalar <$busy>; scalar <$busy>; } # ready, done -- its handler is now the only one -my $c0 = time(); -my $queued = talk_to($capped_port, 'next'); -my $hello = $queued ? scalar <$queued> : undef; -my $queued_waited = time() - $c0; + 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 child per node'); + 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'); -kill 'KILL', $capped; -waitpid($capped, 0); + close $_ for grep { $_ } $busy, $queued; + stop_monitor($mon); +} + +# --- 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();