version 1.53, 2004/09/20 09:34:31
|
version 1.57.2.1, 2005/01/19 21:38:25
|
Line 61 use LONCAPA::LondConnection;
|
Line 61 use LONCAPA::LondConnection;
|
use LONCAPA::LondTransaction; |
use LONCAPA::LondTransaction; |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
use LONCAPA::HashIterator; |
use LONCAPA::HashIterator; |
|
use Fcntl qw(:flock); |
|
|
|
|
# Read the httpd configuration file to get perl variables |
# Read the httpd configuration file to get perl variables |
Line 104 my $ConnectionRetries=2; # Number of con
|
Line 105 my $ConnectionRetries=2; # Number of con
|
my $ConnectionRetriesLeft=2; # Number of connection retries remaining. |
my $ConnectionRetriesLeft=2; # Number of connection retries remaining. |
my $LondVersion = "unknown"; # Version of lond we talk with. |
my $LondVersion = "unknown"; # Version of lond we talk with. |
my $KeyMode = ""; # e.g. ssl, local, insecure from last connect. |
my $KeyMode = ""; # e.g. ssl, local, insecure from last connect. |
|
my $LondConnecting = 0; # True when a connection is being built. |
|
|
|
my $DieWhenIdle = 0; # When true children die when trimmed -> 0. |
|
|
# |
# |
# The hash below gives the HTML format for log messages |
# The hash below gives the HTML format for log messages |
Line 118 $LogFormats{"WARNING"} = "<font color='
|
Line 122 $LogFormats{"WARNING"} = "<font color='
|
$LogFormats{"DEFAULT"} = " %s "; |
$LogFormats{"DEFAULT"} = " %s "; |
|
|
|
|
|
# UpdateStatus; |
|
# Update the idle status display to show how many connections |
|
# are left, retries and other stuff. |
|
# |
|
sub UpdateStatus { |
|
if ($ConnectionRetriesLeft > 0) { |
|
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount |
|
." Retries remaining: ".$ConnectionRetriesLeft |
|
." ($KeyMode)"); |
|
} else { |
|
ShowStatus(GetServerHost()." >> DEAD <<"); |
|
} |
|
} |
|
|
|
|
=pod |
=pod |
|
|
Line 275 sub SocketTimeout {
|
Line 293 sub SocketTimeout {
|
$ConnectionRetriesLeft--; |
$ConnectionRetriesLeft--; |
if($ConnectionRetriesLeft <= 0) { |
if($ConnectionRetriesLeft <= 0) { |
Log("CRITICAL", "Host marked DEAD: ".GetServerHost()); |
Log("CRITICAL", "Host marked DEAD: ".GetServerHost()); |
|
$LondConnecting = 0; |
} |
} |
|
|
} |
} |
Line 294 sub Tick {
|
Line 313 sub Tick {
|
my $clock_watcher = $Event->w; |
my $clock_watcher = $Event->w; |
|
|
my $client; |
my $client; |
if($ConnectionRetriesLeft > 0) { |
UpdateStatus(); |
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount |
|
." Retries remaining: ".$ConnectionRetriesLeft |
|
." ($KeyMode)"); |
|
} else { |
|
ShowStatus(GetServerHost()." >> DEAD <<"); |
|
} |
|
# Is it time to prune connection count: |
# Is it time to prune connection count: |
|
|
|
|
Line 310 sub Tick {
|
Line 324 sub Tick {
|
if($IdleSeconds > $IdleTimeout) { # Prune a connection... |
if($IdleSeconds > $IdleTimeout) { # Prune a connection... |
my $Socket = $IdleConnections->pop(); |
my $Socket = $IdleConnections->pop(); |
KillSocket($Socket); |
KillSocket($Socket); |
IdleSeconds = 0; # Otherwise all connections get trimmed to fast. |
$IdleSeconds = 0; # Otherwise all connections get trimmed to fast. |
|
UpdateStatus(); |
|
if(($ConnectionCount == 0) && $DieWhenIdle) { |
|
# |
|
# Create a lock file since there will be a time window |
|
# between our exit and the parent's picking up the listen |
|
# during which no listens will be done on the |
|
# lonnet client socket. |
|
# |
|
my $lock_file = GetLoncSocketPath().".lock"; |
|
open(LOCK,">$lock_file"); |
|
print LOCK "Contents not important"; |
|
close(LOCK); |
|
|
|
exit(0); |
|
} |
} |
} |
} else { |
} else { |
$IdleSeconds = 0; # Reset idle count if not idle. |
$IdleSeconds = 0; # Reset idle count if not idle. |
Line 329 sub Tick {
|
Line 358 sub Tick {
|
# Do we have work in the queue, but no connections to service them? |
# 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. |
# If so, try to make some new connections to get things going again. |
# |
# |
|
# Note this code is dead now... |
|
# |
my $Requests = $WorkQueue->Count(); |
my $Requests = $WorkQueue->Count(); |
if (($ConnectionCount == 0) && ($Requests > 0)) { |
if (($ConnectionCount == 0) && ($Requests > 0) && (!$LondConnecting)) { |
if ($ConnectionRetriesLeft > 0) { |
if ($ConnectionRetriesLeft > 0) { |
my $Connections = ($Requests <= $MaxConnectionCount) ? |
Debug(5,"Work but no connections, Make a new one"); |
$Requests : $MaxConnectionCount; |
my $success; |
Debug(5,"Work but no connections, start ".$Connections." of them"); |
$success = &MakeLondConnection; |
my $successCount = 0; |
if($success == 0) { # All connections failed: |
for (my $i =0; $i < $Connections; $i++) { |
|
$successCount += MakeLondConnection(); |
|
} |
|
if($successCount == 0) { # All connections failed: |
|
Debug(5,"Work in queue failed to make any connectiouns\n"); |
Debug(5,"Work in queue failed to make any connectiouns\n"); |
EmptyQueue(); # Fail pending transactions with con_lost. |
EmptyQueue(); # Fail pending transactions with con_lost. |
CloseAllLondConnections(); # Should all be closed but.... |
CloseAllLondConnections(); # Should all be closed but.... |
} |
} |
} else { |
} else { |
|
$LondConnecting = 0; |
ShowStatus(GetServerHost()." >>> DEAD!!! <<<"); |
ShowStatus(GetServerHost()." >>> DEAD!!! <<<"); |
Debug(5,"Work in queue, but gave up on connections..flushing\n"); |
Debug(5,"Work in queue, but gave up on connections..flushing\n"); |
EmptyQueue(); # Connections can't be established. |
EmptyQueue(); # Connections can't be established. |
Line 357 sub Tick {
|
Line 384 sub Tick {
|
$KeyMode = ""; |
$KeyMode = ""; |
$clock_watcher->cancel(); |
$clock_watcher->cancel(); |
} |
} |
|
&UpdateStatus(); |
} |
} |
|
|
=pod |
=pod |
Line 798 sub LondReadable {
|
Line 826 sub LondReadable {
|
"Lond connection lost."); |
"Lond connection lost."); |
if(exists($ActiveTransactions{$Socket})) { |
if(exists($ActiveTransactions{$Socket})) { |
FailTransaction($ActiveTransactions{$Socket}); |
FailTransaction($ActiveTransactions{$Socket}); |
|
} else { |
|
# Socket is connecting and failed... need to mark |
|
# no longer connecting. |
|
|
|
$LondConnecting = 0; |
} |
} |
$Watcher->cancel(); |
$Watcher->cancel(); |
KillSocket($Socket); |
KillSocket($Socket); |
Line 872 sub LondReadable {
|
Line 905 sub LondReadable {
|
.$RemoteHost." now ready for action"); |
.$RemoteHost." now ready for action"); |
} |
} |
ServerToIdle($Socket); # Next work unit or idle. |
ServerToIdle($Socket); # Next work unit or idle. |
|
|
|
# |
|
$LondConnecting = 0; # Best spot I can think of for this. |
|
# |
|
|
} elsif ($State eq "SendingRequest") { |
} elsif ($State eq "SendingRequest") { |
# We need to be writable for this and probably don't belong |
# We need to be writable for this and probably don't belong |
Line 985 sub LondWritable {
|
Line 1022 sub LondWritable {
|
" has been disconnected"); |
" has been disconnected"); |
if(exists($ActiveTransactions{$Socket})) { |
if(exists($ActiveTransactions{$Socket})) { |
FailTransaction($ActiveTransactions{$Socket}); |
FailTransaction($ActiveTransactions{$Socket}); |
|
} else { |
|
# In the process of conneting, so need to turn that off. |
|
|
|
$LondConnecting = 0; |
} |
} |
$Watcher->cancel(); |
$Watcher->cancel(); |
KillSocket($Socket); |
KillSocket($Socket); |
Line 1155 sub MakeLondConnection {
|
Line 1196 sub MakeLondConnection {
|
} |
} |
Log("SUCESS", "Created connection ".$ConnectionCount |
Log("SUCESS", "Created connection ".$ConnectionCount |
." to host ".GetServerHost()); |
." to host ".GetServerHost()); |
|
$LondConnecting = 1; # Connection in progress. |
return 1; # Return success. |
return 1; # Return success. |
} |
} |
|
|
Line 1238 sub QueueTransaction {
|
Line 1280 sub QueueTransaction {
|
if(!defined $LondSocket) { # Need to queue request. |
if(!defined $LondSocket) { # Need to queue request. |
Debug(5,"Must queue..."); |
Debug(5,"Must queue..."); |
$WorkQueue->enqueue($requestData); |
$WorkQueue->enqueue($requestData); |
if($ConnectionCount < $MaxConnectionCount) { |
Debug(5, "Queue Transaction startnew $ConnectionCount $LondConnecting"); |
|
if(($ConnectionCount < $MaxConnectionCount) && (! $LondConnecting)) { |
|
|
if($ConnectionRetriesLeft > 0) { |
if($ConnectionRetriesLeft > 0) { |
Debug(5,"Starting additional lond connection"); |
Debug(5,"Starting additional lond connection"); |
if(MakeLondConnection() == 0) { |
if(&MakeLondConnection() == 0) { |
EmptyQueue(); # Fail transactions, can't make connection. |
EmptyQueue(); # Fail transactions, can't make connection. |
CloseAllLondConnections; # Should all be closed but... |
CloseAllLondConnections; # Should all be closed but... |
} |
} |
} else { |
} else { |
ShowStatus(GetServerHost()." >>> DEAD !!!! <<<"); |
ShowStatus(GetServerHost()." >>> DEAD !!!! <<<"); |
|
$LondConnecting = 0; |
EmptyQueue(); # It's worse than that ... he's dead Jim. |
EmptyQueue(); # It's worse than that ... he's dead Jim. |
CloseAllLondConnections; # Should all be closed but.. |
CloseAllLondConnections; # Should all be closed but.. |
} |
} |
Line 1400 sub SetupLoncListener {
|
Line 1445 sub SetupLoncListener {
|
my $SocketName = GetLoncSocketPath(); |
my $SocketName = GetLoncSocketPath(); |
unlink($SocketName); |
unlink($SocketName); |
unless ($socket =IO::Socket::UNIX->new(Local => $SocketName, |
unless ($socket =IO::Socket::UNIX->new(Local => $SocketName, |
Listen => 10, |
Listen => 250, |
Type => SOCK_STREAM)) { |
Type => SOCK_STREAM)) { |
die "Failed to create a lonc listner socket"; |
die "Failed to create a lonc listner socket"; |
} |
} |
Line 1445 sub ChildStatus {
|
Line 1490 sub ChildStatus {
|
|
|
Debug(2, "Reporting child status because : ".$watcher->data); |
Debug(2, "Reporting child status because : ".$watcher->data); |
my $docdir = $perlvar{'lonDocRoot'}; |
my $docdir = $perlvar{'lonDocRoot'}; |
my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt"); |
|
print $fh $$."\t".$RemoteHost."\t".$Status."\t". |
open(LOG,">>$docdir/lon-status/loncstatus.txt"); |
|
flock(LOG,LOCK_EX); |
|
print LOG $$."\t".$RemoteHost."\t".$Status."\t". |
$RecentLogEntry."\n"; |
$RecentLogEntry."\n"; |
# |
# |
# Write out information about each of the connections: |
# Write out information about each of the connections: |
# |
# |
if ($DebugLevel > 2) { |
if ($DebugLevel > 2) { |
print $fh "Active connection statuses: \n"; |
print LOG "Active connection statuses: \n"; |
my $i = 1; |
my $i = 1; |
print STDERR "================================= Socket Status Dump:\n"; |
print STDERR "================================= Socket Status Dump:\n"; |
foreach my $item (keys %ActiveConnections) { |
foreach my $item (keys %ActiveConnections) { |
my $Socket = $ActiveConnections{$item}->data; |
my $Socket = $ActiveConnections{$item}->data; |
my $state = $Socket->GetState(); |
my $state = $Socket->GetState(); |
print $fh "Connection $i State: $state\n"; |
print LOG "Connection $i State: $state\n"; |
print STDERR "---------------------- Connection $i \n"; |
print STDERR "---------------------- Connection $i \n"; |
$Socket->Dump(-1); # Ensure it gets dumped.. |
$Socket->Dump(-1); # Ensure it gets dumped.. |
$i++; |
$i++; |
} |
} |
} |
} |
|
flock(LOG,LOCK_UN); |
|
close(LOG); |
$ConnectionRetriesLeft = $ConnectionRetries; |
$ConnectionRetriesLeft = $ConnectionRetries; |
} |
} |
|
|
Line 1686 sub CheckKids {
|
Line 1735 sub CheckKids {
|
foreach my $pid (keys %ChildHash) { |
foreach my $pid (keys %ChildHash) { |
Debug(2, "Sending USR1 -> $pid"); |
Debug(2, "Sending USR1 -> $pid"); |
kill 'USR1' => $pid; # Tell Child to report status. |
kill 'USR1' => $pid; # Tell Child to report status. |
sleep 1; # Wait so file doesn't intermix. |
|
} |
} |
} |
} |
|
|