--- loncom/loncnew 2003/07/02 01:12:35 1.12 +++ loncom/loncnew 2003/09/16 09:46:42 1.24 @@ -2,13 +2,12 @@ # The LearningOnline Network with CAPA # lonc maintains the connections to remote computers # -# $Id: loncnew,v 1.12 2003/07/02 01:12:35 foxr Exp $ +# $Id: loncnew,v 1.24 2003/09/16 09:46:42 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,10 +45,60 @@ # Change log: # $Log: loncnew,v $ -# Revision 1.12 2003/07/02 01:12:35 foxr -# - Add some debugging to killthemall -# - Add better error handling to LondReadable -# - Remove tick logging in the timer handler. +# Revision 1.24 2003/09/16 09:46:42 foxr +# Added skeletal infrastructure to support SIGUSR2 update hosts request. +# +# Revision 1.23 2003/09/15 09:24:49 foxr +# Add use strict and fix all the fallout from that. +# +# Revision 1.22 2003/09/02 10:34:47 foxr +# - Fix errors in host dead detection logic (too many cases where the +# retries left were not getting incremented or just not checked). +# - Added some additional status to the ps axuww display: +# o Remaining retries on a host. +# o >>> DEAD <<< indicator if I've given up on a host. +# - Tested the SIGHUP will reset the retries remaining count (thanks to +# the above status stuff, and get allow the loncnew to re-try again +# on the host (thanks to the log). +# +# Revision 1.21 2003/08/26 09:19:51 foxr +# How embarrassing... put in the SocketTimeout function in loncnew and forgot +# to actually hook it into the LondTransaction. Added this to MakeLondConnection +# where it belongs... hopefully transactions (not just connection attempts) will +# timeout more speedily than the socket errors will catch it. +# +# Revision 1.20 2003/08/25 18:48:11 albertel +# - fixing a forgotten ; +# +# Revision 1.19 2003/08/19 09:31:46 foxr +# Get socket directory from configuration rather than the old hard coded test +# way that I forgot to un-hard code. +# +# 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. @@ -57,7 +106,7 @@ # 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. +# going or else the client will permanently give up on dead servers. # # Revision 1.9 2003/06/13 02:38:43 foxr # Add logging in 'expected format' @@ -71,7 +120,7 @@ # complete coding to support deferred transactions. # # - +use strict; use lib "/home/httpd/lib/perl/"; use lib "/home/foxr/newloncapa/types"; use Event qw(:DEFAULT ); @@ -95,12 +144,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 @@ -119,13 +168,14 @@ 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. # # The variables below are only used by the child processes. # my $RemoteHost; # Name of host child is talking to. -my $UnixSocketDir= "/home/httpd/sockets"; +my $UnixSocketDir= $perlvar{'lonSockDir'}; my $IdleConnections = Stack->new(); # Set of idle connections my %ActiveConnections; # Connections to the remote lond. my %ActiveTransactions; # LondTransactions in flight. @@ -134,6 +184,7 @@ 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. @@ -210,6 +261,7 @@ 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; @@ -232,7 +284,7 @@ sub GetPeername { my $peerip; if($AdrFamily == AF_INET) { ($peerport, $peerip) = sockaddr_in($peer); - my $peername = gethostbyaddr($iaddr, $AdrFamily); + my $peername = gethostbyaddr($peerip, $AdrFamily); return $peername; } elsif ($AdrFamily == AF_UNIX) { my $peerfile; @@ -253,7 +305,7 @@ sub Debug { my $level = shift; my $message = shift; if ($level <= $DebugLevel) { - print $message." host = ".$RemoteHost."\n"; + Log("INFO", "-Debug- $message host = $RemoteHost"); } } @@ -283,6 +335,23 @@ sub ShowStatus { =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); # A transaction timeout also counts as + # a connection failure: + $ConnectionRetriesLeft--; +} + +=pod + =head2 Tick Invoked each timer tick. @@ -292,8 +361,12 @@ Invoked each timer tick. sub Tick { my $client; - ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount); - + if($ConnectionRetriesLeft > 0) { + ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount + ." Retries remaining: ".$ConnectionRetriesLeft); + } else { + ShowStatus(GetServerHost()." >> DEAD <<"); + } # Is it time to prune connection count: @@ -301,13 +374,19 @@ sub Tick { ($WorkQueue->Count() == 0)) { # Idle connections and nothing to do? $IdleSeconds++; if($IdleSeconds > $IdleTimeout) { # Prune a connection... - $Socket = $IdleConnections->pop(); + my $Socket = $IdleConnections->pop(); KillSocket($Socket); } } else { $IdleSeconds = 0; # Reset idle count if not idle. } - + # + # For each inflight transaction, tick down its timeout counter. + # + foreach my $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. # @@ -318,10 +397,16 @@ sub Tick { my $Connections = ($Requests <= $MaxConnectionCount) ? $Requests : $MaxConnectionCount; Debug(1,"Work but no connections, start ".$Connections." of them"); - for ($i =0; $i < $Connections; $i++) { - MakeLondConnection(); + my $successCount = 0; + for (my $i =0; $i < $Connections; $i++) { + $successCount += MakeLondConnection(); + } + if($successCount == 0) { # All connections failed: + Debug(1,"Work in queue failed to make any connectiouns\n"); + EmptyQueue(); # Fail pending transactions with con_lost. } } else { + ShowStatus(GetServerHost()." >>> DEAD!!! <<<"); Debug(1,"Work in queue, but gave up on connections..flushing\n"); EmptyQueue(); # Connections can't be established. } @@ -373,7 +458,7 @@ sub ServerToIdle { # If there's work to do, start the transaction: - $reqdata = $WorkQueue->dequeue(); # This is a LondTransaction + my $reqdata = $WorkQueue->dequeue(); # This is a LondTransaction unless($reqdata eq undef) { Debug(9, "Queue gave request data: ".$reqdata->getRequest()); &StartRequest($Socket, $reqdata); @@ -445,6 +530,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... @@ -501,7 +592,7 @@ sub CompleteTransaction { StartClientReply($Transaction, $data); } else { # Delete deferred transaction file. Log("SUCCESS", "A delayed transaction was completed"); - LogPerm("S:$Client:".$Transaction->getRequest()); + LogPerm("S:$Transaction->getClient() :".$Transaction->getRequest()); unlink $Transaction->getFile(); } } @@ -562,12 +653,16 @@ Parameters: sub FailTransaction { my $transaction = shift; + 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"); } + if($ConnectionRetriesLeft <= 0) { + Log("CRITICAL", "Host marked dead: ".GetServerHost()); + } } @@ -579,6 +674,7 @@ sub FailTransaction { =cut sub EmptyQueue { + $ConnectionRetriesLeft--; # Counts as connection failure too. while($WorkQueue->Count()) { my $request = $WorkQueue->dequeue(); # This is a transaction FailTransaction($request); @@ -593,7 +689,7 @@ Close all connections open on lond prior =cut sub CloseAllLondConnections { - foreach $Socket (keys %ActiveConnections) { + foreach my $Socket (keys %ActiveConnections) { KillSocket($Socket); } } @@ -624,6 +720,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, @@ -644,7 +741,7 @@ sub KillSocket { # work queue, the work all gets failed with con_lost. # if($ConnectionCount == 0) { - EmptyQueue; + EmptyQueue(); } } @@ -713,25 +810,28 @@ sub LondReadable { my $Socket = $Watcher->data; my $client = undef; - &Debug(6,"LondReadable called state = ".$State); + &Debug(6,"LondReadable called state = ".$Socket->GetState()); my $State = $Socket->GetState(); # All action depends on the state. SocketDump(6, $Socket); my $status = $Socket->Readable(); + &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(); KillSocket($Socket); + $ConnectionRetriesLeft--; # Counts as connection failure return; } SocketDump(6,$Socket); @@ -765,6 +865,10 @@ sub LondReadable { } elsif ($State eq "Idle") { # If necessary, complete a transaction and then go into the # idle queue. + # Note that a trasition to idle indicates a live lond + # on the other end so reset the connection retries. + # + $ConnectionRetriesLeft = $ConnectionRetries; # success resets the count $Watcher->cancel(); if(exists($ActiveTransactions{$Socket})) { Debug(8,"Completing transaction!!"); @@ -877,6 +981,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; @@ -976,8 +1081,7 @@ sub QueueDelayed { Debug(4, "Delayed path: ".$path); opendir(DIRHANDLE, $path); - @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE; - Debug(4, "Got ".$alldelayed." delayed files"); + my @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE; closedir(DIRHANDLE); my $dfname; my $reqfile; @@ -1019,7 +1123,7 @@ sub MakeLondConnection { $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 @@ -1032,8 +1136,9 @@ sub MakeLondConnection { &Debug(9,"MakeLondConnection got socket: ".$Socket); } - - $event = Event->io(fd => $Socket, + $Connection->SetTimeoutCallback(\&SocketTimeout); + + my $event = Event->io(fd => $Socket, poll => 'w', cb => \&LondWritable, data => $Connection, @@ -1089,7 +1194,7 @@ sub StartRequest { $ActiveTransactions{$Lond} = $Request; $Lond->InitiateTransaction($Request->getRequest()); - $event = Event->io(fd => $Socket, + my $event = Event->io(fd => $Socket, poll => "w", cb => \&LondWritable, data => $Lond, @@ -1131,8 +1236,15 @@ sub QueueTransaction { Debug(8,"Must queue..."); $WorkQueue->enqueue($requestData); if($ConnectionCount < $MaxConnectionCount) { - Debug(4,"Starting additional lond connection"); - MakeLondConnection(); + if($ConnectionRetriesLeft > 0) { + Debug(4,"Starting additional lond connection"); + if(MakeLondConnection() == 0) { + EmptyQueue(); # Fail transactions, can't make connection. + } + } else { + ShowStatus(GetServerHost()." >>> DEAD !!!! <<<"); + EmptyQueue(); # It's worse than that ... he's dead Jim. + } } } else { # Can start the request: Debug(8,"Can start..."); @@ -1290,6 +1402,28 @@ sub SetupLoncListener { fd => $socket); } +=pod + +=head2 ChildStatus + +Child USR1 signal handler to report the most recent status +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 { + 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"; + $ConnectionRetriesLeft = $ConnectionRetries; +} + =pod =head2 SignalledToDeath @@ -1300,17 +1434,35 @@ Called in response to a signal that caus sub SignalledToDeath { - Debug(2,"Signalled to death!"); - my ($signal) = @_; + 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\""); - die("Signal abnormal end"); 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. @@ -1320,14 +1472,22 @@ This sub implements a child process for sub ChildProcess { - # For now turn off signals. - - $SIG{QUIT} = \&SignalledToDeath; - $SIG{HUP} = IGNORE; - $SIG{USR1} = IGNORE; - $SIG{INT} = DEFAULT; - $SIG{CHLD} = IGNORE; - $SIG{__DIE__} = \&SignalledToDeath; + # + # 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(); @@ -1339,7 +1499,7 @@ sub ChildProcess { # Setup the initial server connection: - # &MakeLondConnection(); // let first work requirest do it. + # &MakeLondConnection(); // let first work requirest do it. Debug(9,"Entering event loop"); @@ -1357,14 +1517,15 @@ sub CreateChild { my $host = shift; $RemoteHost = $host; Log("CRITICAL", "Forking server for ".$host); - $pid = fork; + my $pid = fork; if($pid) { # Parent + $RemoteHost = "Parent"; $ChildHash{$pid} = $RemoteHost; sigprocmask(SIG_UNBLOCK, $sigset); } else { # child. ShowStatus("Connected to ".$RemoteHost); - $SIG{INT} = DEFAULT; + $SIG{INT} = 'DEFAULT'; sigprocmask(SIG_UNBLOCK, $sigset); ChildProcess; # Does not return. } @@ -1401,11 +1562,13 @@ if ($childpid != 0) { # ShowStatus("Parent writing pid file:"); -$execdir = $perlvar{'lonDaemons'}; +my $execdir = $perlvar{'lonDaemons'}; open (PIDSAVE, ">$execdir/logs/lonc.pid"); print PIDSAVE "$$\n"; close(PIDSAVE); + + if (POSIX::setsid() < 0) { print "Could not create new session\n"; exit -1; @@ -1418,7 +1581,7 @@ Log("CRITICAL", "--------------- Startin my $HostIterator = LondConnection::GetHostIterator; while (! $HostIterator->end()) { - $hostentryref = $HostIterator->get(); + my $hostentryref = $HostIterator->get(); CreateChild($hostentryref->[0]); $HostIterator->next(); } @@ -1432,14 +1595,16 @@ ShowStatus("Parent keeping the flock"); # Set up parent signals: # -$SIG{INT} = \&KillThemAll; -$SIG{TERM} = \&KillThemAll; - +$SIG{INT} = \&Terminate; +$SIG{TERM} = \&Terminate; +$SIG{HUP} = \&Restart; +$SIG{USR1} = \&CheckKids; +$SIG{USR2} = \&UpdateKids; # LonManage update request. while(1) { - $deadchild = wait(); + my $deadchild = wait(); if(exists $ChildHash{$deadchild}) { # need to restart. - $deadhost = $ChildHash{$deadchild}; + my $deadhost = $ChildHash{$deadchild}; delete($ChildHash{$deadchild}); Log("WARNING","Lost child pid= ".$deadchild. "Connected to host ".$deadhost); @@ -1448,31 +1613,123 @@ 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 my $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 UpdateKids + +parent's SIGUSR1 handler. This handler: + +=item + +Rereads the hosts file. + +=item + +Kills off (via sigint) children for hosts that have disappeared. + +=item + +HUP's children for hosts that already exist (this just forces a status display +and resets the connection retry count for that host. + +=item + +Starts new children for hosts that have been added to the hosts.tab file since +the start of the master program and maintains them. + +=cut + +sub UpdateKids { +} + + +=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 -SIGINT. Responds to sigint and sigterm. +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) { + foreach my $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('INT', $pid); + kill 'QUIT' => $pid; + delete($ChildHash{$pid}); } - Log("CRITICAL", "Killing the master process."); - exit + 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 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.