[LON-CAPA-cvs] cvs: loncom / loncnew

[albertel]

albertel		Tue Apr 10 20:10:46 2007 EDT

  Modified files:              
    /loncom	loncnew 
  Log:
  - when there is a race to create a connection make sure only one child gets forked off
  
  
Index: loncom/loncnew
diff -u loncom/loncnew:1.82 loncom/loncnew:1.83
--- loncom/loncnew:1.82	Wed Mar 28 17:44:05 2007
+++ loncom/loncnew	Tue Apr 10 20:10:45 2007
@@ -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.83 2007/04/11 00:10:45 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -72,7 +72,8 @@
 #
 #  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. 
@@ -1762,7 +1763,7 @@
     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 +1833,12 @@
 
     &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 +1893,7 @@
 
 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 +1902,12 @@
 }
 
 
-# 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 +1916,6 @@
 #  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 +1940,11 @@
 	}
 	# 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 +2068,7 @@
     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.
     }
@@ -2154,8 +2146,8 @@
 sub KillThemAll {
     Debug(2, "Kill them all!!");
     local($SIG{CHLD}) = 'IGNORE';      # Our children >will< die.
-    foreach my $pid (keys %ChildHash) {
-	my $serving = $ChildHash{$pid};
+    foreach my $pid (keys %ChildPid) {
+	my $serving = $ChildPid{$pid};
 	ShowStatus("Nicely Killing lonc for $serving pid = $pid");
 	Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid");
 	kill 'QUIT' => $pid;
@@ -2171,12 +2163,12 @@
 {
     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");
     }