--- loncom/loncnew 2004/09/29 10:37:35 1.61 +++ loncom/loncnew 2004/10/04 10:30:50 1.62 @@ -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 %perlvar = %{$perlvarref}; 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 @@ my $LondConnecting = 0; # True wh # 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 @@ sub ClientRequest { } +# +# 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 @@ sub 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(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 @@ Optional parameter: =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 @@ sub ChildProcess { 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 @@ sub ChildProcess { # 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 @@ sub ChildProcess { # 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 @@ sub CreateChild { 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 @@ sub CreateChild { # 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 @@ sub parent_listen { 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; }