--- loncom/loncnew 2003/12/11 23:18:37 1.34
+++ loncom/loncnew 2004/05/25 15:32:13 1.46
@@ -2,7 +2,7 @@
# The LearningOnline Network with CAPA
# lonc maintains the connections to remote computers
#
-# $Id: loncnew,v 1.34 2003/12/11 23:18:37 albertel Exp $
+# $Id: loncnew,v 1.46 2004/05/25 15:32:13 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -35,12 +35,12 @@
# - 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)
#
use strict;
@@ -63,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:
@@ -89,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.
#
@@ -105,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
@@ -112,10 +110,10 @@ my $ConnectionRetriesLeft=2; # Number of
#
my %LogFormats;
-$LogFormats{"CRITICAL"} = "<font color=red>CRITICAL: %s</font>";
-$LogFormats{"SUCCESS"} = "<font color=green>SUCCESS: %s</font>";
-$LogFormats{"INFO"} = "<font color=yellow>INFO: %s</font>";
-$LogFormats{"WARNING"} = "<font color=blue>WARNING: %s</font>";
+$LogFormats{"CRITICAL"} = "<font color='red'>CRITICAL: %s</font>";
+$LogFormats{"SUCCESS"} = "<font color='green'>SUCCESS: %s</font>";
+$LogFormats{"INFO"} = "<font color='yellow'>INFO: %s</font>";
+$LogFormats{"WARNING"} = "<font color='blue'>WARNING: %s</font>";
$LogFormats{"DEFAULT"} = " %s ";
@@ -210,7 +208,6 @@ sub GetPeername {
return $peerfile;
}
}
-#----------------------------- Timer management ------------------------
=pod
=head2 Debug
@@ -262,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
@@ -301,14 +308,10 @@ 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' && $State ne 'SendingRequest' &&
- $State ne 'ReceivingReply') {
+ if ($State ne 'Idle') {
Debug(5,"Ticking Socket $State $item");
$ActiveConnections{$item}->data->Tick();
}
@@ -330,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...
}
}
@@ -515,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");
@@ -522,7 +530,9 @@ sub CompleteTransaction {
unlink $Transaction->getFile();
}
}
+
=pod
+
=head1 StartClientReply
Initiates a reply to a client where the reply data is a parameter.
@@ -538,6 +548,7 @@ sub CompleteTransaction {
The data to send to apached client.
=cut
+
sub StartClientReply {
my $Transaction = shift;
my $data = shift;
@@ -555,7 +566,9 @@ sub StartClientReply {
cb => \&ClientWritable,
data => $data);
}
+
=pod
+
=head2 FailTransaction
Finishes a transaction with failure because the associated lond socket
@@ -565,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:
@@ -574,6 +586,7 @@ Parameters:
The LondTransaction we are failing.
+
=cut
sub FailTransaction {
@@ -585,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());
- }
}
@@ -615,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
@@ -659,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...
}
}
@@ -692,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
@@ -746,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",
@@ -764,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
@@ -788,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
@@ -817,7 +865,7 @@ sub LondReadable {
} else {
- # Invalid state.
+ # Invalid state.
Debug(4, "Invalid state in LondReadable");
}
}
@@ -899,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
@@ -921,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:
@@ -963,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
@@ -1165,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:
@@ -1211,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");
@@ -1219,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);
@@ -1327,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
@@ -1337,6 +1416,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 {
my $event = shift;
my $watcher = $event->w;
@@ -1346,6 +1426,22 @@ 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:
+ #
+ if ($DebugLevel > 2) {
+ 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;
}
@@ -1410,6 +1506,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");