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

foxr lon-capa-cvs@mail.lon-capa.org
Sat, 12 Apr 2003 02:47:49 -0000


This is a MIME encoded message

--foxr1050115669
Content-Type: text/plain

foxr		Fri Apr 11 22:47:49 2003 EDT

  Modified files:              
    /newloncapa	loncnew 
  Log:
  Extended to run a master process that forks off and maintains children.
  
  
  
--foxr1050115669
Content-Type: text/plain
Content-Disposition: attachment; filename="foxr-20030411224749.txt"

Index: newloncapa/loncnew
diff -u newloncapa/loncnew:1.6 newloncapa/loncnew:1.7
--- newloncapa/loncnew:1.6	Tue Apr  8 21:09:18 2003
+++ newloncapa/loncnew	Fri Apr 11 22:47:49 2003
@@ -27,27 +27,42 @@
 use Queue;
 use Stack;
 use LondConnection;
+use LONCAPA::Configuration;
+use HashIterator;
 
 print "Loncnew starting\n";
 
+# Read the httpd configuration file to get perl variables
+# normally set in apache modules:
+
+my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');
+my %perlvar    = %{$perlvarref};
+
 #
-#   The stack below is a cache of a idle connections.
-#
+#  parent and shared variables.
+
+my %ChildHash;			# by pid -> host.
+
 
-my $IdleConnections = Stack->new();
+my $MaxConnectionCount = 5;	# Will get from config later.
+my $ClientConnection = 0;	# Uniquifier for client events.
+
+my $DebugLevel = 5;
+my $IdleTimeout= 3600;		# Wait an hour before pruning connections.
+
+#
+#  The variables below are only used by the child processes.
+#
+my $RemoteHost;			# Name of host child is talking to.
+my $UnixSocketDir= "/home/foxr/pipes"; # Testing for now.
+my $IdleConnections = Stack->new(); # Set of idle connections
 my %ActiveConnections;		# Connections to the remote lond.
 my %ActiveTransactions;		# Transactions in flight.
 my %ActiveClients;		# Serial numbers of active clients by socket.
-
-
 my $WorkQueue       = Queue->new(); # Queue of pending transactions.
 my $ClientQueue     = Queue->new(); # Queue of clients causing xactinos.
 my $ConnectionCount = 0;
-my $MaxConnectionCount = 5;	# Will get from config later.
-my $ClientConnection = 0;	# Uniquifier for client events.
 
-$DebugLevel = 10;
-$IdleTimeout= 3600;		# Wait an hour before pruning connections.
 
 #
 =pod
@@ -81,7 +96,15 @@
     my $level   = shift;
     my $message = shift;
     if ($level <= $DebugLevel) {
-	print $message."\n";
+	print $message." host = ".$RemoteHost."\n";
+    }
+}
+
+sub SocketDump {
+    my $level = shift;
+    my $socket= shift;
+    if($level <= $DebugLevel) {
+	$socket->Dump();
     }
 }
 =pod
@@ -91,10 +114,10 @@
 
 sub Tick {
     my $client;
-    Debug(4, "Tick");
-    Debug(9, "    Current connection count: ".$ConnectionCount);
+    Debug(6, "Tick");
+    Debug(6, "    Current connection count: ".$ConnectionCount);
     foreach $client (keys %ActiveClients) {
-	Debug(9, "    Have client:  with id: ".$ActiveClients{$client});
+	Debug(7, "    Have client:  with id: ".$ActiveClients{$client});
     }
 }
 
@@ -109,7 +132,7 @@
 =cut
 
 sub SetupTimer {
-    Debug(4, "SetupTimer");
+    Debug(6, "SetupTimer");
     Event->timer(interval => 1, debug => 1, cb => \&Tick );
 }
 =pod
