[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--