--- loncom/loncnew 2004/02/17 15:09:08 1.43
+++ loncom/loncnew 2004/08/26 12:35:10 1.51
@@ -2,7 +2,7 @@
# The LearningOnline Network with CAPA
# lonc maintains the connections to remote computers
#
-# $Id: loncnew,v 1.43 2004/02/17 15:09:08 albertel Exp $
+# $Id: loncnew,v 1.51 2004/08/26 12:35:10 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -82,7 +82,7 @@ my $ClientConnection = 0; # Uniquifier f
my $DebugLevel = 0;
my $NextDebugLevel= 2; # So Sigint can toggle this.
-my $IdleTimeout= 3600; # Wait an hour before pruning connections.
+my $IdleTimeout= 600; # Wait 10 minutes before pruning connections.
my $LogTransactions = 0; # When True, all transactions/replies get logged.
@@ -103,17 +103,22 @@ 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.
+my $KeyMode = ""; # e.g. ssl, local, insecure from last connect.
+my $LongTickLength = 10000000; #Tick Frequency when Idle
+my $ShortTickLength = 1; #Tick Frequency when Active (many places in
+ # the code assume this is one)
+my $TickLength = $ShortTickLength;#number of seconds to wait until ticking
#
# 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{"CRITICAL"} = "CRITICAL: %s";
+$LogFormats{"SUCCESS"} = "SUCCESS: %s";
+$LogFormats{"INFO"} = "INFO: %s";
+$LogFormats{"WARNING"} = "WARNING: %s";
$LogFormats{"DEFAULT"} = " %s ";
@@ -156,9 +161,9 @@ host and the time will be formatted into
=cut
sub Log {
- my $severity = shift;
- my $message = shift;
-
+
+ my ($severity, $message) = @_;
+
if(!$LogFormats{$severity}) {
$severity = "DEFAULT";
}
@@ -193,8 +198,10 @@ Returns the name of the host that a sock
=cut
sub GetPeername {
- my $connection = shift;
- my $AdrFamily = shift;
+
+
+ my ($connection, $AdrFamily) = @_;
+
my $peer = $connection->peername();
my $peerport;
my $peerip;
@@ -217,18 +224,20 @@ Invoked to issue a debug message.
=cut
sub Debug {
- my $level = shift;
- my $message = shift;
+
+ my ($level, $message) = @_;
+
if ($level <= $DebugLevel) {
Log("INFO", "-Debug- $message host = $RemoteHost");
}
}
sub SocketDump {
- my $level = shift;
- my $socket= shift;
+
+ my ($level, $socket) = @_;
+
if($level <= $DebugLevel) {
- $socket->Dump();
+ $socket->Dump(-1); # Ensure it will get dumped.
}
}
@@ -261,7 +270,7 @@ sub SocketTimeout {
my $Socket = shift;
Log("WARNING", "A socket timeout was detected");
Debug(0, " SocketTimeout called: ");
- $Socket->Dump();
+ $Socket->Dump(0);
if(exists($ActiveTransactions{$Socket})) {
FailTransaction($ActiveTransactions{$Socket});
}
@@ -288,7 +297,8 @@ sub Tick {
my $client;
if($ConnectionRetriesLeft > 0) {
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount
- ." Retries remaining: ".$ConnectionRetriesLeft);
+ ." Retries remaining: ".$ConnectionRetriesLeft
+ ." ($KeyMode)");
} else {
ShowStatus(GetServerHost()." >> DEAD <<");
}
@@ -297,10 +307,13 @@ sub Tick {
if($IdleConnections->Count() &&
($WorkQueue->Count() == 0)) { # Idle connections and nothing to do?
- $IdleSeconds++;
+ $IdleSeconds+=$TickLength;
if($IdleSeconds > $IdleTimeout) { # Prune a connection...
my $Socket = $IdleConnections->pop();
KillSocket($Socket);
+ if ($IdleConnections->Count() == 0) {
+ &SetupTimer($LongTickLength);
+ }
}
} else {
$IdleSeconds = 0; # Reset idle count if not idle.
@@ -343,6 +356,9 @@ sub Tick {
}
}
+ if ($ConnectionCount == 0) {
+ $KeyMode = "";
+ }
}
=pod
@@ -361,9 +377,13 @@ Trigger disconnections of idle sockets.
=cut
+my $timer;
sub SetupTimer {
- Debug(6, "SetupTimer");
- Event->timer(interval => 1, cb => \&Tick );
+ my ($newLength)=@_;
+ Debug(6, "SetupTimer $TickLength->$newLength");
+ $TickLength=$newLength;
+ if ($timer) { $timer->cancel; }
+ $timer=Event->timer(interval => $TickLength, cb => \&Tick );
}
=pod
@@ -383,6 +403,7 @@ long enough, it will be shut down and re
sub ServerToIdle {
my $Socket = shift; # Get the socket.
+ $KeyMode = $Socket->{AuthenticationMode};
delete($ActiveTransactions{$Socket}); # Server has no transaction
&Debug(5, "Server to idle");
@@ -515,8 +536,8 @@ The transaction that is being completed.
sub CompleteTransaction {
&Debug(5,"Complete transaction");
- my $Socket = shift;
- my $Transaction = shift;
+
+ my ($Socket, $Transaction) = @_;
if (!$Transaction->isDeferred()) { # Normal transaction
my $data = $Socket->GetReply(); # Data to send.
@@ -550,9 +571,8 @@ sub CompleteTransaction {
=cut
sub StartClientReply {
- my $Transaction = shift;
- my $data = shift;
+ my ($Transaction, $data) = @_;
my $Client = $Transaction->getClient();
@@ -1164,8 +1184,8 @@ The text of the request to send.
=cut
sub StartRequest {
- my $Lond = shift;
- my $Request = shift; # This is a LondTransaction.
+
+ my ($Lond, $Request) = @_;
Debug(6, "StartRequest: ".$Request->getRequest());
@@ -1223,6 +1243,7 @@ sub QueueTransaction {
EmptyQueue(); # Fail transactions, can't make connection.
CloseAllLondConnections; # Should all be closed but...
}
+ &SetupTimer($ShortTickLength);
} else {
ShowStatus(GetServerHost()." >>> DEAD !!!! <<<");
EmptyQueue(); # It's worse than that ... he's dead Jim.
@@ -1269,7 +1290,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");
@@ -1416,6 +1437,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;
@@ -1428,16 +1450,18 @@ sub ChildStatus {
#
# 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++;
+ 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(-1); # Ensure it gets dumped..
+ $i++;
+ }
}
$ConnectionRetriesLeft = $ConnectionRetries;
}
@@ -1509,7 +1533,7 @@ sub ChildProcess {
cb => \&ToggleDebug,
data => "INT");
- SetupTimer();
+ SetupTimer($LongTickLength);
SetupLoncListener();