--- loncom/loncnew 2007/03/28 21:44:05 1.82
+++ loncom/loncnew 2007/05/01 01:04:23 1.85
@@ -2,7 +2,7 @@
# The LearningOnline Network with CAPA
# lonc maintains the connections to remote computers
#
-# $Id: loncnew,v 1.82 2007/03/28 21:44:05 albertel Exp $
+# $Id: loncnew,v 1.85 2007/05/01 01:04:23 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -72,7 +72,8 @@ my %perlvar = %{$perlvarref};
#
# parent and shared variables.
-my %ChildHash; # by pid -> host.
+my %ChildPid; # by pid -> host.
+my %ChildHost; # by host.
my %listening_to; # Socket->host table for who the parent
# is listening to.
my %parent_dispatchers; # host-> listener watcher events.
@@ -501,6 +502,9 @@ the data and Event->w->fd is the socket
sub ClientWritable {
my $Event = shift;
my $Watcher = $Event->w;
+ if (!defined($Watcher)) {
+ &child_exit(-1,'No watcher for event in ClientWritable');
+ }
my $Data = $Watcher->data;
my $Socket = $Watcher->fd;
@@ -564,6 +568,7 @@ sub ClientWritable {
}
} else {
$Watcher->cancel(); # A delayed request...just cancel.
+ return;
}
}
@@ -1762,7 +1767,7 @@ sub CreateChild {
my $pid = fork;
if($pid) { # Parent
$RemoteHost = "Parent";
- $ChildHash{$pid} = $host;
+ $ChildPid{$pid} = $host;
sigprocmask(SIG_UNBLOCK, $sigset);
undef(@all_host_ids);
} else { # child.
@@ -1832,8 +1837,12 @@ sub get_remote_hostname {
&Debug(5,"Creating child for $data (parent_client_connection)");
(my $hostname,my $lonid,@all_host_ids) = split(':',$data);
- &CreateChild($hostname,$lonid);
-
+ $ChildHost{$hostname}++;
+ if ($ChildHost{$hostname} == 1) {
+ &CreateChild($hostname,$lonid);
+ } else {
+ &Log('WARNING',"Request for a second child on $hostname");
+ }
# Clean up the listen since now the child takes over until it exits.
$watcher->cancel(); # Nolonger listening to this event
$socket->send("done\n");
@@ -1888,7 +1897,7 @@ sub parent_listen {
sub parent_clean_up {
my ($loncapa_host) = @_;
- Debug(5, "parent_clean_up: $loncapa_host");
+ Debug(-1, "parent_clean_up: $loncapa_host");
my $socket_file = &GetLoncSocketPath($loncapa_host);
unlink($socket_file); # No problem if it doesn't exist yet [startup e.g.]
@@ -1897,14 +1906,12 @@ sub parent_clean_up {
}
-# 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.
+
+# This sub initiates a listen on the common unix domain lonc client socket.
+# loncnew starts up with no children, and only spawns off children when a
+# connection request occurs on the common 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
@@ -1913,18 +1920,6 @@ sub parent_clean_up {
# 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->[3];
- Debug(9, "Listen for $host_name");
- &parent_listen($host_name);
- $host_iterator->next();
- }
-}
-
sub listen_on_common_socket {
Debug(5, "listen_on_common_socket");
&parent_listen();
@@ -1949,10 +1944,11 @@ sub server_died {
}
# need the host to restart:
- my $host = $ChildHash{$pid};
+ my $host = $ChildPid{$pid};
if($host) { # It's for real...
&Debug(9, "Caught sigchild for $host");
- delete($ChildHash{$pid});
+ delete($ChildPid{$pid});
+ delete($ChildHost{$host});
&parent_clean_up($host);
} else {
@@ -2076,7 +2072,7 @@ sub CheckKids {
foreach my $host (keys %parent_dispatchers) {
print $fh "LONC Parent process listening for $host\n";
}
- foreach my $pid (keys %ChildHash) {
+ foreach my $pid (keys %ChildPid) {
Debug(2, "Sending USR1 -> $pid");
kill 'USR1' => $pid; # Tell Child to report status.
}
@@ -2153,13 +2149,19 @@ SIGHUP. Responds to sigint and sigterm.
sub KillThemAll {
Debug(2, "Kill them all!!");
- local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die.
- foreach my $pid (keys %ChildHash) {
- my $serving = $ChildHash{$pid};
+
+ #local($SIG{CHLD}) = 'IGNORE';
+ # Our children >will< die.
+ # but we need to catch their death and cleanup after them in case this is
+ # a restart set of kills
+ my @allpids = keys(%ChildPid);
+ foreach my $pid (@allpids) {
+ my $serving = $ChildPid{$pid};
ShowStatus("Nicely Killing lonc for $serving pid = $pid");
Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid");
kill 'QUIT' => $pid;
}
+ ShowStatus("Finished killing child processes off.");
}
@@ -2171,12 +2173,12 @@ 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};
+ foreach my $pid (keys %ChildPid) {
+ my $serving = $ChildPid{$pid};
&ShowStatus("Nastily killing lonc for $serving pid = $pid");
Log("CRITICAL", "Nastily killing lonc for $serving pid = $pid");
kill 'KILL' => $pid;
- delete($ChildHash{$pid});
+ delete($ChildPid{$pid});
my $execdir = $perlvar{'lonDaemons'};
unlink("$execdir/logs/lonc.pid");
}