--- loncom/loncnew 2005/01/19 21:38:25 1.57.2.1 +++ loncom/loncnew 2005/06/09 02:38:03 1.70 @@ -2,7 +2,7 @@ # The LearningOnline Network with CAPA # lonc maintains the connections to remote computers # -# $Id: loncnew,v 1.57.2.1 2005/01/19 21:38:25 albertel Exp $ +# $Id: loncnew,v 1.70 2005/06/09 02:38:03 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -76,7 +76,11 @@ 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 %parent_handlers; # Parent signal handlers... my $MaxConnectionCount = 10; # Will get from config later. my $ClientConnection = 0; # Uniquifier for client events. @@ -86,6 +90,7 @@ my $NextDebugLevel= 2; # So Sigint can my $IdleTimeout= 600; # Wait 10 minutes before pruning connections. my $LogTransactions = 0; # When True, all transactions/replies get logged. +my $executable = $0; # Get the full path to me. # # The variables below are only used by the child processes. @@ -107,7 +112,10 @@ my $LondVersion = "unknown"; # Versi my $KeyMode = ""; # e.g. ssl, local, insecure from last connect. my $LondConnecting = 0; # True when a connection is being built. -my $DieWhenIdle = 0; # When true children die when trimmed -> 0. + + +my $DieWhenIdle = 1; # 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 @@ -144,6 +152,7 @@ sub UpdateStatus { Makes an entry into the permanent log file. =cut + sub LogPerm { my $message=shift; my $execdir=$perlvar{'lonDaemons'}; @@ -263,6 +272,7 @@ sub SocketDump { and as what we return in a SIGUSR1 =cut + sub ShowStatus { my $state = shift; my $now = time; @@ -273,13 +283,14 @@ sub ShowStatus { =pod -=head 2 SocketTimeout +=head2 SocketTimeout Called when an action on the socket times out. The socket is destroyed and any active transaction is failed. =cut + sub SocketTimeout { my $Socket = shift; Log("WARNING", "A socket timeout was detected"); @@ -297,6 +308,44 @@ sub SocketTimeout { } } +# +# This function should be called by the child in all cases where it must +# exit. If the child process is running with the DieWhenIdle turned on +# it must create a lock file for the AF_UNIX socket in order to prevent +# connection requests from lonnet in the time between process exit +# and the parent picking up the listen again. +# Parameters: +# exit_code - Exit status value, however see the next parameter. +# message - If this optional parameter is supplied, the exit +# is via a die with this message. +# +sub child_exit { + my ($exit_code, $message) = @_; + + # Regardless of how we exit, we may need to do the lock thing: + + if($DieWhenIdle) { + # + # Create a lock file since there will be a time window + # between our exit and the parent's picking up the listen + # during which no listens will be done on the + # lonnet client socket. + # + my $lock_file = GetLoncSocketPath().".lock"; + open(LOCK,">$lock_file"); + print LOCK "Contents not important"; + close(LOCK); + + exit(0); + } + # Now figure out how we exit: + + if($message) { + die $message; + } else { + exit($exit_code); + } +} #----------------------------- Timer management ------------------------ =pod @@ -327,18 +376,8 @@ sub Tick { $IdleSeconds = 0; # Otherwise all connections get trimmed to fast. UpdateStatus(); if(($ConnectionCount == 0) && $DieWhenIdle) { - # - # Create a lock file since there will be a time window - # between our exit and the parent's picking up the listen - # during which no listens will be done on the - # lonnet client socket. - # - my $lock_file = GetLoncSocketPath().".lock"; - open(LOCK,">$lock_file"); - print LOCK "Contents not important"; - close(LOCK); - - exit(0); + &child_exit(0); + } } } else { @@ -650,12 +689,14 @@ sub FailTransaction { } =pod + =head1 EmptyQueue Fails all items in the work queue with con_lost. Note that each item in the work queue is a transaction. =cut + sub EmptyQueue { $ConnectionRetriesLeft--; # Counts as connection failure too. while($WorkQueue->Count()) { @@ -671,6 +712,7 @@ sub EmptyQueue { Close all connections open on lond prior to exit e.g. =cut + sub CloseAllLondConnections { foreach my $Socket (keys %ActiveConnections) { if(exists($ActiveTransactions{$Socket})) { @@ -679,7 +721,6 @@ sub CloseAllLondConnections { KillSocket($Socket); } } -=cut =pod @@ -701,8 +742,8 @@ Parameters: nonzero if we are allowed to create a new connection. - =cut + sub KillSocket { my $Socket = shift; @@ -1115,6 +1156,7 @@ sub LondWritable { =pod =cut + sub QueueDelayed { Debug(3,"QueueDelayed called"); @@ -1173,7 +1215,7 @@ sub MakeLondConnection { # my $Socket = $Connection->GetSocket(); if($Socket eq undef) { - die "did not get a socket from the connection"; + &child_exit(-1, "did not get a socket from the connection"); } else { &Debug(9,"MakeLondConnection got socket: ".$Socket); } @@ -1355,6 +1397,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 @@ -1373,21 +1449,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 @@ -1397,10 +1460,20 @@ sub NewClient { Returns the name of the UNIX socket on which to listen for client connections. +=head2 Parameters: + + host (optional) - Name of the host socket to return.. defaults to + the return from GetServerHost(). + =cut sub GetLoncSocketPath { - return $UnixSocketDir."/".GetServerHost(); + + my $host = GetServerHost(); # Default host. + if (@_) { + ($host) = @_; # Override if supplied. + } + return $UnixSocketDir."/".$host; } =pod @@ -1437,22 +1510,32 @@ connection. The event handler establish (creating a communcations channel), that int turn will establish another event handler to subess requests. +=head2 Parameters: + + host (optional) Name of the host to set up a unix socket to. + =cut sub SetupLoncListener { + my $host = GetServerHost(); # Default host. + if (@_) { + ($host) = @_ # Override host with parameter. + } + my $socket; - my $SocketName = GetLoncSocketPath(); + my $SocketName = GetLoncSocketPath($host); unlink($SocketName); unless ($socket =IO::Socket::UNIX->new(Local => $SocketName, Listen => 250, Type => SOCK_STREAM)) { - die "Failed to create a lonc listner socket"; + if($I_am_child) { + &child_exit(-1, "Failed to create a lonc listener socket"); + } else { + die "Failed to create a lonc listner socket"; + } } - Event->io(cb => \&NewClient, - poll => 'r', - desc => 'Lonc listener Unix Socket', - fd => $socket); + return $socket; } # @@ -1482,6 +1565,7 @@ into the status file. We also use this to reset the retries count in order to allow the client to retry connections with a previously dead server. + =cut sub ChildStatus { @@ -1514,6 +1598,7 @@ sub ChildStatus { flock(LOG,LOCK_UN); close(LOG); $ConnectionRetriesLeft = $ConnectionRetries; + UpdateStatus(); } =pod @@ -1534,12 +1619,14 @@ sub SignalledToDeath { chomp($signal); Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost " ."died through "."\"$signal\""); - LogPerm("F:lonc: $$ on $RemoteHost signalled to death: " - ."\"$signal\""); + #LogPerm("F:lonc: $$ on $RemoteHost signalled to death: " +# ."\"$signal\""); exit 0; } +=pod + =head2 ToggleDebug This sub toggles trace debugging on and off. @@ -1555,18 +1642,54 @@ sub ToggleDebug { } +=pod + =head2 ChildProcess This sub implements a child process for a single lonc daemon. +Optional parameter: + $socket - if provided, this is a socket already open for listen + on the client socket. Otherwise, a new listen is set up. =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(); + delete($parent_dispatchers{$listener}); + + } + + # kill off the parent's signal handlers too! + # + + for my $handler (keys %parent_handlers) { + my $watcher = $parent_handlers{$handler}; + $watcher->cancel(); + delete($parent_handlers{$handler}); + } + + $I_am_child = 1; # Seems like in spite of it all I may still getting + # parent event dispatches.. flag I'm a child. # # Signals must be handled by the Event framework... -# + # Event->signal(signal => "QUIT", cb => \&SignalledToDeath, @@ -1583,8 +1706,21 @@ sub ChildProcess { cb => \&ToggleDebug, data => "INT"); - - SetupLoncListener(); + # 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', + fd => $socket); $Event::Debuglevel = $DebugLevel; @@ -1592,20 +1728,26 @@ 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. - die "Main event loop exited!!!"; + &child_exit (-1,"Main event loop exited!!!"); } # 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); @@ -1622,10 +1764,157 @@ 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. + } + } +} + +# parent_client_connection: +# Event handler that processes client connections for the parent process. +# This sub is called when the parent is listening on a socket and +# a connection request arrives. We must: +# Start a child process to accept the connection request. +# Kill our listen on the socket. +# Parameter: +# event - The event object that was created to monitor this socket. +# event->w->fd is the socket. +# Returns: +# NONE +# +sub parent_client_connection { + 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: +# Opens a socket and starts a listen for the parent process on a client UNIX +# domain socket. +# +# This involves: +# Creating a socket for listen. +# Removing any socket lock file +# Adding an event handler for this socket becoming readable +# To the parent's event dispatcher. +# Parameters: +# loncapa_host - LonCAPA cluster name of the host represented by the client +# socket. +# Returns: +# NONE +# +sub parent_listen { + my ($loncapa_host) = @_; + 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($loncapa_host).".lock"; + unlink($lock_file); # No problem if it doesn't exist yet [startup e.g.] + + my $watcher = Event->io(cb => \&parent_client_connection, + poll => 'r', + desc => "Parent listener unix socket ($loncapa_host)", + fd => $socket); + $parent_dispatchers{$loncapa_host} = $watcher; + +} + + +# listen_on_all_unix_sockets: +# This sub initiates a listen on all unix domain lonc client sockets. +# This will be called in the case where we are trimming idle processes. +# When idle processes are trimmed, loncnew starts up with no children, +# and only spawns off children when a connection request occurs on the +# client unix socket. The spawned child continues to run until it has +# been idle a while at which point it eventually exits and once more +# the parent picks up the listen. +# +# Parameters: +# NONE +# Implicit Inputs: +# The configuration file that has been read in by LondConnection. +# Returns: +# NONE +# +sub listen_on_all_unix_sockets { + Debug(5, "listen_on_all_unix_sockets"); + my $host_iterator = &LondConnection::GetHostIterator(); + while (!$host_iterator->end()) { + my $host_entry_ref = $host_iterator->get(); + my $host_name = $host_entry_ref->[0]; + Debug(9, "Listen for $host_name"); + &parent_listen($host_name); + $host_iterator->next(); + } +} + +# server_died is called whenever a child process exits. +# Since this is dispatched via a signal, we must process all +# dead children until there are no more left. The action +# is to: +# - Remove the child from the bookeeping hashes +# - Re-establish a listen on the unix domain socket associated +# with that host. +# Parameters: +# The event, but we don't actually care about it. +sub server_died { + &Debug(9, "server_died called..."); + + while(1) { # Loop until waitpid nowait fails. + my $pid = waitpid(-1, WNOHANG); + if($pid <= 0) { + return; # Nothing left to wait for. + } + # need the host to restart: + + my $host = $ChildHash{$pid}; + if($host) { # It's for real... + &Debug(9, "Caught sigchild for $host"); + delete($ChildHash{$pid}); + delete($HostToPid{$host}); + &parent_listen($host); + + } else { + &Debug(5, "Caught sigchild for pid not in hosts hash: $pid"); + } } } + # # Parent process logic pass 1: # For each entry in the hosts table, we will @@ -1675,44 +1964,91 @@ Log("CRITICAL", "--------------- Startin LondConnection::ReadConfig; # Read standard config files. my $HostIterator = LondConnection::GetHostIterator; -while (! $HostIterator->end()) { - my $hostentryref = $HostIterator->get(); - CreateChild($hostentryref->[0]); - $HostHash{$hostentryref->[0]} = $hostentryref->[4]; - $HostIterator->next(); +if ($DieWhenIdle) { + $RemoteHost = "[parent]"; + &listen_on_all_unix_sockets(); +} else { + + while (! $HostIterator->end()) { + + my $hostentryref = $HostIterator->get(); + CreateChild($hostentryref->[0]); + $HostHash{$hostentryref->[0]} = $hostentryref->[4]; + $HostIterator->next(); + } } + $RemoteHost = "Parent Server"; # Maintain the population: ShowStatus("Parent keeping the flock"); -# -# Set up parent signals: -# -$SIG{INT} = \&Terminate; -$SIG{TERM} = \&Terminate; -$SIG{HUP} = \&Restart; -$SIG{USR1} = \&CheckKids; -$SIG{USR2} = \&UpdateKids; # LonManage update request. - -while(1) { - my $deadchild = wait(); - if(exists $ChildHash{$deadchild}) { # need to restart. - my $deadhost = $ChildHash{$deadchild}; - delete($HostToPid{$deadhost}); - delete($ChildHash{$deadchild}); - Log("WARNING","Lost child pid= ".$deadchild. - "Connected to host ".$deadhost); - Log("INFO", "Restarting child procesing ".$deadhost); - CreateChild($deadhost); +if ($DieWhenIdle) { + # We need to setup a SIGChild event to handle the exit (natural or otherwise) + # of the children. + + Event->signal(cb => \&server_died, + desc => "Child exit handler", + signal => "CHLD"); + + + # Set up all the other signals we set up. We'll vector them off to the + # same subs as we would for DieWhenIdle false and, if necessary, conditionalize + # the code there. + + $parent_handlers{INT} = Event->signal(cb => \&Terminate, + desc => "Parent INT handler", + signal => "INT"); + $parent_handlers{TERM} = Event->signal(cb => \&Terminate, + desc => "Parent TERM handler", + signal => "TERM"); + $parent_handlers{HUP} = Event->signal(cb => \&Restart, + desc => "Parent HUP handler.", + signal => "HUP"); + $parent_handlers{USR1} = Event->signal(cb => \&CheckKids, + desc => "Parent USR1 handler", + signal => "USR1"); + $parent_handlers{USR2} = Event->signal(cb => \&UpdateKids, + desc => "Parent USR2 handler.", + signal => "USR2"); + + # Start procdesing events. + + $Event::DebugLevel = $DebugLevel; + Debug(9, "Parent entering event loop"); + my $ret = Event::loop(); + die "Main Event loop exited: $ret"; + + +} else { + # + # Set up parent signals: + # + + $SIG{INT} = \&Terminate; + $SIG{TERM} = \&Terminate; + $SIG{HUP} = \&Restart; + $SIG{USR1} = \&CheckKids; + $SIG{USR2} = \&UpdateKids; # LonManage update request. + + while(1) { + my $deadchild = wait(); + if(exists $ChildHash{$deadchild}) { # need to restart. + my $deadhost = $ChildHash{$deadchild}; + delete($HostToPid{$deadhost}); + delete($ChildHash{$deadchild}); + Log("WARNING","Lost child pid= ".$deadchild. + "Connected to host ".$deadhost); + Log("INFO", "Restarting child procesing ".$deadhost); + CreateChild($deadhost); + } } } - =pod =head1 CheckKids @@ -1732,10 +2068,14 @@ sub CheckKids { my $now=time; my $local=localtime($now); print $fh "LONC status $local - parent $$ \n\n"; + foreach my $host (keys %parent_dispatchers) { + print $fh "LONC Parent process listening for $host\n"; + } foreach my $pid (keys %ChildHash) { Debug(2, "Sending USR1 -> $pid"); kill 'USR1' => $pid; # Tell Child to report status. } + } =pod @@ -1768,81 +2108,15 @@ sub UpdateKids { Log("INFO", "Updating connections via SIGUSR2"); - # Just in case we need to kill our own lonc, we wait a few seconds to - # give it a chance to receive and relay lond's response to the - # re-init command. - # + # I'm not sure what I was thinking in the first implementation. + # someone will have to work hard to convince me the effect is any + # different than Restart, especially now that we don't start up + # per host servers automatically, may as well just restart. + # The down side is transactions that are in flight will get timed out + # (lost unless they are critical). - sleep(2); # Wait a couple of seconds. + &Restart(); - my %hosts; # Indexed by loncapa hostname, value=ip. - - # Need to re-read the host table: - - - LondConnection::ReadConfig(); - my $I = LondConnection::GetHostIterator; - while (! $I->end()) { - my $item = $I->get(); - $hosts{$item->[0]} = $item->[4]; - $I->next(); - } - - # The logic below is written for clarity not for efficiency. - # Since I anticipate that this function is only rarely called, that's - # appropriate. There are certainly ways to combine the loops below, - # and anyone wishing to obscure the logic is welcome to go for it. - # Note that we don't re-direct sigchild. Instead we do what's needed - # to the data structures that keep track of children to ensure that - # when sigchild is honored, no new child is born. - # - - # For each existing child; if it's host doesn't exist, kill the child. - - foreach my $child (keys %ChildHash) { - my $oldhost = $ChildHash{$child}; - if (!(exists $hosts{$oldhost})) { - Log("CRITICAL", "Killing child for $oldhost host no longer exists"); - delete $ChildHash{$child}; - delete $HostToPid{$oldhost}; - kill 'QUIT' => $child; - } - } - # For each remaining existing child; if it's host's ip has changed, - # Restart the child on the new IP. - - foreach my $child (keys %ChildHash) { - my $oldhost = $ChildHash{$child}; - my $oldip = $HostHash{$oldhost}; - if ($hosts{$oldhost} ne $oldip) { - - # kill the old child. - - Log("CRITICAL", "Killing child for $oldhost host ip has changed..."); - delete $ChildHash{$child}; - delete $HostToPid{$oldhost}; - kill 'QUIT' => $child; - - # Do the book-keeping needed to start a new child on the - # new ip. - - $HostHash{$oldhost} = $hosts{$oldhost}; - CreateChild($oldhost); - } - } - # Finally, for each new host, not in the host hash, create a - # enter the host and create a new child. - # Force a status display of any existing process. - - foreach my $host (keys %hosts) { - if(!(exists $HostHash{$host})) { - Log("INFO", "New host $host discovered in hosts.tab..."); - $HostHash{$host} = $hosts{$host}; - CreateChild($host); - } else { - kill 'HUP' => $HostToPid{$host}; # status display. - } - } } @@ -1861,7 +2135,7 @@ sub Restart { Log("CRITICAL", "Restarting"); my $execdir = $perlvar{'lonDaemons'}; unlink("$execdir/logs/lonc.pid"); - exec("$execdir/loncnew"); + exec("$executable"); } =pod @@ -1905,6 +2179,7 @@ sub really_kill_them_all_dammit unlink("$execdir/logs/lonc.pid"); } } + =pod =head1 Terminate