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