--- loncom/loncnew 2004/02/17 15:09:08 1.43 +++ loncom/loncnew 2004/10/04 11:30:45 1.63 @@ -2,7 +2,7 @@ # The LearningOnline Network with CAPA # lonc maintains the connections to remote computers # -# $Id: loncnew,v 1.43 2004/02/17 15:09:08 albertel Exp $ +# $Id: loncnew,v 1.63 2004/10/04 11:30:45 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -75,14 +75,16 @@ my %perlvar = %{$perlvarref}; my %ChildHash; # by pid -> host. my %HostToPid; # By host -> pid. my %HostHash; # by loncapaname -> IP. - +my %listening_to; # Socket->host table for who the parent + # is listening to. +my %parent_dispatchers; # host-> listener watcher events. my $MaxConnectionCount = 10; # Will get from config later. my $ClientConnection = 0; # Uniquifier for client events. my $DebugLevel = 0; my $NextDebugLevel= 2; # So Sigint can toggle this. -my $IdleTimeout= 3600; # Wait an hour before pruning connections. +my $IdleTimeout= 600; # Wait 10 minutes before pruning connections. my $LogTransactions = 0; # When True, all transactions/replies get logged. @@ -103,6 +105,14 @@ my $RecentLogEntry = ""; my $ConnectionRetries=2; # Number of connection retries allowed. my $ConnectionRetriesLeft=2; # Number of connection retries remaining. my $LondVersion = "unknown"; # Version of lond we talk with. +my $KeyMode = ""; # e.g. ssl, local, insecure from last connect. +my $LondConnecting = 0; # True when a connection is being built. + + +# DO NOT SET THE NEXT VARIABLE TO NON ZERO!!!!!!!!!!!!!!! + +my $DieWhenIdle = 0; # When true children die when trimmed -> 0. +my $I_am_child = 0; # True if this is the child process. # # The hash below gives the HTML format for log messages @@ -110,13 +120,27 @@ my $LondVersion = "unknown"; # Versi # my %LogFormats; -$LogFormats{"CRITICAL"} = "CRITICAL: %s"; -$LogFormats{"SUCCESS"} = "SUCCESS: %s"; -$LogFormats{"INFO"} = "INFO: %s"; -$LogFormats{"WARNING"} = "WARNING: %s"; +$LogFormats{"CRITICAL"} = "CRITICAL: %s"; +$LogFormats{"SUCCESS"} = "SUCCESS: %s"; +$LogFormats{"INFO"} = "INFO: %s"; +$LogFormats{"WARNING"} = "WARNING: %s"; $LogFormats{"DEFAULT"} = " %s "; +# UpdateStatus; +# Update the idle status display to show how many connections +# are left, retries and other stuff. +# +sub UpdateStatus { + if ($ConnectionRetriesLeft > 0) { + ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount + ." Retries remaining: ".$ConnectionRetriesLeft + ." ($KeyMode)"); + } else { + ShowStatus(GetServerHost()." >> DEAD <<"); + } +} + =pod @@ -156,9 +180,9 @@ host and the time will be formatted into =cut sub Log { - my $severity = shift; - my $message = shift; - + + my ($severity, $message) = @_; + if(!$LogFormats{$severity}) { $severity = "DEFAULT"; } @@ -193,8 +217,10 @@ Returns the name of the host that a sock =cut sub GetPeername { - my $connection = shift; - my $AdrFamily = shift; + + + my ($connection, $AdrFamily) = @_; + my $peer = $connection->peername(); my $peerport; my $peerip; @@ -217,18 +243,20 @@ Invoked to issue a debug message. =cut sub Debug { - my $level = shift; - my $message = shift; + + my ($level, $message) = @_; + if ($level <= $DebugLevel) { Log("INFO", "-Debug- $message host = $RemoteHost"); } } sub SocketDump { - my $level = shift; - my $socket= shift; + + my ($level, $socket) = @_; + if($level <= $DebugLevel) { - $socket->Dump(); + $socket->Dump(-1); # Ensure it will get dumped. } } @@ -260,8 +288,8 @@ sub ShowStatus { sub SocketTimeout { my $Socket = shift; Log("WARNING", "A socket timeout was detected"); - Debug(0, " SocketTimeout called: "); - $Socket->Dump(); + Debug(5, " SocketTimeout called: "); + $Socket->Dump(0); if(exists($ActiveTransactions{$Socket})) { FailTransaction($ActiveTransactions{$Socket}); } @@ -269,7 +297,8 @@ sub SocketTimeout { # a connection failure: $ConnectionRetriesLeft--; if($ConnectionRetriesLeft <= 0) { - Log("CRITICAL", "Host marked dead: ".GetServerHost()); + Log("CRITICAL", "Host marked DEAD: ".GetServerHost()); + $LondConnecting = 0; } } @@ -285,13 +314,12 @@ Invoked each timer tick. sub Tick { + my ($Event) = @_; + my $clock_watcher = $Event->w; + my $client; - if($ConnectionRetriesLeft > 0) { - ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount - ." Retries remaining: ".$ConnectionRetriesLeft); - } else { - ShowStatus(GetServerHost()." >> DEAD <<"); - } + UpdateStatus(); + # Is it time to prune connection count: @@ -301,6 +329,22 @@ sub Tick { if($IdleSeconds > $IdleTimeout) { # Prune a connection... my $Socket = $IdleConnections->pop(); KillSocket($Socket); + $IdleSeconds = 0; # Otherwise all connections get trimmed to fast. + UpdateStatus(); + if(($ConnectionCount == 0) && $DieWhenIdle) { + # + # Create a lock file since there will be a time window + # between our exit and the parent's picking up the listen + # during which no listens will be done on the + # lonnet client socket. + # + my $lock_file = GetLoncSocketPath().".lock"; + open(LOCK,">$lock_file"); + print LOCK "Contents not important"; + close(LOCK); + + exit(0); + } } } else { $IdleSeconds = 0; # Reset idle count if not idle. @@ -319,23 +363,21 @@ sub Tick { # Do we have work in the queue, but no connections to service them? # If so, try to make some new connections to get things going again. # - + # Note this code is dead now... + # my $Requests = $WorkQueue->Count(); - if (($ConnectionCount == 0) && ($Requests > 0)) { + if (($ConnectionCount == 0) && ($Requests > 0) && (!$LondConnecting)) { if ($ConnectionRetriesLeft > 0) { - my $Connections = ($Requests <= $MaxConnectionCount) ? - $Requests : $MaxConnectionCount; - Debug(5,"Work but no connections, start ".$Connections." of them"); - my $successCount = 0; - for (my $i =0; $i < $Connections; $i++) { - $successCount += MakeLondConnection(); - } - if($successCount == 0) { # All connections failed: + Debug(5,"Work but no connections, Make a new one"); + my $success; + $success = &MakeLondConnection; + if($success == 0) { # All connections failed: Debug(5,"Work in queue failed to make any connectiouns\n"); EmptyQueue(); # Fail pending transactions with con_lost. CloseAllLondConnections(); # Should all be closed but.... } } else { + $LondConnecting = 0; ShowStatus(GetServerHost()." >>> DEAD!!! <<<"); Debug(5,"Work in queue, but gave up on connections..flushing\n"); EmptyQueue(); # Connections can't be established. @@ -343,6 +385,10 @@ sub Tick { } } + if ($ConnectionCount == 0) { + $KeyMode = ""; + $clock_watcher->cancel(); + } } =pod @@ -383,6 +429,7 @@ long enough, it will be shut down and re sub ServerToIdle { my $Socket = shift; # Get the socket. + $KeyMode = $Socket->{AuthenticationMode}; delete($ActiveTransactions{$Socket}); # Server has no transaction &Debug(5, "Server to idle"); @@ -462,7 +509,7 @@ sub ClientWritable { } else { # Partial string sent. $Watcher->data(substr($Data, $result)); if($result == 0) { # client hung up on us!! - Log("INFO", "lonc pipe client hung up on us!"); + # Log("INFO", "lonc pipe client hung up on us!"); $Watcher->cancel; $Socket->shutdown(2); $Socket->close(); @@ -515,8 +562,8 @@ The transaction that is being completed. sub CompleteTransaction { &Debug(5,"Complete transaction"); - my $Socket = shift; - my $Transaction = shift; + + my ($Socket, $Transaction) = @_; if (!$Transaction->isDeferred()) { # Normal transaction my $data = $Socket->GetReply(); # Data to send. @@ -550,9 +597,8 @@ sub CompleteTransaction { =cut sub StartClientReply { - my $Transaction = shift; - my $data = shift; + my ($Transaction, $data) = @_; my $Client = $Transaction->getClient(); @@ -591,7 +637,13 @@ Parameters: sub FailTransaction { my $transaction = shift; - Log("WARNING", "Failing transaction ".$transaction->getRequest()); + + # If the socket is dead, that's already logged. + + if ($ConnectionRetriesLeft > 0) { + Log("WARNING", "Failing transaction " + .$transaction->getRequest()); + } Debug(1, "Failing transaction: ".$transaction->getRequest()); if (!$transaction->isDeferred()) { # If the transaction is deferred we'll get to it. my $client = $transaction->getClient(); @@ -778,6 +830,11 @@ sub LondReadable { "Lond connection lost."); if(exists($ActiveTransactions{$Socket})) { FailTransaction($ActiveTransactions{$Socket}); + } else { + # Socket is connecting and failed... need to mark + # no longer connecting. + + $LondConnecting = 0; } $Watcher->cancel(); KillSocket($Socket); @@ -852,6 +909,10 @@ sub LondReadable { .$RemoteHost." now ready for action"); } ServerToIdle($Socket); # Next work unit or idle. + + # + $LondConnecting = 0; # Best spot I can think of for this. + # } elsif ($State eq "SendingRequest") { # We need to be writable for this and probably don't belong @@ -965,6 +1026,10 @@ sub LondWritable { " has been disconnected"); if(exists($ActiveTransactions{$Socket})) { FailTransaction($ActiveTransactions{$Socket}); + } else { + # In the process of conneting, so need to turn that off. + + $LondConnecting = 0; } $Watcher->cancel(); KillSocket($Socket); @@ -1125,7 +1190,9 @@ sub MakeLondConnection { data => $Connection, desc => 'Connection to lond server'); $ActiveConnections{$Connection} = $event; - + if ($ConnectionCount == 0) { + &SetupTimer; # Need to handle timeouts with connections... + } $ConnectionCount++; Debug(4, "Connection count = ".$ConnectionCount); if($ConnectionCount == 1) { # First Connection: @@ -1133,6 +1200,7 @@ sub MakeLondConnection { } Log("SUCESS", "Created connection ".$ConnectionCount ." to host ".GetServerHost()); + $LondConnecting = 1; # Connection in progress. return 1; # Return success. } @@ -1164,8 +1232,8 @@ The text of the request to send. =cut sub StartRequest { - my $Lond = shift; - my $Request = shift; # This is a LondTransaction. + + my ($Lond, $Request) = @_; Debug(6, "StartRequest: ".$Request->getRequest()); @@ -1216,15 +1284,18 @@ sub QueueTransaction { if(!defined $LondSocket) { # Need to queue request. Debug(5,"Must queue..."); $WorkQueue->enqueue($requestData); - if($ConnectionCount < $MaxConnectionCount) { + Debug(5, "Queue Transaction startnew $ConnectionCount $LondConnecting"); + if(($ConnectionCount < $MaxConnectionCount) && (! $LondConnecting)) { + if($ConnectionRetriesLeft > 0) { Debug(5,"Starting additional lond connection"); - if(MakeLondConnection() == 0) { + if(&MakeLondConnection() == 0) { EmptyQueue(); # Fail transactions, can't make connection. CloseAllLondConnections; # Should all be closed but... } } else { ShowStatus(GetServerHost()." >>> DEAD !!!! <<<"); + $LondConnecting = 0; EmptyQueue(); # It's worse than that ... he's dead Jim. CloseAllLondConnections; # Should all be closed but.. } @@ -1269,7 +1340,7 @@ sub ClientRequest { Debug(8,"Data: ".$data." this read: ".$thisread); $data = $data.$thisread; # Append new data. $watcher->data($data); - if($data =~ /(.*\n)/) { # Request entirely read. + if($data =~ /\n$/) { # Request entirely read. if($data eq "close_connection_exit\n") { Log("CRITICAL", "Request Close Connection ... exiting"); @@ -1288,6 +1359,40 @@ sub ClientRequest { } +# +# Accept a connection request for a client (lonc child) and +# start up an event watcher to keep an eye on input from that +# Event. This can be called both from NewClient and from +# ChildProcess if we are started in DieWhenIdle mode. +# Parameters: +# $socket - The listener socket. +# Returns: +# NONE +# Side Effects: +# An event is made to watch the accepted connection. +# Active clients hash is updated to reflect the new connection. +# The client connection count is incremented. +# +sub accept_client { + my ($socket) = @_; + + Debug(8, "Entering accept for lonc UNIX socket\n"); + my $connection = $socket->accept(); # Accept the client connection. + Debug(8,"Connection request accepted from " + .GetPeername($connection, AF_UNIX)); + + + my $description = sprintf("Connection to lonc client %d", + $ClientConnection); + Debug(9, "Creating event named: ".$description); + Event->io(cb => \&ClientRequest, + poll => 'r', + desc => $description, + data => "", + fd => $connection); + $ActiveClients{$connection} = $ClientConnection; + $ClientConnection++; +} =pod @@ -1306,21 +1411,8 @@ sub NewClient { my $event = shift; # Get the event parameters. my $watcher = $event->w; my $socket = $watcher->fd; # Get the event' socket. - my $connection = $socket->accept(); # Accept the client connection. - Debug(8,"Connection request accepted from " - .GetPeername($connection, AF_UNIX)); - - my $description = sprintf("Connection to lonc client %d", - $ClientConnection); - Debug(9, "Creating event named: ".$description); - Event->io(cb => \&ClientRequest, - poll => 'r', - desc => $description, - data => "", - fd => $connection); - $ActiveClients{$connection} = $ClientConnection; - $ClientConnection++; + &accept_client($socket); } =pod @@ -1330,10 +1422,20 @@ sub NewClient { Returns the name of the UNIX socket on which to listen for client connections. +=head2 Parameters: + + host (optional) - Name of the host socket to return.. defaults to + the return from GetServerHost(). + =cut sub GetLoncSocketPath { - return $UnixSocketDir."/".GetServerHost(); + + my $host = GetServerHost(); # Default host. + if (@_) { + ($host) = @_; # Override if supplied. + } + return $UnixSocketDir."/".$host; } =pod @@ -1370,22 +1472,28 @@ connection. The event handler establish (creating a communcations channel), that int turn will establish another event handler to subess requests. +=head2 Parameters: + + host (optional) Name of the host to set up a unix socket to. + =cut sub SetupLoncListener { + my $host = GetServerHost(); # Default host. + if (@_) { + ($host) = @_ # Override host with parameter. + } + my $socket; - my $SocketName = GetLoncSocketPath(); + my $SocketName = GetLoncSocketPath($host); unlink($SocketName); unless ($socket =IO::Socket::UNIX->new(Local => $SocketName, - Listen => 10, + Listen => 250, Type => SOCK_STREAM)) { die "Failed to create a lonc listner socket"; } - Event->io(cb => \&NewClient, - poll => 'r', - desc => 'Lonc listener Unix Socket', - fd => $socket); + return $socket; } # @@ -1416,6 +1524,7 @@ into the status file. We also use this to reset the retries count in order to allow the client to retry connections with a previously dead server. =cut + sub ChildStatus { my $event = shift; my $watcher = $event->w; @@ -1428,16 +1537,18 @@ sub ChildStatus { # # Write out information about each of the connections: # - print $fh "Active connection statuses: \n"; - my $i = 1; - print STDERR "================================= Socket Status Dump:\n"; - foreach my $item (keys %ActiveConnections) { - my $Socket = $ActiveConnections{$item}->data; - my $state = $Socket->GetState(); - print $fh "Connection $i State: $state\n"; - print STDERR "---------------------- Connection $i \n"; - $Socket->Dump(); - $i++; + if ($DebugLevel > 2) { + print $fh "Active connection statuses: \n"; + my $i = 1; + print STDERR "================================= Socket Status Dump:\n"; + foreach my $item (keys %ActiveConnections) { + my $Socket = $ActiveConnections{$item}->data; + my $state = $Socket->GetState(); + print $fh "Connection $i State: $state\n"; + print STDERR "---------------------- Connection $i \n"; + $Socket->Dump(-1); # Ensure it gets dumped.. + $i++; + } } $ConnectionRetriesLeft = $ConnectionRetries; } @@ -1484,15 +1595,39 @@ sub ToggleDebug { =head2 ChildProcess This sub implements a child process for a single lonc daemon. +Optional parameter: + $socket - if provided, this is a socket already open for listen + on the client socket. Otherwise, a new listen is set up. =cut sub ChildProcess { + # If we are in DieWhenIdle mode, we've inherited all the + # events of our parent and those have to be cancelled or else + # all holy bloody chaos will result.. trust me, I already made + # >that< mistake. + + my $host = GetServerHost(); + foreach my $listener (keys %parent_dispatchers) { + my $watcher = $parent_dispatchers{$listener}; + my $s = $watcher->fd; + if ($listener ne $host) { # Close everyone but me. + Debug(5, "Closing listen socket for $listener"); + $s->close(); + } + Debug(5, "Killing watcher for $listener"); + + $watcher->cancel(); + undef $parent_dispatchers{$listener}; + + } + $I_am_child = 1; # Seems like in spite of it all I'm still getting + # parent event dispatches. # # Signals must be handled by the Event framework... -# + # Event->signal(signal => "QUIT", cb => \&SignalledToDeath, @@ -1509,9 +1644,21 @@ sub ChildProcess { cb => \&ToggleDebug, data => "INT"); - SetupTimer(); - - SetupLoncListener(); + # Figure out if we got passed a socket or need to open one to listen for + # client requests. + + my ($socket) = @_; + if (!$socket) { + + $socket = SetupLoncListener(); + } + # Establish an event to listen for client connection requests. + + + Event->io(cb => \&NewClient, + poll => 'r', + desc => 'Lonc Listener Unix Socket', + fd => $socket); $Event::Debuglevel = $DebugLevel; @@ -1519,8 +1666,14 @@ sub ChildProcess { # Setup the initial server connection: - # &MakeLondConnection(); // let first work requirest do it. + # &MakeLondConnection(); // let first work request do it. + + # If We are in diwhenidle, need to accept the connection since the + # event may not fire. + if ($DieWhenIdle) { + &accept_client($socket); + } Debug(9,"Entering event loop"); my $ret = Event::loop(); # Start the main event loop. @@ -1532,9 +1685,10 @@ sub ChildProcess { # Create a new child for host passed in: sub CreateChild { + my ($host, $socket) = @_; + my $sigset = POSIX::SigSet->new(SIGINT); sigprocmask(SIG_BLOCK, $sigset); - my $host = shift; $RemoteHost = $host; Log("CRITICAL", "Forking server for ".$host); my $pid = fork; @@ -1548,10 +1702,157 @@ sub CreateChild { ShowStatus("Connected to ".$RemoteHost); $SIG{INT} = 'DEFAULT'; sigprocmask(SIG_UNBLOCK, $sigset); - ChildProcess; # Does not return. + if(defined $socket) { + &ChildProcess($socket); + } else { + ChildProcess; # Does not return. + } + } +} + +# parent_client_connection: +# Event handler that processes client connections for the parent process. +# This sub is called when the parent is listening on a socket and +# a connection request arrives. We must: +# Start a child process to accept the connection request. +# Kill our listen on the socket. +# Parameter: +# event - The event object that was created to monitor this socket. +# event->w->fd is the socket. +# Returns: +# NONE +# +sub parent_client_connection { + if ($I_am_child) { + # Should not get here, but seem to anyway: + &Debug(5," Child caught parent client connection event!!"); + my ($event) = @_; + my $watcher = $event->w; + $watcher->cancel(); # Try to kill it off again!! + } else { + &Debug(9, "parent_client_connection"); + my ($event) = @_; + my $watcher = $event->w; + my $socket = $watcher->fd; + + # Lookup the host associated with this socket: + + my $host = $listening_to{$socket}; + + # Start the child: + + + + &Debug(9,"Creating child for $host (parent_client_connection)"); + &CreateChild($host, $socket); + + # Clean up the listen since now the child takes over until it exits. + + $watcher->cancel(); # Nolonger listening to this event + delete($listening_to{$socket}); + delete($parent_dispatchers{$host}); + $socket->close(); + } +} + +# parent_listen: +# Opens a socket and starts a listen for the parent process on a client UNIX +# domain socket. +# +# This involves: +# Creating a socket for listen. +# Removing any socket lock file +# Adding an event handler for this socket becoming readable +# To the parent's event dispatcher. +# Parameters: +# loncapa_host - LonCAPA cluster name of the host represented by the client +# socket. +# Returns: +# NONE +# +sub parent_listen { + my ($loncapa_host) = @_; + Debug(5, "parent_listen: $loncapa_host"); + + my $socket = &SetupLoncListener($loncapa_host); + $listening_to{$socket} = $loncapa_host; + if (!$socket) { + die "Unable to create a listen socket for $loncapa_host"; + } + + my $lock_file = &GetLoncSocketPath($loncapa_host).".lock"; + unlink($lock_file); # No problem if it doesn't exist yet [startup e.g.] + + my $watcher = Event->io(cb => \&parent_client_connection, + poll => 'r', + desc => "Parent listener unix socket ($loncapa_host)", + fd => $socket); + $parent_dispatchers{$loncapa_host} = $watcher; + +} + + +# listen_on_all_unix_sockets: +# This sub initiates a listen on all unix domain lonc client sockets. +# This will be called in the case where we are trimming idle processes. +# When idle processes are trimmed, loncnew starts up with no children, +# and only spawns off children when a connection request occurs on the +# client unix socket. The spawned child continues to run until it has +# been idle a while at which point it eventually exits and once more +# the parent picks up the listen. +# +# Parameters: +# NONE +# Implicit Inputs: +# The configuration file that has been read in by LondConnection. +# Returns: +# NONE +# +sub listen_on_all_unix_sockets { + Debug(5, "listen_on_all_unix_sockets"); + my $host_iterator = &LondConnection::GetHostIterator(); + while (!$host_iterator->end()) { + my $host_entry_ref = $host_iterator->get(); + my $host_name = $host_entry_ref->[0]; + Debug(9, "Listen for $host_name"); + &parent_listen($host_name); + $host_iterator->next(); + } +} + +# server_died is called whenever a child process exits. +# Since this is dispatched via a signal, we must process all +# dead children until there are no more left. The action +# is to: +# - Remove the child from the bookeeping hashes +# - Re-establish a listen on the unix domain socket associated +# with that host. +# Parameters: +# The event, but we don't actually care about it. +sub server_died { + &Debug(9, "server_died called..."); + + while(1) { # Loop until waitpid nowait fails. + my $pid = waitpid(-1, WNOHANG); + if($pid <= 0) { + return; # Nothing left to wait for. + } + # need the host to restart: + + my $host = $ChildHash{$pid}; + if($host) { # It's for real... + &Debug(9, "Caught sigchild for $host"); + delete($ChildHash{$pid}); + delete($HostToPid{$host}); + &parent_listen($host); + + } else { + &Debug(5, "Caught sigchild for pid not in hosts hash: $pid"); + } } } + # # Parent process logic pass 1: # For each entry in the hosts table, we will @@ -1601,44 +1902,69 @@ Log("CRITICAL", "--------------- Startin LondConnection::ReadConfig; # Read standard config files. my $HostIterator = LondConnection::GetHostIterator; -while (! $HostIterator->end()) { - my $hostentryref = $HostIterator->get(); - CreateChild($hostentryref->[0]); - $HostHash{$hostentryref->[0]} = $hostentryref->[4]; - $HostIterator->next(); +if ($DieWhenIdle) { + $RemoteHost = "[parent]"; + &listen_on_all_unix_sockets(); +} else { + + while (! $HostIterator->end()) { + + my $hostentryref = $HostIterator->get(); + CreateChild($hostentryref->[0]); + $HostHash{$hostentryref->[0]} = $hostentryref->[4]; + $HostIterator->next(); + } } + $RemoteHost = "Parent Server"; # Maintain the population: ShowStatus("Parent keeping the flock"); -# -# Set up parent signals: -# -$SIG{INT} = \&Terminate; -$SIG{TERM} = \&Terminate; -$SIG{HUP} = \&Restart; -$SIG{USR1} = \&CheckKids; -$SIG{USR2} = \&UpdateKids; # LonManage update request. - -while(1) { - my $deadchild = wait(); - if(exists $ChildHash{$deadchild}) { # need to restart. - my $deadhost = $ChildHash{$deadchild}; - delete($HostToPid{$deadhost}); - delete($ChildHash{$deadchild}); - Log("WARNING","Lost child pid= ".$deadchild. - "Connected to host ".$deadhost); - Log("INFO", "Restarting child procesing ".$deadhost); - CreateChild($deadhost); +if ($DieWhenIdle) { + # We need to setup a SIGChild event to handle the exit (natural or otherwise) + # of the children. + + Event->signal(cb => \&server_died, + desc => "Child exit handler", + signal => "CHLD"); + + + $Event::DebugLevel = $DebugLevel; + Debug(9, "Parent entering event loop"); + my $ret = Event::loop(); + die "Main Event loop exited: $ret"; + + +} else { + # + # Set up parent signals: + # + + $SIG{INT} = \&Terminate; + $SIG{TERM} = \&Terminate; + $SIG{HUP} = \&Restart; + $SIG{USR1} = \&CheckKids; + $SIG{USR2} = \&UpdateKids; # LonManage update request. + + while(1) { + my $deadchild = wait(); + if(exists $ChildHash{$deadchild}) { # need to restart. + my $deadhost = $ChildHash{$deadchild}; + delete($HostToPid{$deadhost}); + delete($ChildHash{$deadchild}); + Log("WARNING","Lost child pid= ".$deadchild. + "Connected to host ".$deadhost); + Log("INFO", "Restarting child procesing ".$deadhost); + CreateChild($deadhost); + } } } - =pod =head1 CheckKids @@ -1805,17 +2131,33 @@ sub KillThemAll { local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die. foreach my $pid (keys %ChildHash) { my $serving = $ChildHash{$pid}; - Debug(2, "Killing lonc for $serving pid = $pid"); - ShowStatus("Killing lonc for $serving pid = $pid"); - Log("CRITICAL", "Killing lonc for $serving pid = $pid"); + ShowStatus("Nicely Killing lonc for $serving pid = $pid"); + Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid"); kill 'QUIT' => $pid; - delete($ChildHash{$pid}); } - my $execdir = $perlvar{'lonDaemons'}; - unlink("$execdir/logs/lonc.pid"); + } + +# +# Kill all children via KILL. Just in case the +# first shot didn't get them. + +sub really_kill_them_all_dammit +{ + Debug(2, "Kill them all Dammit"); + local($SIG{CHLD} = 'IGNORE'); # In case some purist reenabled them. + foreach my $pid (keys %ChildHash) { + my $serving = $ChildHash{$pid}; + &ShowStatus("Nastily killing lonc for $serving pid = $pid"); + Log("CRITICAL", "Nastily killing lonc for $serving pid = $pid"); + kill 'KILL' => $pid; + delete($ChildHash{$pid}); + my $execdir = $perlvar{'lonDaemons'}; + unlink("$execdir/logs/lonc.pid"); + } +} =pod =head1 Terminate @@ -1825,7 +2167,15 @@ Terminate the system. =cut sub Terminate { - KillThemAll; + &Log("CRITICAL", "Asked to kill children.. first be nice..."); + &KillThemAll; + # + # By now they really should all be dead.. but just in case + # send them all SIGKILL's after a bit of waiting: + + sleep(4); + &Log("CRITICAL", "Now kill children nasty"); + &really_kill_them_all_dammit; Log("CRITICAL","Master process exiting"); exit 0;