@@ -127,7 +150,7 @@
 sub ServerToIdle {
     my $Socket   = shift;	# Get the socket.
 
-    &Debug(1, "Server to idle");
+    &Debug(6, "Server to idle");
 
     #  If there's work to do, start the transaction:
 
@@ -135,14 +158,14 @@
     Debug(9, "Queue gave request data: ".$reqdata);
     unless($reqdata eq undef)  {
 	my $unixSocket = $ClientQueue->dequeue();
-	&Debug(3, "Starting new work request");
-	&Debug(9, "Request: ".$reqdata);
+	&Debug(6, "Starting new work request");
+	&Debug(7, "Request: ".$reqdata);
 	
 	&StartRequest($Socket, $unixSocket, $reqdata);
     } else {
 	
     #  There's no work waiting, so push the server to idle list.
-	&Debug(3, "No new work requests, server connection going idle");
+	&Debug(8, "No new work requests, server connection going idle");
 	delete($ActiveTransactions{$Socket});
 	$IdleConnections->push($Socket);
     }
@@ -167,7 +190,7 @@
 
     # Try to send the data:
 
-    &Debug(1, "ClientWritable writing".$Data);
+    &Debug(6, "ClientWritable writing".$Data);
     &Debug(9, "Socket is: ".$Socket);
 
     my $result = $Socket->send($Data, 0);
@@ -209,7 +232,7 @@
 	   $errno == POSIX::EINTR) {
 	    # No action taken?
 	} else {		# Unanticipated errno.
-	    &Debug(5,"ClientWritable error or peer shutdown");
+	    &Debug(5,"ClientWritable error or peer shutdown".$RemoteHost);
 	    $Watcher->cancel;	# Stop the watcher.
 	    $Socket->shutdown(2); # Kill connection
 	    $Socket->close();	# Close the socket.
@@ -233,7 +256,7 @@
 
 =cut
 sub CompleteTransaction {
-    &Debug(4,"Complete transaction");
+    &Debug(6,"Complete transaction");
     my $Socket = shift;
     my $Client = shift;
 
@@ -300,15 +323,16 @@
 
     my $State = $Socket->GetState(); # All action depends on the state.
 
-    &Debug(4,"LondReadable called state = ".$State);
-    $Socket->Dump();
+    &Debug(6,"LondReadable called state = ".$State);
+    SocketDump(6, $Socket);
+
     if($Socket->Readable() != 0) {
 	 # bad return from socket read.
     }
-    $Socket->Dump();
+    SocketDump(6,$Socket);
 
     $State = $Socket->GetState(); # Update in case of transition.
-    &Debug(5, "After read, state is ".$State);
+    &Debug(6, "After read, state is ".$State);
 
    if($State eq "Initialized") {
 
@@ -348,7 +372,7 @@
 	#  We need to be writable for this and probably don't belong
 	#  here inthe first place.
 
-	Deubg(5, "SendingRequest state encountered in readable");
+	Deubg(6, "SendingRequest state encountered in readable");
 	$Watcher->poll("w");
 	$Watcher->cb(\&LondWritable);
 
@@ -414,7 +438,7 @@
     my $Event   = shift;
     my $Watcher = $Event->w;
     my @data    = $Watcher->data;
-    Debug(4,"LondWritable State = ".$State." data has ".@data." elts.\n");
+    Debug(6,"LondWritable State = ".$State." data has ".@data." elts.\n");
 
     my $Socket  = $data[0];	# I know there's at least a socket.
 
@@ -424,7 +448,7 @@
     my $State   = $Socket->GetState();
 
 
-    $Socket->Dump();
+    SocketDump(6,$Socket);
 
     if      ($State eq "Connected")         {
 	#  "init" is being sent...
@@ -529,7 +553,7 @@
     if($Socket == undef) {
 	die "did not get a socket from the connection";
     } else {
-	&Debug(4,"MakeLondConnection got socket: ".$Socket);
+	&Debug(9,"MakeLondConnection got socket: ".$Socket);
     }
 
     
@@ -562,7 +586,7 @@
     my $Client   = shift;
     my $Request  = shift;
     
-    Debug(4, "StartRequest: ".$Request);
+    Debug(6, "StartRequest: ".$Request);
 
     my $Socket = $Lond->GetSocket();
     
@@ -596,11 +620,11 @@
     my $requestSocket = shift;
     my $requestData   = shift;
 
-    Debug(4,"QueueTransaction: ".$requestData);
+    Debug(6,"QueueTransaction: ".$requestData);
 
     my $LondSocket    = $IdleConnections->pop();
     if(!defined $LondSocket) {	# Need to queue request.
-	Debug(4,"Must queue...");
+	Debug(8,"Must queue...");
 	$ClientQueue->enqueue($requestSocket);
 	$WorkQueue->enqueue($requestData);
 	if($ConnectionCount < $MaxConnectionCount) {
@@ -608,7 +632,7 @@
 	    MakeLondConnection();
 	}
     } else {			# Can start the request:
-	Debug(4,"Can start...");
+	Debug(8,"Can start...");
 	StartRequest($LondSocket, $requestSocket, $requestData);
     }
 }
@@ -622,7 +646,7 @@
 =cut
 
 sub ClientRequest {
-    Debug(4, "ClientRequest");
+    Debug(6, "ClientRequest");
     my $event   = shift;
     my $watcher = $event->w;
     my $socket  = $watcher->fd;
@@ -636,7 +660,7 @@
 	  ." read =".$thisread);
     unless (defined $rv && length($thisread)) {
 	 # Likely eof on socket.
-	Debug(2,"Socket closed");
+	Debug(5,"Client Socket closed on lonc for ".$RemoteHost);
 	close($socket);
 	$watcher->cancel();
 	delete($ActiveClients{$socket});
@@ -645,7 +669,7 @@
     $data = $data.$thisread;	# Append new data.
     $watcher->data($data);
     if($data =~ /(.*\n)/) {	# Request entirely read.
-	Debug(2, "Complete transaction received: ".$data);
+	Debug(8, "Complete transaction received: ".$data);
 	QueueTransaction($socket, $data);
 	$watcher->cancel();	# Done looking for input data.
     }
@@ -662,18 +686,18 @@
     and register a new event on the readability of that socket:
 =cut
 sub NewClient {
-    Debug(4, "NewClient");
+    Debug(6, "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(3,"Connection request accepted from "
+    Debug(8,"Connection request accepted from "
 	  .GetPeername($connection, AF_UNIX));
 
 
     my $description = sprintf("Connection to lonc client %d",
 			      $ClientConnection);
-    Debug(4, "Creating event named: ".$description);
+    Debug(9, "Creating event named: ".$description);
     Event->io(cb      => \&ClientRequest,
 	      poll    => 'r',
 	      desc    => $description,
@@ -688,20 +712,20 @@
 
 =cut
 sub GetLoncSocketPath {
-    return "/home/foxr/londtest";
+    return $UnixSocketDir."/".GetServerHost();
 }
 
 =pod GetServerHost 
    Returns the host whose lond we talk with.
 =cut
 sub GetServerHost {		# Stub - get this from config.
-    return "nscll1";
+    return $RemoteHost;		# Setup by the fork.
 }
 =pod GetServerPort
    Returns the lond port number.
 =cut
 sub GetServerPort {		# Stub - get this from config.
-    return 5663;
+    return $perlvar{londPort};
 }
 =pod SetupLoncListener
    Setup a lonc listener event.  The event is called when
@@ -726,29 +750,81 @@
 	      desc   => 'Lonc listener Unix Socket',
 	      fd     => $socket);
 }
-#------------------------- Main program ---------------------
-#
-#  Setup up event notifications for connections on the UNIX socket and
-#  the timer then dive into the main event loop.
-#
 
-print "Loncnew\n";
-SetupTimer();
+=pod
+=head2 ChildProcess
+
+This sub implements a child process for a single lonc daemon.
+
+=cut
 
-SetupLoncListener();
+sub ChildProcess {
 
-$Event::Debuglevel = $DebugLevel;
+    print "Loncnew\n";
+    SetupTimer();
+    
+    SetupLoncListener();
+    
+    $Event::Debuglevel = $DebugLevel;
+    
+    Debug(9, "Making initial lond connection for ".$RemoteHost);
 
-Debug(9, "Making lond connection");
 # Setup the initial server connection:
+    
+    &MakeLondConnection();
+    
+    Debug(9,"Entering event loop");
+    my $ret = Event::loop();		#  Start the main event loop.
+    
+    
+    die "Main event loop exited!!!";
+}
 
-&MakeLondConnection();
+#  Create a new child for host passed in:
+
+sub CreateChild {
+    my $host = shift;
+    $RemoteHost = $host;
+    Debug(3, "Forking off child for ".$RemoteHost);
+    sleep(5);
+    $pid          = fork;
+    if($pid) {			# Parent
+	$ChildHash{$pid} = $RemoteHost;
+    } else {			# child.
+	ChildProcess;
+    }
 
-Debug(9,"Entering event loop");
-my $ret = Event::loop();		#  Start the main event loop.
+}
+#
+#  Parent process logic pass 1:
+#   For each entry in the hosts table, we will
+#  fork off an instance of ChildProcess to service the transactions
+#  to that host.  Each pid will be entered in a global hash
+#  with the value of the key, the host.
+#  The parent will then enter a loop to wait for process exits.
+#  Each exit gets logged and the child gets restarted.
+#
 
+my $HostIterator = LondConnection::GetHostIterator;
+while (! $HostIterator->end()) {
 
-die "Main event loop exited!!!";
+    $hostentryref = $HostIterator->get();
+    CreateChild($hostentryref->[0]);
+    $HostIterator->next();
+}
+
+# Maintain the population:
+
+while(1) {
+    $deadchild = wait();
+    if(exists $ChildHash{$deadchild}) {	# need to restart.
+	$deadhost = $ChildHash{$deadchild};
+	delete($ChildHash{$deadchild});
+	Debug(4,"Lost child pid= ".$deadchild.
+	      "Connected to host ".$deadhost);
+	CreateChild($deadhost);
+    }
+}
 
 =head1 Theory
    The event class is used to build this as a single process with

--foxr1050115669--