--- loncom/loncnew 2003/06/13 02:38:43 1.9 +++ loncom/loncnew 2003/08/06 09:52:29 1.18 @@ -2,13 +2,12 @@ # The LearningOnline Network with CAPA # lonc maintains the connections to remote computers # -# $Id: loncnew,v 1.9 2003/06/13 02:38:43 foxr Exp $ +# $Id: loncnew,v 1.18 2003/08/06 09:52:29 foxr Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). -# -# LON-CAPA is free software; you can redistribute it and/or modify +## LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. @@ -27,7 +26,7 @@ # http://www.lon-capa.org/ # # -# new lonc handles n requestors spread out bver m connections to londs. +# new lonc handles n request out bver m connections to londs. # This module is based on the Event class. # Development iterations: # - Setup basic event loop. (done) @@ -46,6 +45,40 @@ # Change log: # $Log: loncnew,v $ +# Revision 1.18 2003/08/06 09:52:29 foxr +# Also needed to remember to fail in-flight transactions if their sends fail. +# +# Revision 1.17 2003/08/03 00:44:31 foxr +# 1. Correct handling of connection failure: Assume it means the host is +# unreachable and fail all of the queued transactions. Note that the +# inflight transactions should fail on their own time due either to timeout +# or send/receive failures. +# 2. Correct handling of logs for forced death signals. Pull the signal +# from the event watcher. +# +# Revision 1.16 2003/07/29 02:33:05 foxr +# Add SIGINT processing to child processes to toggle annoying trace mode +# on/off.. will try to use this to isolate the compute boud process issue. +# +# Revision 1.15 2003/07/15 02:07:05 foxr +# Added code for lonc/lond transaction timeouts. Who knows if it works right. +# The intent is for a timeout to fail any transaction in progress and kill +# off the sockt that timed out. +# +# Revision 1.14 2003/07/03 02:10:18 foxr +# Get all of the signals to work correctly. +# +# Revision 1.13 2003/07/02 01:31:55 foxr +# Added kill -HUP logic (restart). +# +# Revision 1.11 2003/06/25 01:54:44 foxr +# Fix more problems with transaction failure. +# +# Revision 1.10 2003/06/24 02:46:04 foxr +# Put a limit on the number of times we'll retry a connection. +# Start getting the signal stuff put in as well...note that need to get signals +# going or else 6the client will permanently give up on dead servers. +# # Revision 1.9 2003/06/13 02:38:43 foxr # Add logging in 'expected format' # @@ -63,6 +96,7 @@ use lib "/home/httpd/lib/perl/"; use lib "/home/foxr/newloncapa/types"; use Event qw(:DEFAULT ); use POSIX qw(:signal_h); +use POSIX; use IO::Socket; use IO::Socket::INET; use IO::Socket::UNIX; @@ -81,12 +115,12 @@ use LONCAPA::HashIterator; # # Disable all signals we might receive from outside for now. # -$SIG{QUIT} = IGNORE; -$SIG{HUP} = IGNORE; -$SIG{USR1} = IGNORE; -$SIG{INT} = IGNORE; -$SIG{CHLD} = IGNORE; -$SIG{__DIE__} = IGNORE; +#$SIG{QUIT} = IGNORE; +#$SIG{HUP} = IGNORE; +#$SIG{USR1} = IGNORE; +#$SIG{INT} = IGNORE; +#$SIG{CHLD} = IGNORE; +#$SIG{__DIE__} = IGNORE; # Read the httpd configuration file to get perl variables @@ -105,6 +139,7 @@ my $MaxConnectionCount = 10; # Will get my $ClientConnection = 0; # Uniquifier for client events. my $DebugLevel = 0; +my $NextDebugLevel= 10; # So Sigint can toggle this. my $IdleTimeout= 3600; # Wait an hour before pruning connections. # @@ -120,7 +155,9 @@ my $WorkQueue = Queue->new(); # Qu my $ConnectionCount = 0; my $IdleSeconds = 0; # Number of seconds idle. my $Status = ""; # Current status string. - +my $RecentLogEntry = ""; +my $ConnectionRetries=5; # Number of connection retries allowed. +my $ConnectionRetriesLeft=5; # Number of connection retries remaining. # # The hash below gives the HTML format for log messages @@ -134,7 +171,23 @@ $LogFormats{"INFO"} = "new(">>$execdir/logs/lonnet.perm.log"); + print $fh "$now:$message:$local\n"; +} =pod @@ -179,8 +232,10 @@ sub Log { my $execdir = $perlvar{'lonDaemons'}; my $fh = IO::File->new(">>$execdir/logs/lonc.log"); my $msg = sprintf($finalformat, $message); + $RecentLogEntry = $msg; print $fh $msg; + } @@ -221,7 +276,7 @@ sub Debug { my $level = shift; my $message = shift; if ($level <= $DebugLevel) { - print $message." host = ".$RemoteHost."\n"; + Log("INFO", "-Debug- $message host = $RemotHost"); } } @@ -238,13 +293,30 @@ sub SocketDump { =head2 ShowStatus Place some text as our pid status. + and as what we return in a SIGUSR1 =cut sub ShowStatus { - my $status = shift; - $0 = "lonc: ".$status; - $Status = $status; # Make available for logging. + my $state = shift; + my $now = time; + my $local = localtime($now); + $Status = $local.": ".$state; + $0='lonc: '.$state.' '.$local; +} +=pod + +=head 2 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; + + KillSocket($Socket); } =pod @@ -259,11 +331,7 @@ Invoked each timer tick. sub Tick { my $client; ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount); - Debug(6, "Tick"); - Debug(6, " Current connection count: ".$ConnectionCount); - foreach $client (keys %ActiveClients) { - Debug(7, " Have client: with id: ".$ActiveClients{$client}); - } + # Is it time to prune connection count: @@ -277,18 +345,29 @@ sub Tick { } else { $IdleSeconds = 0; # Reset idle count if not idle. } - + # + # For each inflight transaction, tick down its timeout counter. + # + foreach $item (keys %ActiveTransactions) { + my $Socket = $ActiveTransactions{$item}->getServer(); + $Socket->Tick(); + } # Do we have work in the queue, but no connections to service them? # If so, try to make some new connections to get things going again. # my $Requests = $WorkQueue->Count(); - if (($ConnectionCount == 0) && ($Requests > 0)) { - my $Connections = ($Requests <= $MaxConnectionCount) ? - $Requests : $MaxConnectionCount; - Debug(1,"Work but no connections, starting ".$Connections." of them"); - for ($i =0; $i < $Connections; $i++) { - MakeLondConnection(); + if (($ConnectionCount == 0) && ($Requests > 0)) { + if ($ConnectionRetriesLeft > 0) { + my $Connections = ($Requests <= $MaxConnectionCount) ? + $Requests : $MaxConnectionCount; + Debug(1,"Work but no connections, start ".$Connections." of them"); + for ($i =0; $i < $Connections; $i++) { + MakeLondConnection(); + } + } else { + Debug(1,"Work in queue, but gave up on connections..flushing\n"); + EmptyQueue(); # Connections can't be established. } } @@ -410,6 +489,12 @@ sub ClientWritable { } else { # Partial string sent. $Watcher->data(substr($Data, $result)); + if($result == 0) { # client hung up on us!! + Log("INFO", "lonc pipe client hung up on us!"); + $Watcher->cancel; + $Socket->shutdown(2); + $Socket->close(); + } } } else { # Error of some sort... @@ -466,6 +551,7 @@ sub CompleteTransaction { StartClientReply($Transaction, $data); } else { # Delete deferred transaction file. Log("SUCCESS", "A delayed transaction was completed"); + LogPerm("S:$Client:".$Transaction->getRequest()); unlink $Transaction->getFile(); } } @@ -489,6 +575,7 @@ sub StartClientReply { my $Transaction = shift; my $data = shift; + my $Client = $Transaction->getClient(); &Debug(8," Reply was: ".$data); @@ -525,13 +612,13 @@ Parameters: sub FailTransaction { my $transaction = shift; - my $Lond = $transaction->getServer(); - if (!$client->isDeferred()) { # If the transaction is deferred we'll get to it. - my $client = $transcation->getClient(); - StartClientReply($client, "con_lost"); + Log("WARNING", "Failing transaction ".$transaction->getRequest()); + Debug(1, "Failing transaction: ".$transaction->getRequest()); + if (!$transaction->isDeferred()) { # If the transaction is deferred we'll get to it. + my $client = $transaction->getClient(); + Debug(1," Replying con_lost to ".$transaction->getRequest()); + StartClientReply($transaction, "con_lost\n"); } -# not needed, done elsewhere if active. -# delete $ActiveTransactions{$Lond}; } @@ -544,7 +631,7 @@ sub FailTransaction { =cut sub EmptyQueue { while($WorkQueue->Count()) { - my $request = $Workqueue->dequeue(); # This is a transaction + my $request = $WorkQueue->dequeue(); # This is a transaction FailTransaction($request); } } @@ -588,6 +675,7 @@ nonzero if we are allowed to create a ne sub KillSocket { my $Socket = shift; + Log("WARNING", "Shutting down a socket"); $Socket->Shutdown(); # If the socket came from the active connection set, @@ -683,13 +771,17 @@ sub LondReadable { my $State = $Socket->GetState(); # All action depends on the state. SocketDump(6, $Socket); + my $status = $Socket->Readable(); - if($Socket->Readable() != 0) { + &Debug(2, "Socket->Readable returned: $status"); + + if($status != 0) { # bad return from socket read. Currently this means that # The socket has become disconnected. We fail the transaction. + Log("WARNING", + "Lond connection lost."); if(exists($ActiveTransactions{$Socket})) { - Debug(3,"Lond connection lost failing transaction"); FailTransaction($ActiveTransactions{$Socket}); } $Watcher->cancel(); @@ -839,6 +931,7 @@ sub LondWritable { # We'll treat this as if the socket got disconnected: Log("WARNING", "Connection to ".$RemoteHost. " has been disconnected"); + FailTransaction($ActiveTransactions{$Socket}); $Watcher->cancel(); KillSocket($Socket); return; @@ -949,7 +1042,7 @@ sub QueueDelayed { my $Handle = IO::File->new($reqfile); my $cmd = <$Handle>; chomp $cmd; # There may or may not be a newline... - $cmd = $cmd."\ny"; # now for sure there's exactly one newline. + $cmd = $cmd."\n"; # now for sure there's exactly one newline. my $Transaction = LondTransaction->new($cmd); $Transaction->SetDeferred($reqfile); QueueTransaction($Transaction); @@ -978,7 +1071,10 @@ sub MakeLondConnection { if($Connection == undef) { # Needs to be more robust later. Log("CRITICAL","Failed to make a connection with lond."); + $ConnectionRetriesLeft--; + return 0; # Failure. } else { + $ConnectionRetriesLeft = $ConnectionRetries; # success resets the count # The connection needs to have writability # monitored in order to send the init sequence # that starts the whole authentication/key @@ -1006,6 +1102,7 @@ sub MakeLondConnection { } Log("SUCESS", "Created connection ".$ConnectionCount ." to host ".GetServerHost()); + return 1; # Return success. } } @@ -1090,7 +1187,9 @@ sub QueueTransaction { $WorkQueue->enqueue($requestData); if($ConnectionCount < $MaxConnectionCount) { Debug(4,"Starting additional lond connection"); - MakeLondConnection(); + if(MakeLondConnection() == 0) { + EmptyQueue(); # Fail transactions, can't make connection. + } } } else { # Can start the request: Debug(8,"Can start..."); @@ -1103,7 +1202,6 @@ sub QueueTransaction { =pod =head2 ClientRequest - Callback that is called when data can be read from the UNIX domain socket connecting us with an apache server process. @@ -1128,12 +1226,13 @@ sub ClientRequest { close($socket); $watcher->cancel(); delete($ActiveClients{$socket}); + return; } Debug(8,"Data: ".$data." this read: ".$thisread); $data = $data.$thisread; # Append new data. $watcher->data($data); if($data =~ /(.*\n)/) { # Request entirely read. - if($data == "close_connection_exit\n") { + if($data eq "close_connection_exit\n") { Log("CRITICAL", "Request Close Connection ... exiting"); CloseAllLondConnections(); @@ -1248,8 +1347,64 @@ sub SetupLoncListener { fd => $socket); } +=pod + +=head2 ChildStatus + +Child USR1 signal handler to report the most recent status +into the status file. + +=cut +sub ChildStatus { + my $event = shift; + my $watcher = $event->w; + + Debug(2, "Reporting child status because : ".$watcher->data); + my $docdir = $perlvar{'lonDocRoot'}; + my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt"); + print $fh $$."\t".$RemoteHost."\t".$Status."\t". + $RecentLogEntry."\n"; +} + =pod +=head2 SignalledToDeath + +Called in response to a signal that causes a chid process to die. + +=cut + + +sub SignalledToDeath { + my $event = shift; + my $watcher= $event->w; + + Debug(2,"Signalled to death! via ".$watcher->data); + my ($signal) = $watcher->data; + chomp($signal); + Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost " + ."died through "."\"$signal\""); + LogPerm("F:lonc: $$ on $RemoteHost signalled to death: " + ."\"$signal\""); + exit 0; + +} + +=head2 ToggleDebug + +This sub toggles trace debugging on and off. + +=cut + +sub ToggleDebug { + my $Current = $DebugLevel; + $DebugLevel = $NextDebugLevel; + $NextDebugLevel = $Current; + + Log("SUCCESS", "New debugging level for $RemoteHost now $DebugLevel"); + +} + =head2 ChildProcess This sub implements a child process for a single lonc daemon. @@ -1259,14 +1414,22 @@ This sub implements a child process for sub ChildProcess { - # For now turn off signals. - - $SIG{QUIT} = IGNORE; - $SIG{HUP} = IGNORE; - $SIG{USR1} = IGNORE; - $SIG{INT} = IGNORE; - $SIG{CHLD} = IGNORE; - $SIG{__DIE__} = IGNORE; + # + # Signals must be handled by the Event framework... +# + + Event->signal(signal => "QUIT", + cb => \&SignalledToDeath, + data => "QUIT"); + Event->signal(signal => "HUP", + cb => \&ChildStatus, + data => "HUP"); + Event->signal(signal => "USR1", + cb => \&ChildStatus, + data => "USR1"); + Event->signal(signal => "INT", + cb => \&ToggleDebug, + data => "INT"); SetupTimer(); @@ -1278,12 +1441,9 @@ sub ChildProcess { # Setup the initial server connection: - &MakeLondConnection(); + # &MakeLondConnection(); // let first work requirest do it. + - if($ConnectionCount == 0) { - Debug(1,"Could not make initial connection..\n"); - Debug(1,"Will retry when there's work to do\n"); - } Debug(9,"Entering event loop"); my $ret = Event::loop(); # Start the main event loop. @@ -1294,15 +1454,22 @@ sub ChildProcess { # Create a new child for host passed in: sub CreateChild { + my $sigset = POSIX::SigSet->new(SIGINT); + sigprocmask(SIG_BLOCK, $sigset); my $host = shift; $RemoteHost = $host; Log("CRITICAL", "Forking server for ".$host); $pid = fork; if($pid) { # Parent + $RemoteHost = "Parent"; $ChildHash{$pid} = $RemoteHost; + sigprocmask(SIG_UNBLOCK, $sigset); + } else { # child. ShowStatus("Connected to ".$RemoteHost); - ChildProcess; + $SIG{INT} = DEFAULT; + sigprocmask(SIG_UNBLOCK, $sigset); + ChildProcess; # Does not return. } } @@ -1342,6 +1509,8 @@ open (PIDSAVE, ">$execdir/logs/lonc.pid" print PIDSAVE "$$\n"; close(PIDSAVE); + + if (POSIX::setsid() < 0) { print "Could not create new session\n"; exit -1; @@ -1358,11 +1527,21 @@ while (! $HostIterator->end()) { CreateChild($hostentryref->[0]); $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; + while(1) { $deadchild = wait(); if(exists $ChildHash{$deadchild}) { # need to restart. @@ -1375,6 +1554,93 @@ while(1) { } } + + +=pod + +=head1 CheckKids + + Since kids do not die as easily in this implementation +as the previous one, there is no need to restart the +dead ones (all dead kids get restarted when they die!!) +The only thing this function does is to pass USR1 to the +kids so that they report their status. + +=cut + +sub CheckKids { + Debug(2, "Checking status of children"); + my $docdir = $perlvar{'lonDocRoot'}; + my $fh = IO::File->new(">$docdir/lon-status/loncstatus.txt"); + my $now=time; + my $local=localtime($now); + print $fh "LONC status $local - parent $$ \n\n"; + foreach $pid (keys %ChildHash) { + Debug(2, "Sending USR1 -> $pid"); + kill 'USR1' => $pid; # Tell Child to report status. + sleep 1; # Wait so file doesn't intermix. + } +} + +=pod + +=head1 Restart + +Signal handler for HUP... all children are killed and +we self restart. This is an el-cheapo way to re read +the config file. + +=cut + +sub Restart { + KillThemAll; # First kill all the children. + Log("CRITICAL", "Restarting"); + my $execdir = $perlvar{'lonDaemons'}; + unlink("$execdir/logs/lonc.pid"); + exec("$execdir/lonc"); +} + +=pod + +=head1 KillThemAll + +Signal handler that kills all children by sending them a +SIGHUP. Responds to sigint and sigterm. + +=cut + +sub KillThemAll { + Debug(2, "Kill them all!!"); + local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die. + foreach $pid (keys %ChildHash) { + my $serving = $ChildHash{$pid}; + Debug(2, "Killing lonc for $serving pid = $pid"); + ShowStatus("Killing lonc for $serving pid = $pid"); + Log("CRITICAL", "Killing lonc for $serving pid = $pid"); + kill 'QUIT' => $pid; + delete($ChildHash{$pid}); + } + my $execdir = $perlvar{'lonDaemons'}; + unlink("$execdir/logs/lonc.pid"); + +} + +=pod + +=head1 Terminate + +Terminate the system. + +=cut + +sub Terminate { + KillThemAll; + Log("CRITICAL","Master process exiting"); + exit 0; + +} +=pod + =head1 Theory The event class is used to build this as a single process with an