--- loncom/loncnew 2003/05/05 23:40:27 1.6 +++ loncom/loncnew 2003/09/15 09:24:49 1.23 @@ -2,13 +2,12 @@ # The LearningOnline Network with CAPA # lonc maintains the connections to remote computers # -# $Id: loncnew,v 1.6 2003/05/05 23:40:27 foxr Exp $ +# $Id: loncnew,v 1.23 2003/09/15 09:24:49 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,48 +26,127 @@ # 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) # - Add timer dispatch. (done) # - Add ability to accept lonc UNIX domain sockets. (done) # - Add ability to create/negotiate lond connections (done). -# - Add general logic for dispatching requests and timeouts. -# - Add support for the lonc/lond requests. +# - Add general logic for dispatching requests and timeouts. (done). +# - Add support for the lonc/lond requests. (done). # - Add logging/status monitoring. # - Add Signal handling - HUP restarts. USR1 status report. -# - Add Configuration file I/O -# - Add Pending request processing on startup. +# - Add Configuration file I/O (done). # - Add management/status request interface. +# - Add deferred request capability. (done) +# - Detect transmission timeouts. +# +# Change log: +# $Log: loncnew,v $ +# 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. +# +# 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 the client will permanently give up on dead servers. +# +# Revision 1.9 2003/06/13 02:38:43 foxr +# Add logging in 'expected format' +# +# Revision 1.8 2003/06/11 02:04:35 foxr +# Support delayed transactions... this is done uniformly by encapsulating +# transactions in an object ... a LondTransaction that is implemented by +# LondTransaction.pm +# +# Revision 1.7 2003/06/03 01:59:39 foxr +# complete coding to support deferred transactions. +# +# +use strict; 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; +use IO::File; use IO::Handle; use Socket; use Crypt::IDEA; use LONCAPA::Queue; use LONCAPA::Stack; use LONCAPA::LondConnection; +use LONCAPA::LondTransaction; use LONCAPA::Configuration; use LONCAPA::HashIterator; -print "Loncnew starting\n"; # # 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 @@ -83,33 +161,109 @@ my %perlvar = %{$perlvarref}; my %ChildHash; # by pid -> host. -my $MaxConnectionCount = 5; # Will get from config later. +my $MaxConnectionCount = 10; # Will get from config later. my $ClientConnection = 0; # Uniquifier for client events. -my $DebugLevel = 5; +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; # Transactions in flight. +my %ActiveTransactions; # LondTransactions in flight. my %ActiveClients; # Serial numbers of active clients by socket. my $WorkQueue = Queue->new(); # Queue of pending transactions. -my $ClientQueue = Queue->new(); # Queue of clients causing xactinos. 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. # -# This disconnected socket makes posible a bit more regular -# code when processing delayed requests: -# -my $NullSocket = IO::Socket->new(); +# The hash below gives the HTML format for log messages +# given a severity. +# +my %LogFormats; + +$LogFormats{"CRITICAL"} = "CRITICAL: %s"; +$LogFormats{"SUCCESS"} = "SUCCESS: %s"; +$LogFormats{"INFO"} = "INFO: %s"; +$LogFormats{"WARNING"} = "WARNING: %s"; +$LogFormats{"DEFAULT"} = " %s "; + + + +=pod + +=head2 LogPerm + +Makes an entry into the permanent log file. + +=cut +sub LogPerm { + my $message=shift; + my $execdir=$perlvar{'lonDaemons'}; + my $now=time; + my $local=localtime($now); + my $fh=IO::File->new(">>$execdir/logs/lonnet.perm.log"); + print $fh "$now:$message:$local\n"; +} + +=pod + +=head2 Log + +Logs a message to the log file. +Parameters: + +=item severity + +One of CRITICAL, WARNING, INFO, SUCCESS used to select the +format string used to format the message. if the severity is +not a defined severity the Default format string is used. + +=item message + +The base message. In addtion to the format string, the message +will be appended to a string containing the name of our remote +host and the time will be formatted into the message. + +=cut + +sub Log { + my $severity = shift; + my $message = shift; + + if(!$LogFormats{$severity}) { + $severity = "DEFAULT"; + } + + my $format = $LogFormats{$severity}; + + # Put the window dressing in in front of the message format: + + my $now = time; + my $local = localtime($now); + my $finalformat = "$local ($$) [$RemoteHost] [$Status] "; + my $finalformat = $finalformat.$format."\n"; + + # open the file and put the result. + + my $execdir = $perlvar{'lonDaemons'}; + my $fh = IO::File->new(">>$execdir/logs/lonc.log"); + my $msg = sprintf($finalformat, $message); + $RecentLogEntry = $msg; + print $fh $msg; + + +} -# =pod @@ -127,7 +281,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; @@ -148,7 +302,7 @@ sub Debug { my $level = shift; my $message = shift; if ($level <= $DebugLevel) { - print $message." host = ".$RemoteHost."\n"; + Log("INFO", "-Debug- $message host = $RemoteHost"); } } @@ -165,11 +319,32 @@ 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; + 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); # A transaction timeout also counts as + # a connection failure: + $ConnectionRetriesLeft--; } =pod @@ -183,11 +358,11 @@ 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}); + if($ConnectionRetriesLeft > 0) { + ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount + ." Retries remaining: ".$ConnectionRetriesLeft); + } else { + ShowStatus(GetServerHost()." >> DEAD <<"); } # Is it time to prune connection count: @@ -196,24 +371,41 @@ 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. # 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"); + 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. } } @@ -257,24 +449,21 @@ long enough, it will be shut down and re sub ServerToIdle { my $Socket = shift; # Get the socket. + delete($ActiveTransactions{$Socket}); # Server has no transaction &Debug(6, "Server to idle"); # If there's work to do, start the transaction: - $reqdata = $WorkQueue->dequeue(); - Debug(9, "Queue gave request data: ".$reqdata); + my $reqdata = $WorkQueue->dequeue(); # This is a LondTransaction unless($reqdata eq undef) { - my $unixSocket = $ClientQueue->dequeue(); - &Debug(6, "Starting new work request"); - &Debug(7, "Request: ".$reqdata); - - &StartRequest($Socket, $unixSocket, $reqdata); + Debug(9, "Queue gave request data: ".$reqdata->getRequest()); + &StartRequest($Socket, $reqdata); + } else { # There's no work waiting, so push the server to idle list. &Debug(8, "No new work requests, server connection going idle"); - delete($ActiveTransactions{$Socket}); $IdleConnections->push($Socket); } } @@ -338,6 +527,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... @@ -378,30 +573,49 @@ Parameters: Socket on which the lond transaction occured. This is a LondConnection. The data received is in the TransactionReply member. -=item Client +=item Transaction -Unix domain socket open on the ultimate client. +The transaction that is being completed. =cut sub CompleteTransaction { &Debug(6,"Complete transaction"); my $Socket = shift; - my $Client = shift; + my $Transaction = shift; - my $data = $Socket->GetReply(); # Data to send. - StartClientReply($Client, $data); + if (!$Transaction->isDeferred()) { # Normal transaction + my $data = $Socket->GetReply(); # Data to send. + StartClientReply($Transaction, $data); + } else { # Delete deferred transaction file. + Log("SUCCESS", "A delayed transaction was completed"); + LogPerm("S:$Transaction->getClient() :".$Transaction->getRequest()); + unlink $Transaction->getFile(); + } } =pod =head1 StartClientReply Initiates a reply to a client where the reply data is a parameter. +=head2 parameters: + +=item Transaction + + The transaction for which we are responding to the client. + +=item data + + The data to send to apached client. + =cut sub StartClientReply { - my $Client = shift; + my $Transaction = shift; my $data = shift; + + my $Client = $Transaction->getClient(); + &Debug(8," Reply was: ".$data); my $Serial = $ActiveClients{$Client}; my $desc = sprintf("Connection to lonc client %d", @@ -417,34 +631,66 @@ sub StartClientReply { =head2 FailTransaction Finishes a transaction with failure because the associated lond socket - disconnected. It is up to our client to retry if desired. + disconnected. There are two possibilities: + - The transaction is deferred: in which case we just quietly + delete the transaction since there is no client connection. + - The transaction is 'live' in which case we initiate the sending + of "con_lost" to the client. + +Deleting the transaction means killing it from the +%ActiveTransactions hash. Parameters: =item client - The UNIX domain socket open on our client. - + The LondTransaction we are failing. + =cut sub FailTransaction { - my $client = shift; - - StartClientReply($client, "con_lost"); + 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()); + } } =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()) { - my $request = $WorkQUeue->dequeue(); # Just to help it become empty. - my $client = $ClientQueue->dequeue(); # Need to con_lost this guy. - FailTransaction($client); + my $request = $WorkQueue->dequeue(); # This is a transaction + FailTransaction($request); + } +} + +=pod + +=head2 CloseAllLondConnections + +Close all connections open on lond prior to exit e.g. + +=cut +sub CloseAllLondConnections { + foreach my $Socket (keys %ActiveConnections) { + KillSocket($Socket); } } +=cut =pod @@ -471,8 +717,14 @@ nonzero if we are allowed to create a ne sub KillSocket { my $Socket = shift; - # If the socket came from the active connection set, delete it. - # otherwise it came from the idle set and has already been destroyed: + Log("WARNING", "Shutting down a socket"); + $Socket->Shutdown(); + + # If the socket came from the active connection set, + # delete its transaction... note that FailTransaction should + # already have been called!!! + # otherwise it came from the idle set. + # if(exists($ActiveTransactions{$Socket})) { delete ($ActiveTransactions{$Socket}); @@ -486,7 +738,7 @@ sub KillSocket { # work queue, the work all gets failed with con_lost. # if($ConnectionCount == 0) { - EmptyQueue; + EmptyQueue(); } } @@ -549,27 +801,34 @@ transaction is in progress, the socket a =cut sub LondReadable { + my $Event = shift; my $Watcher = $Event->w; my $Socket = $Watcher->data; my $client = undef; + &Debug(6,"LondReadable called state = ".$Socket->GetState()); + my $State = $Socket->GetState(); # All action depends on the state. - &Debug(6,"LondReadable called state = ".$State); SocketDump(6, $Socket); + my $status = $Socket->Readable(); + + &Debug(2, "Socket->Readable returned: $status"); - if($Socket->Readable() != 0) { + 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); @@ -585,8 +844,8 @@ sub LondReadable { # in the connection takes care of setting that up. Just # need to transition to writable: - $Watcher->poll("w"); $Watcher->cb(\&LondWritable); + $Watcher->poll("w"); } elsif ($State eq "ChallengeReplied") { @@ -595,20 +854,27 @@ sub LondReadable { # The ok was received. Now we need to request the key # That requires us to be writable: - $Watcher->poll("w"); $Watcher->cb(\&LondWritable); + $Watcher->poll("w"); } elsif ($State eq "ReceivingKey") { } 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!!"); CompleteTransaction($Socket, $ActiveTransactions{$Socket}); + } else { + Log("SUCCESS", "Connection ".$ConnectionCount." to " + .$RemoteHost." now ready for action"); } - $Watcher->cancel(); ServerToIdle($Socket); # Next work unit or idle. } elsif ($State eq "SendingRequest") { @@ -692,15 +958,15 @@ is the socket on which to return a reply sub LondWritable { my $Event = shift; my $Watcher = $Event->w; - my @data = $Watcher->data; - Debug(6,"LondWritable State = ".$State." data has ".@data." elts.\n"); + my $Socket = $Watcher->data; + my $State = $Socket->GetState(); - my $Socket = $data[0]; # I know there's at least a socket. + Debug(6,"LondWritable State = ".$State."\n"); + # Figure out what to do depending on the state of the socket: - my $State = $Socket->GetState(); SocketDump(6,$Socket); @@ -710,7 +976,9 @@ sub LondWritable { if ($Socket->Writable() != 0) { # The write resulted in an error. # 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; @@ -723,8 +991,8 @@ sub LondWritable { # Now that init was sent, we switch # to watching for readability: - $Watcher->poll("r"); $Watcher->cb(\&LondReadable); + $Watcher->poll("r"); } elsif ($State eq "ChallengeReceived") { # We received the challenge, now we @@ -742,8 +1010,8 @@ sub LondWritable { # The echo was sent back, so we switch # to watching readability. - $Watcher->poll("r"); $Watcher->cb(\&LondReadable); + $Watcher->poll("r"); } elsif ($State eq "RequestingKey") { # At this time we're requesting the key. @@ -763,8 +1031,8 @@ sub LondWritable { # Now we need to wait for the key # to come back from the peer: - $Watcher->poll("r"); $Watcher->cb(\&LondReadable); + $Watcher->poll("r"); } elsif ($State eq "SendingRequest") { # At this time we are sending a request to the @@ -786,8 +1054,8 @@ sub LondWritable { # The send has completed. Wait for the # data to come in for a reply. Debug(8,"Writable sent request/receiving reply"); - $Watcher->poll("r"); $Watcher->cb(\&LondReadable); + $Watcher->poll("r"); } else { # Control only passes here on an error: @@ -803,18 +1071,27 @@ sub LondWritable { =cut sub QueueDelayed { + Debug(3,"QueueDelayed called"); + my $path = "$perlvar{'lonSockDir'}/delayed"; + + Debug(4, "Delayed path: ".$path); opendir(DIRHANDLE, $path); - @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE; + + my @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE; closedir(DIRHANDLE); my $dfname; - my $reqfile - foreach $reqfile (sort @alldelayed) { - $reqfile = $path/$reqfile; + my $reqfile; + foreach $dfname (sort @alldelayed) { + $reqfile = "$path/$dfname"; + Debug(4, "queueing ".$reqfile); my $Handle = IO::File->new($reqfile); my $cmd = <$Handle>; - chomp($cmd); - QueueTransaction($NullSocket, $cmd); + chomp $cmd; # There may or may not be a newline... + $cmd = $cmd."\n"; # now for sure there's exactly one newline. + my $Transaction = LondTransaction->new($cmd); + $Transaction->SetDeferred($reqfile); + QueueTransaction($Transaction); } } @@ -839,8 +1116,11 @@ sub MakeLondConnection { &GetServerPort()); if($Connection == undef) { # Needs to be more robust later. - Debug(0,"Failed to make a connection with lond."); + Log("CRITICAL","Failed to make a connection with lond."); + $ConnectionRetriesLeft--; + return 0; # Failure. } else { + # The connection needs to have writability # monitored in order to send the init sequence # that starts the whole authentication/key @@ -853,18 +1133,23 @@ 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, undef), + data => $Connection, desc => 'Connection to lond server'); $ActiveConnections{$Connection} = $event; $ConnectionCount++; + Debug(4, "Connection count = ".$ConnectionCount); if($ConnectionCount == 1) { # First Connection: QueueDelayed; } + Log("SUCESS", "Created connection ".$ConnectionCount + ." to host ".GetServerHost()); + return 1; # Return success. } } @@ -896,17 +1181,17 @@ The text of the request to send. sub StartRequest { my $Lond = shift; - my $Client = shift; - my $Request = shift; + my $Request = shift; # This is a LondTransaction. - Debug(6, "StartRequest: ".$Request); + Debug(6, "StartRequest: ".$Request->getRequest()); my $Socket = $Lond->GetSocket(); - $ActiveTransactions{$Lond} = $Client; # Socket to relay to client. + $Request->Activate($Lond); + $ActiveTransactions{$Lond} = $Request; - $Lond->InitiateTransaction($Request); - $event = Event->io(fd => $Lond->GetSocket(), + $Lond->InitiateTransaction($Request->getRequest()); + my $event = Event->io(fd => $Socket, poll => "w", cb => \&LondWritable, data => $Lond, @@ -937,23 +1222,30 @@ data to send to the lond. =cut sub QueueTransaction { - my $requestSocket = shift; - my $requestData = shift; - Debug(6,"QueueTransaction: ".$requestData); + my $requestData = shift; # This is a LondTransaction. + my $cmd = $requestData->getRequest(); + + Debug(6,"QueueTransaction: ".$cmd); my $LondSocket = $IdleConnections->pop(); if(!defined $LondSocket) { # Need to queue request. Debug(8,"Must queue..."); - $ClientQueue->enqueue($requestSocket); $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..."); - StartRequest($LondSocket, $requestSocket, $requestData); + StartRequest($LondSocket, $requestData); } } @@ -962,7 +1254,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. @@ -987,13 +1278,22 @@ 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 eq "close_connection_exit\n") { + Log("CRITICAL", + "Request Close Connection ... exiting"); + CloseAllLondConnections(); + exit; + } Debug(8, "Complete transaction received: ".$data); - QueueTransaction($socket, $data); + my $Transaction = LondTransaction->new($data); + $Transaction->SetClient($socket); + QueueTransaction($Transaction); $watcher->cancel(); # Done looking for input data. } @@ -1055,7 +1355,7 @@ Returns the host whose lond we talk with =cut -sub GetServerHost { # Stub - get this from config. +sub GetServerHost { return $RemoteHost; # Setup by the fork. } @@ -1067,7 +1367,7 @@ Returns the lond port number. =cut -sub GetServerPort { # Stub - get this from config. +sub GetServerPort { return $perlvar{londPort}; } @@ -1088,7 +1388,7 @@ sub SetupLoncListener { my $socket; my $SocketName = GetLoncSocketPath(); unlink($SocketName); - unless ($socket = IO::Socket::UNIX->new(Local => $SocketName, + unless ($socket =IO::Socket::UNIX->new(Local => $SocketName, Listen => 10, Type => SOCK_STREAM)) { die "Failed to create a lonc listner socket"; @@ -1099,8 +1399,67 @@ 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 + +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. @@ -1109,16 +1468,23 @@ This sub implements a child process for sub ChildProcess { - print "Loncnew\n"; - # 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(); @@ -1130,12 +1496,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. @@ -1146,16 +1509,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; - Debug(3, "Forking off child for ".$RemoteHost); - sleep(5); - $pid = fork; + Log("CRITICAL", "Forking server for ".$host); + my $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. } } @@ -1177,11 +1546,7 @@ sub CreateChild { -ShowStatus("Parent writing pid file:"); -$execdir = $perlvar{'lonDaemons'}; -open (PIDSAVE, ">$execdir/logs/lonc.pid"); -print PIDSAVE "$$\n"; -close(PIDSAVE); + ShowStatus("Forming new session"); my $childpid = fork; @@ -1189,6 +1554,17 @@ if ($childpid != 0) { sleep 4; # Give child a chacne to break to exit 0; # a new sesion. } +# +# Write my pid into the pid file so I can be located +# + +ShowStatus("Parent writing pid file:"); +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"; @@ -1197,29 +1573,129 @@ if (POSIX::setsid() < 0) { ShowStatus("Forking node servers"); +Log("CRITICAL", "--------------- Starting children ---------------"); + my $HostIterator = LondConnection::GetHostIterator; while (! $HostIterator->end()) { - $hostentryref = $HostIterator->get(); + my $hostentryref = $HostIterator->get(); 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(); + my $deadchild = wait(); if(exists $ChildHash{$deadchild}) { # need to restart. - $deadhost = $ChildHash{$deadchild}; + my $deadhost = $ChildHash{$deadchild}; delete($ChildHash{$deadchild}); - Debug(4,"Lost child pid= ".$deadchild. + Log("WARNING","Lost child pid= ".$deadchild. "Connected to host ".$deadhost); + Log("INFO", "Restarting child procesing ".$deadhost); CreateChild($deadhost); } } + + +=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 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 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 '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