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

foxr lon-capa-cvs@mail.lon-capa.org
Mon, 04 Oct 2004 10:30:50 -0000


foxr		Mon Oct  4 06:30:50 2004 EDT

  Modified files:              
    /loncom	loncnew 
  Log:
  Get the subprocess forking to work.  A lot of stuff still to do (Handling
  child exit for one, signals etc. for another), so pleases still leave
  DieWhenIdle false.
  
  
  
  
Index: loncom/loncnew
diff -u loncom/loncnew:1.61 loncom/loncnew:1.62
--- loncom/loncnew:1.61	Wed Sep 29 06:37:35 2004
+++ loncom/loncnew	Mon Oct  4 06:30:50 2004
@@ -2,7 +2,7 @@
 # The LearningOnline Network with CAPA
 # lonc maintains the connections to remote computers
 #
-# $Id: loncnew,v 1.61 2004/09/29 10:37:35 foxr Exp $
+# $Id: loncnew,v 1.62 2004/10/04 10:30:50 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -75,7 +75,9 @@
 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.
@@ -110,6 +112,7 @@
 # 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
@@ -1356,6 +1359,40 @@
 
 }
 
+#
+#     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
 
@@ -1374,21 +1411,8 @@
     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
@@ -1578,6 +1602,27 @@
 =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. 
 
 
     #
@@ -1599,12 +1644,17 @@
 		  cb       => \&ToggleDebug,
 		  data     => "INT");
 
-    
+    #  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',
@@ -1616,8 +1666,14 @@
 
 # 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.
@@ -1629,7 +1685,7 @@
 #  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);
@@ -1646,7 +1702,11 @@
 	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.
+	}
     }
 }
 
@@ -1664,8 +1724,36 @@
 #    NONE
 #
 sub parent_client_connection {
-    die "DieWhenIdle processing not completely operational yet";
-
+    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:
@@ -1688,17 +1776,19 @@
     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().".lock";
+    my $lock_file = &GetLoncSocketPath($loncapa_host).".lock";
     unlink($lock_file);		# No problem if it doesn't exist yet [startup e.g.]
 
-    Event->io(cb    => &parent_client_connection,
+    my $watcher = Event->io(cb    => \&parent_client_connection,
 	      poll  => 'r',
-	      desc  => 'Parent listener unix socket',
+	      desc  => "Parent listener unix socket ($loncapa_host)",
 	      fd    => $socket);
+    $parent_dispatchers{$loncapa_host} = $watcher;
 
 }