--- loncom/loncnew 2003/10/28 10:48:10 1.31 +++ loncom/loncnew 2004/05/11 19:55:35 1.45 @@ -2,7 +2,7 @@ # The LearningOnline Network with CAPA # lonc maintains the connections to remote computers # -# $Id: loncnew,v 1.31 2003/10/28 10:48:10 foxr Exp $ +# $Id: loncnew,v 1.45 2004/05/11 19:55:35 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -35,122 +35,16 @@ # - Add ability to create/negotiate lond connections (done). # - 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 logging/status monitoring. (done) +# - Add Signal handling - HUP restarts. USR1 status report. (done) # - Add Configuration file I/O (done). -# - Add management/status request interface. +# - Add management/status request interface. (done) # - Add deferred request capability. (done) -# - Detect transmission timeouts. +# - Detect transmission timeouts. (done) # -# Change log: -# $Log: loncnew,v $ -# Revision 1.31 2003/10/28 10:48:10 foxr -# Call LondConnection::ReadConfig explicitly so that the configuration is loaded -# prior to getting the hosts table hashiterator. -# -# Revision 1.30 2003/10/27 10:09:21 foxr -# Tighten up a few compares to eq and flip a few debug levels around... nothing -# critical -# -# Revision 1.29 2003/10/21 14:24:42 foxr -# Fix little typo that may explain growth of connections -# -# Revision 1.28 2003/10/14 15:36:21 albertel -# - making it easier to run loncnew, -# /etc/init.d/loncontrol startnew -# /etc/init.d/loncontrol restartnew -# will now start loncnew in place of lonc -# -# Revision 1.27 2003/10/07 11:23:03 foxr -# Installed and tested code to process reinit in parent server. -# -# Revision 1.26 2003/09/30 11:11:17 foxr -# Add book-keeping hashes to support the re-init procedure. -# -# Revision 1.25 2003/09/23 11:22:14 foxr -# Tested ability to receive sigusr2 This is now logged and must be -# properly implemented as a re-read of hosts and re-init of appropriate -# children. -# -# 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. -# -# 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; @@ -169,11 +63,6 @@ use LONCAPA::Configuration; use LONCAPA::HashIterator; -# -# Disable all signals we might receive from outside for now. -# - - # Read the httpd configuration file to get perl variables # normally set in apache modules: @@ -195,6 +84,8 @@ my $DebugLevel = 0; my $NextDebugLevel= 2; # So Sigint can toggle this. my $IdleTimeout= 3600; # Wait an hour before pruning connections. +my $LogTransactions = 0; # When True, all transactions/replies get logged. + # # The variables below are only used by the child processes. # @@ -211,6 +102,7 @@ my $Status = ""; # Current stat my $RecentLogEntry = ""; my $ConnectionRetries=2; # Number of connection retries allowed. my $ConnectionRetriesLeft=2; # Number of connection retries remaining. +my $LondVersion = "unknown"; # Version of lond we talk with. # # The hash below gives the HTML format for log messages @@ -218,10 +110,10 @@ my $ConnectionRetriesLeft=2; # Number of # my %LogFormats; -$LogFormats{"CRITICAL"} = "CRITICAL: %s"; -$LogFormats{"SUCCESS"} = "SUCCESS: %s"; -$LogFormats{"INFO"} = "INFO: %s"; -$LogFormats{"WARNING"} = "WARNING: %s"; +$LogFormats{"CRITICAL"} = "CRITICAL: %s"; +$LogFormats{"SUCCESS"} = "SUCCESS: %s"; +$LogFormats{"INFO"} = "INFO: %s"; +$LogFormats{"WARNING"} = "WARNING: %s"; $LogFormats{"DEFAULT"} = " %s "; @@ -316,7 +208,6 @@ sub GetPeername { return $peerfile; } } -#----------------------------- Timer management ------------------------ =pod =head2 Debug @@ -368,11 +259,21 @@ sub ShowStatus { =cut sub SocketTimeout { my $Socket = shift; - + Log("WARNING", "A socket timeout was detected"); + Debug(0, " SocketTimeout called: "); + $Socket->Dump(); + if(exists($ActiveTransactions{$Socket})) { + FailTransaction($ActiveTransactions{$Socket}); + } KillSocket($Socket); # A transaction timeout also counts as # a connection failure: $ConnectionRetriesLeft--; + if($ConnectionRetriesLeft <= 0) { + Log("CRITICAL", "Host marked dead: ".GetServerHost()); + } + } +#----------------------------- Timer management ------------------------ =pod @@ -407,9 +308,13 @@ sub Tick { # # For each inflight transaction, tick down its timeout counter. # - foreach my $item (keys %ActiveTransactions) { - my $Socket = $ActiveTransactions{$item}->getServer(); - $Socket->Tick(); + + foreach my $item (keys %ActiveConnections) { + my $State = $ActiveConnections{$item}->data->GetState(); + if ($State ne 'Idle') { + Debug(5,"Ticking Socket $State $item"); + $ActiveConnections{$item}->data->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. @@ -428,11 +333,13 @@ sub Tick { if($successCount == 0) { # All connections failed: Debug(5,"Work in queue failed to make any connectiouns\n"); EmptyQueue(); # Fail pending transactions with con_lost. + CloseAllLondConnections(); # Should all be closed but.... } } else { ShowStatus(GetServerHost()." >>> DEAD!!! <<<"); Debug(5,"Work in queue, but gave up on connections..flushing\n"); EmptyQueue(); # Connections can't be established. + CloseAllLondConnections(); # Should all already be closed but... } } @@ -456,7 +363,7 @@ Trigger disconnections of idle sockets. sub SetupTimer { Debug(6, "SetupTimer"); - Event->timer(interval => 1, debug => 1, cb => \&Tick ); + Event->timer(interval => 1, cb => \&Tick ); } =pod @@ -613,6 +520,9 @@ sub CompleteTransaction { if (!$Transaction->isDeferred()) { # Normal transaction my $data = $Socket->GetReply(); # Data to send. + if($LogTransactions) { + Log("SUCCESS", "Reply from lond: '$data'"); + } StartClientReply($Transaction, $data); } else { # Delete deferred transaction file. Log("SUCCESS", "A delayed transaction was completed"); @@ -620,7 +530,9 @@ sub CompleteTransaction { unlink $Transaction->getFile(); } } + =pod + =head1 StartClientReply Initiates a reply to a client where the reply data is a parameter. @@ -636,6 +548,7 @@ sub CompleteTransaction { The data to send to apached client. =cut + sub StartClientReply { my $Transaction = shift; my $data = shift; @@ -653,7 +566,9 @@ sub StartClientReply { cb => \&ClientWritable, data => $data); } + =pod + =head2 FailTransaction Finishes a transaction with failure because the associated lond socket @@ -663,8 +578,7 @@ sub StartClientReply { - 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. +Deleting the transaction means killing it from the %ActiveTransactions hash. Parameters: @@ -672,6 +586,7 @@ Parameters: The LondTransaction we are failing. + =cut sub FailTransaction { @@ -683,9 +598,6 @@ sub FailTransaction { Debug(1," Replying con_lost to ".$transaction->getRequest()); StartClientReply($transaction, "con_lost\n"); } - if($ConnectionRetriesLeft <= 0) { - Log("CRITICAL", "Host marked dead: ".GetServerHost()); - } } @@ -713,7 +625,10 @@ Close all connections open on lond prior =cut sub CloseAllLondConnections { foreach my $Socket (keys %ActiveConnections) { - KillSocket($Socket); + if(exists($ActiveTransactions{$Socket})) { + FailTransaction($ActiveTransactions{$Socket}); + } + KillSocket($Socket); } } =cut @@ -757,14 +672,15 @@ sub KillSocket { } if(exists($ActiveConnections{$Socket})) { delete($ActiveConnections{$Socket}); + $ConnectionCount--; + if ($ConnectionCount < 0) { $ConnectionCount = 0; } } - $ConnectionCount--; - # If the connection count has gone to zero and there is work in the # work queue, the work all gets failed with con_lost. # if($ConnectionCount == 0) { EmptyQueue(); + CloseAllLondConnections; # Should all already be closed but... } } @@ -790,6 +706,17 @@ The connection must echo the challenge b The challenge has been replied to. The we are receiveing the 'ok' from the partner. +=head3 State=ReadingVersionString + +We have requested the lond version and are reading the +version back. Upon completion, we'll store the version away +for future use(?). + +=head3 State=HostSet + +We have selected the domain name of our peer (multhomed hosts) +and are getting the reply (presumably ok) back. + =head3 State=RequestingKey The ok has been received and we need to send the request for @@ -844,7 +771,7 @@ sub LondReadable { &Debug(2, "Socket->Readable returned: $status"); if($status != 0) { - # bad return from socket read. Currently this means that + # bad return from socket read. Currently this means that # The socket has become disconnected. We fail the transaction. Log("WARNING", @@ -862,19 +789,34 @@ sub LondReadable { $State = $Socket->GetState(); # Update in case of transition. &Debug(6, "After read, state is ".$State); - if($State eq "Initialized") { + if($State eq "Initialized") { } elsif ($State eq "ChallengeReceived") { # The challenge must be echoed back; The state machine # in the connection takes care of setting that up. Just # need to transition to writable: - + $Watcher->cb(\&LondWritable); $Watcher->poll("w"); } elsif ($State eq "ChallengeReplied") { + } elsif ($State eq "RequestingVersion") { + # Need to ask for the version... that is writiability: + + $Watcher->cb(\&LondWritable); + $Watcher->poll("w"); + + } elsif ($State eq "ReadingVersionString") { + # Read the rest of the version string... + } elsif ($State eq "SetHost") { + # Need to request the actual domain get set... + + $Watcher->cb(\&LondWritable); + $Watcher->poll("w"); + } elsif ($State eq "HostSet") { + # Reading the 'ok' from the peer. } elsif ($State eq "RequestingKey") { # The ok was received. Now we need to request the key @@ -886,6 +828,14 @@ sub LondReadable { } elsif ($State eq "ReceivingKey") { } elsif ($State eq "Idle") { + + # This is as good a spot as any to get the peer version + # string: + + if($LondVersion eq "unknown") { + $LondVersion = $Socket->PeerVersion(); + Log("INFO", "Connected to lond version: $LondVersion"); + } # If necessary, complete a transaction and then go into the # idle queue. # Note that a trasition to idle indicates a live lond @@ -915,7 +865,7 @@ sub LondReadable { } else { - # Invalid state. + # Invalid state. Debug(4, "Invalid state in LondReadable"); } } @@ -997,21 +947,36 @@ sub LondWritable { SocketDump(6,$Socket); - if ($State eq "Connected") { - - 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"); + # If the socket is writable, we must always write. + # Only by writing will we undergo state transitions. + # Old logic wrote in state specific code below, however + # That forces us at least through another invocation of + # this function after writability is possible again. + # This logic also factors out common code for handling + # write failures... in all cases, write failures + # Kill the socket. + # This logic makes the branches of the >big< if below + # so that the writing states are actually NO-OPs. + + 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"); + if(exists($ActiveTransactions{$Socket})) { FailTransaction($ActiveTransactions{$Socket}); - $Watcher->cancel(); - KillSocket($Socket); - return; } - # "init" is being sent... + $Watcher->cancel(); + KillSocket($Socket); + return; + } - + + + if ($State eq "Connected") { + + # "init" is being sent... + } elsif ($State eq "Initialized") { # Now that init was sent, we switch @@ -1019,40 +984,43 @@ sub LondWritable { $Watcher->cb(\&LondReadable); $Watcher->poll("r"); - + } elsif ($State eq "ChallengeReceived") { # We received the challenge, now we # are echoing it back. This is a no-op, # we're waiting for the state to change - if($Socket->Writable() != 0) { - - $Watcher->cancel(); - KillSocket($Socket); - return; - } - } elsif ($State eq "ChallengeReplied") { # The echo was sent back, so we switch # to watching readability. $Watcher->cb(\&LondReadable); $Watcher->poll("r"); + } elsif ($State eq "RequestingVersion") { + # Sending the peer a version request... + + } elsif ($State eq "ReadingVersionString") { + # Transition to read since we have sent the + # version command and now just need to read the + # version string from the peer: + + $Watcher->cb(\&LondReadable); + $Watcher->poll("r"); + + } elsif ($State eq "SetHost") { + # Setting the remote domain... + + } elsif ($State eq "HostSet") { + # Back to readable to get the ok. + + $Watcher->cb(\&LondReadable); + $Watcher->poll("r"); + } elsif ($State eq "RequestingKey") { # At this time we're requesting the key. # again, this is essentially a no-op. - # we'll write the next chunk until the - # state changes. - if($Socket->Writable() != 0) { - # Write resulted in an error. - - $Watcher->cancel(); - KillSocket($Socket); - return; - - } } elsif ($State eq "ReceivingKey") { # Now we need to wait for the key # to come back from the peer: @@ -1061,20 +1029,10 @@ sub LondWritable { $Watcher->poll("r"); } elsif ($State eq "SendingRequest") { + # At this time we are sending a request to the # peer... write the next chunk: - if($Socket->Writable() != 0) { - - if(exists($ActiveTransactions{$Socket})) { - Debug(3, "Lond connection lost, failing transactions"); - FailTransaction($ActiveTransactions{$Socket}); - } - $Watcher->cancel(); - KillSocket($Socket); - return; - - } } elsif ($State eq "ReceivingReply") { # The send has completed. Wait for the @@ -1263,10 +1221,12 @@ sub QueueTransaction { Debug(5,"Starting additional lond connection"); if(MakeLondConnection() == 0) { EmptyQueue(); # Fail transactions, can't make connection. + CloseAllLondConnections; # Should all be closed but... } } else { ShowStatus(GetServerHost()." >>> DEAD !!!! <<<"); EmptyQueue(); # It's worse than that ... he's dead Jim. + CloseAllLondConnections; # Should all be closed but.. } } } else { # Can start the request: @@ -1309,7 +1269,7 @@ sub ClientRequest { Debug(8,"Data: ".$data." this read: ".$thisread); $data = $data.$thisread; # Append new data. $watcher->data($data); - if($data =~ /(.*\n)/) { # Request entirely read. + if($data =~ /\n$/) { # Request entirely read. if($data eq "close_connection_exit\n") { Log("CRITICAL", "Request Close Connection ... exiting"); @@ -1317,6 +1277,9 @@ sub ClientRequest { exit; } Debug(8, "Complete transaction received: ".$data); + if($LogTransactions) { + Log("SUCCESS", "Transaction: '$data'"); # Transaction has \n. + } my $Transaction = LondTransaction->new($data); $Transaction->SetClient($socket); QueueTransaction($Transaction); @@ -1425,6 +1388,24 @@ sub SetupLoncListener { fd => $socket); } +# +# Toggle transaction logging. +# Implicit inputs: +# LogTransactions +# Implicit Outputs: +# LogTransactions +sub ToggleTransactionLogging { + print STDERR "Toggle transaction logging...\n"; + if(!$LogTransactions) { + $LogTransactions = 1; + } else { + $LogTransactions = 0; + } + + + Log("SUCCESS", "Toggled transaction logging: $LogTransactions \n"); +} + =pod =head2 ChildStatus @@ -1444,6 +1425,20 @@ sub ChildStatus { my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt"); print $fh $$."\t".$RemoteHost."\t".$Status."\t". $RecentLogEntry."\n"; + # + # Write out information about each of the connections: + # + print $fh "Active connection statuses: \n"; + my $i = 1; + print STDERR "================================= Socket Status Dump:\n"; + foreach my $item (keys %ActiveConnections) { + my $Socket = $ActiveConnections{$item}->data; + my $state = $Socket->GetState(); + print $fh "Connection $i State: $state\n"; + print STDERR "---------------------- Connection $i \n"; + $Socket->Dump(); + $i++; + } $ConnectionRetriesLeft = $ConnectionRetries; } @@ -1508,6 +1503,8 @@ sub ChildProcess { Event->signal(signal => "USR1", cb => \&ChildStatus, data => "USR1"); + Event->signal(signal => "USR2", + cb => \&ToggleTransactionLogging); Event->signal(signal => "INT", cb => \&ToggleDebug, data => "INT");