--- loncom/loncnew 2004/09/20 10:27:35 1.54
+++ loncom/loncnew 2005/03/24 22:57:56 1.69
@@ -2,7 +2,7 @@
# The LearningOnline Network with CAPA
# lonc maintains the connections to remote computers
#
-# $Id: loncnew,v 1.54 2004/09/20 10:27:35 foxr Exp $
+# $Id: loncnew,v 1.69 2005/03/24 22:57:56 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -61,6 +61,7 @@ use LONCAPA::LondConnection;
use LONCAPA::LondTransaction;
use LONCAPA::Configuration;
use LONCAPA::HashIterator;
+use Fcntl qw(:flock);
# Read the httpd configuration file to get perl variables
@@ -75,7 +76,11 @@ 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 %parent_handlers; # Parent signal handlers...
my $MaxConnectionCount = 10; # Will get from config later.
my $ClientConnection = 0; # Uniquifier for client events.
@@ -85,6 +90,7 @@ my $NextDebugLevel= 2; # So Sigint can
my $IdleTimeout= 600; # Wait 10 minutes before pruning connections.
my $LogTransactions = 0; # When True, all transactions/replies get logged.
+my $executable = $0; # Get the full path to me.
#
# The variables below are only used by the child processes.
@@ -106,6 +112,11 @@ my $LondVersion = "unknown"; # Versi
my $KeyMode = ""; # e.g. ssl, local, insecure from last connect.
my $LondConnecting = 0; # True when a connection is being built.
+
+
+my $DieWhenIdle = 1; # 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
# given a severity.
@@ -119,6 +130,20 @@ $LogFormats{"WARNING"} = "<font color='
$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
@@ -127,6 +152,7 @@ $LogFormats{"DEFAULT"} = " %s ";
Makes an entry into the permanent log file.
=cut
+
sub LogPerm {
my $message=shift;
my $execdir=$perlvar{'lonDaemons'};
@@ -246,6 +272,7 @@ sub SocketDump {
and as what we return in a SIGUSR1
=cut
+
sub ShowStatus {
my $state = shift;
my $now = time;
@@ -256,13 +283,14 @@ sub ShowStatus {
=pod
-=head 2 SocketTimeout
+=head2 SocketTimeout
Called when an action on the socket times out. The socket is
destroyed and any active transaction is failed.
=cut
+
sub SocketTimeout {
my $Socket = shift;
Log("WARNING", "A socket timeout was detected");
@@ -276,9 +304,48 @@ sub SocketTimeout {
$ConnectionRetriesLeft--;
if($ConnectionRetriesLeft <= 0) {
Log("CRITICAL", "Host marked DEAD: ".GetServerHost());
+ $LondConnecting = 0;
}
}
+#
+# This function should be called by the child in all cases where it must
+# exit. If the child process is running with the DieWhenIdle turned on
+# it must create a lock file for the AF_UNIX socket in order to prevent
+# connection requests from lonnet in the time between process exit
+# and the parent picking up the listen again.
+# Parameters:
+# exit_code - Exit status value, however see the next parameter.
+# message - If this optional parameter is supplied, the exit
+# is via a die with this message.
+#
+sub child_exit {
+ my ($exit_code, $message) = @_;
+
+ # Regardless of how we exit, we may need to do the lock thing:
+
+ if($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);
+ }
+ # Now figure out how we exit:
+
+ if($message) {
+ die $message;
+ } else {
+ exit($exit_code);
+ }
+}
#----------------------------- Timer management ------------------------
=pod
@@ -295,13 +362,8 @@ sub Tick {
my $clock_watcher = $Event->w;
my $client;
- if($ConnectionRetriesLeft > 0) {
- ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount
- ." Retries remaining: ".$ConnectionRetriesLeft
- ." ($KeyMode)");
- } else {
- ShowStatus(GetServerHost()." >> DEAD <<");
- }
+ UpdateStatus();
+
# Is it time to prune connection count:
@@ -312,6 +374,11 @@ sub Tick {
my $Socket = $IdleConnections->pop();
KillSocket($Socket);
$IdleSeconds = 0; # Otherwise all connections get trimmed to fast.
+ UpdateStatus();
+ if(($ConnectionCount == 0) && $DieWhenIdle) {
+ &child_exit(0);
+
+ }
}
} else {
$IdleSeconds = 0; # Reset idle count if not idle.
@@ -330,23 +397,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.
@@ -358,6 +423,7 @@ sub Tick {
$KeyMode = "";
$clock_watcher->cancel();
}
+ &UpdateStatus();
}
=pod
@@ -623,12 +689,14 @@ sub FailTransaction {
}
=pod
+
=head1 EmptyQueue
Fails all items in the work queue with con_lost.
Note that each item in the work queue is a transaction.
=cut
+
sub EmptyQueue {
$ConnectionRetriesLeft--; # Counts as connection failure too.
while($WorkQueue->Count()) {
@@ -644,6 +712,7 @@ sub EmptyQueue {
Close all connections open on lond prior to exit e.g.
=cut
+
sub CloseAllLondConnections {
foreach my $Socket (keys %ActiveConnections) {
if(exists($ActiveTransactions{$Socket})) {
@@ -652,7 +721,6 @@ sub CloseAllLondConnections {
KillSocket($Socket);
}
}
-=cut
=pod
@@ -674,8 +742,8 @@ Parameters:
nonzero if we are allowed to create a new connection.
-
=cut
+
sub KillSocket {
my $Socket = shift;
@@ -799,6 +867,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);
@@ -990,6 +1063,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);
@@ -1079,6 +1156,7 @@ sub LondWritable {
=pod
=cut
+
sub QueueDelayed {
Debug(3,"QueueDelayed called");
@@ -1137,7 +1215,7 @@ sub MakeLondConnection {
#
my $Socket = $Connection->GetSocket();
if($Socket eq undef) {
- die "did not get a socket from the connection";
+ &child_exit(-1, "did not get a socket from the connection");
} else {
&Debug(9,"MakeLondConnection got socket: ".$Socket);
}
@@ -1244,15 +1322,18 @@ sub QueueTransaction {
if(!defined $LondSocket) { # Need to queue request.
Debug(5,"Must queue...");
$WorkQueue->enqueue($requestData);
- if(($ConnectionCount < $MaxConnectionCount)) { # && !$LondConnecting) {
+ 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..
}
@@ -1316,6 +1397,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
@@ -1334,21 +1449,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
@@ -1358,10 +1460,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
@@ -1398,22 +1510,32 @@ 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";
+ if($I_am_child) {
+ &child_exit(-1, "Failed to create a lonc listener socket");
+ } else {
+ die "Failed to create a lonc listner socket";
+ }
}
- Event->io(cb => \&NewClient,
- poll => 'r',
- desc => 'Lonc listener Unix Socket',
- fd => $socket);
+ return $socket;
}
#
@@ -1443,6 +1565,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 {
@@ -1451,25 +1574,29 @@ sub ChildStatus {
Debug(2, "Reporting child status because : ".$watcher->data);
my $docdir = $perlvar{'lonDocRoot'};
- my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt");
- print $fh $$."\t".$RemoteHost."\t".$Status."\t".
+
+ open(LOG,">>$docdir/lon-status/loncstatus.txt");
+ flock(LOG,LOCK_EX);
+ print LOG $$."\t".$RemoteHost."\t".$Status."\t".
$RecentLogEntry."\n";
#
# Write out information about each of the connections:
#
if ($DebugLevel > 2) {
- print $fh "Active connection statuses: \n";
+ print LOG "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 LOG "Connection $i State: $state\n";
print STDERR "---------------------- Connection $i \n";
$Socket->Dump(-1); # Ensure it gets dumped..
$i++;
}
}
+ flock(LOG,LOCK_UN);
+ close(LOG);
$ConnectionRetriesLeft = $ConnectionRetries;
}
@@ -1491,12 +1618,14 @@ sub SignalledToDeath {
chomp($signal);
Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost "
."died through "."\"$signal\"");
- LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "
- ."\"$signal\"");
+ #LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "
+# ."\"$signal\"");
exit 0;
}
+=pod
+
=head2 ToggleDebug
This sub toggles trace debugging on and off.
@@ -1512,18 +1641,54 @@ sub ToggleDebug {
}
+=pod
+
=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();
+ delete($parent_dispatchers{$listener});
+
+ }
+
+ # kill off the parent's signal handlers too!
+ #
+
+ for my $handler (keys %parent_handlers) {
+ my $watcher = $parent_handlers{$handler};
+ $watcher->cancel();
+ delete($parent_handlers{$handler});
+ }
+
+ $I_am_child = 1; # Seems like in spite of it all I may still getting
+ # parent event dispatches.. flag I'm a child.
#
# Signals must be handled by the Event framework...
-#
+ #
Event->signal(signal => "QUIT",
cb => \&SignalledToDeath,
@@ -1540,8 +1705,21 @@ sub ChildProcess {
cb => \&ToggleDebug,
data => "INT");
-
- 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;
@@ -1549,20 +1727,26 @@ 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.
- die "Main event loop exited!!!";
+ &child_exit (-1,"Main event loop exited!!!");
}
# Create a new child for host passed in:
sub CreateChild {
- my $host = shift;
+ my ($host, $socket) = @_;
my $sigset = POSIX::SigSet->new(SIGINT);
sigprocmask(SIG_BLOCK, $sigset);
@@ -1579,10 +1763,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
@@ -1632,44 +1963,91 @@ 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");
+
+
+ # Set up all the other signals we set up. We'll vector them off to the
+ # same subs as we would for DieWhenIdle false and, if necessary, conditionalize
+ # the code there.
+
+ $parent_handlers{INT} = Event->signal(cb => \&Terminate,
+ desc => "Parent INT handler",
+ signal => "INT");
+ $parent_handlers{TERM} = Event->signal(cb => \&Terminate,
+ desc => "Parent TERM handler",
+ signal => "TERM");
+ $parent_handlers{HUP} = Event->signal(cb => \&Restart,
+ desc => "Parent HUP handler.",
+ signal => "HUP");
+ $parent_handlers{USR1} = Event->signal(cb => \&CheckKids,
+ desc => "Parent USR1 handler",
+ signal => "USR1");
+ $parent_handlers{USR2} = Event->signal(cb => \&UpdateKids,
+ desc => "Parent USR2 handler.",
+ signal => "USR2");
+
+ # Start procdesing events.
+
+ $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
@@ -1689,11 +2067,14 @@ sub CheckKids {
my $now=time;
my $local=localtime($now);
print $fh "LONC status $local - parent $$ \n\n";
+ foreach my $host (keys %parent_dispatchers) {
+ print $fh "LONC Parent process listening for $host\n";
+ }
foreach my $pid (keys %ChildHash) {
Debug(2, "Sending USR1 -> $pid");
kill 'USR1' => $pid; # Tell Child to report status.
- sleep 1; # Wait so file doesn't intermix.
}
+
}
=pod
@@ -1726,81 +2107,15 @@ sub UpdateKids {
Log("INFO", "Updating connections via SIGUSR2");
- # Just in case we need to kill our own lonc, we wait a few seconds to
- # give it a chance to receive and relay lond's response to the
- # re-init command.
- #
-
- sleep(2); # Wait a couple of seconds.
-
- my %hosts; # Indexed by loncapa hostname, value=ip.
-
- # Need to re-read the host table:
-
-
- LondConnection::ReadConfig();
- my $I = LondConnection::GetHostIterator;
- while (! $I->end()) {
- my $item = $I->get();
- $hosts{$item->[0]} = $item->[4];
- $I->next();
- }
-
- # The logic below is written for clarity not for efficiency.
- # Since I anticipate that this function is only rarely called, that's
- # appropriate. There are certainly ways to combine the loops below,
- # and anyone wishing to obscure the logic is welcome to go for it.
- # Note that we don't re-direct sigchild. Instead we do what's needed
- # to the data structures that keep track of children to ensure that
- # when sigchild is honored, no new child is born.
- #
-
- # For each existing child; if it's host doesn't exist, kill the child.
-
- foreach my $child (keys %ChildHash) {
- my $oldhost = $ChildHash{$child};
- if (!(exists $hosts{$oldhost})) {
- Log("CRITICAL", "Killing child for $oldhost host no longer exists");
- delete $ChildHash{$child};
- delete $HostToPid{$oldhost};
- kill 'QUIT' => $child;
- }
- }
- # For each remaining existing child; if it's host's ip has changed,
- # Restart the child on the new IP.
-
- foreach my $child (keys %ChildHash) {
- my $oldhost = $ChildHash{$child};
- my $oldip = $HostHash{$oldhost};
- if ($hosts{$oldhost} ne $oldip) {
-
- # kill the old child.
+ # I'm not sure what I was thinking in the first implementation.
+ # someone will have to work hard to convince me the effect is any
+ # different than Restart, especially now that we don't start up
+ # per host servers automatically, may as well just restart.
+ # The down side is transactions that are in flight will get timed out
+ # (lost unless they are critical).
- Log("CRITICAL", "Killing child for $oldhost host ip has changed...");
- delete $ChildHash{$child};
- delete $HostToPid{$oldhost};
- kill 'QUIT' => $child;
+ &Restart();
- # Do the book-keeping needed to start a new child on the
- # new ip.
-
- $HostHash{$oldhost} = $hosts{$oldhost};
- CreateChild($oldhost);
- }
- }
- # Finally, for each new host, not in the host hash, create a
- # enter the host and create a new child.
- # Force a status display of any existing process.
-
- foreach my $host (keys %hosts) {
- if(!(exists $HostHash{$host})) {
- Log("INFO", "New host $host discovered in hosts.tab...");
- $HostHash{$host} = $hosts{$host};
- CreateChild($host);
- } else {
- kill 'HUP' => $HostToPid{$host}; # status display.
- }
- }
}
@@ -1819,7 +2134,7 @@ sub Restart {
Log("CRITICAL", "Restarting");
my $execdir = $perlvar{'lonDaemons'};
unlink("$execdir/logs/lonc.pid");
- exec("$execdir/loncnew");
+ exec("$executable");
}
=pod
@@ -1863,6 +2178,7 @@ sub really_kill_them_all_dammit
unlink("$execdir/logs/lonc.pid");
}
}
+
=pod
=head1 Terminate