version 1.65, 2004/10/05 11:16:57
|
version 1.71, 2005/06/16 22:33:45
|
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 151 sub UpdateStatus {
|
Line 152 sub UpdateStatus {
|
Makes an entry into the permanent log file. |
Makes an entry into the permanent log file. |
|
|
=cut |
=cut |
|
|
sub LogPerm { |
sub LogPerm { |
my $message=shift; |
my $message=shift; |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
Line 270 sub SocketDump {
|
Line 272 sub SocketDump {
|
and as what we return in a SIGUSR1 |
and as what we return in a SIGUSR1 |
|
|
=cut |
=cut |
|
|
sub ShowStatus { |
sub ShowStatus { |
my $state = shift; |
my $state = shift; |
my $now = time; |
my $now = time; |
Line 280 sub ShowStatus {
|
Line 283 sub ShowStatus {
|
|
|
=pod |
=pod |
|
|
=head 2 SocketTimeout |
=head2 SocketTimeout |
|
|
Called when an action on the socket times out. The socket is |
Called when an action on the socket times out. The socket is |
destroyed and any active transaction is failed. |
destroyed and any active transaction is failed. |
|
|
|
|
=cut |
=cut |
|
|
sub SocketTimeout { |
sub SocketTimeout { |
my $Socket = shift; |
my $Socket = shift; |
Log("WARNING", "A socket timeout was detected"); |
Log("WARNING", "A socket timeout was detected"); |
Line 419 sub Tick {
|
Line 423 sub Tick {
|
$KeyMode = ""; |
$KeyMode = ""; |
$clock_watcher->cancel(); |
$clock_watcher->cancel(); |
} |
} |
|
&UpdateStatus(); |
} |
} |
|
|
=pod |
=pod |
Line 672 sub FailTransaction {
|
Line 677 sub FailTransaction {
|
|
|
if ($ConnectionRetriesLeft > 0) { |
if ($ConnectionRetriesLeft > 0) { |
Log("WARNING", "Failing transaction " |
Log("WARNING", "Failing transaction " |
.$transaction->getRequest()); |
.$transaction->getLoggableRequest()); |
} |
} |
Debug(1, "Failing transaction: ".$transaction->getRequest()); |
Debug(1, "Failing transaction: ".$transaction->getLoggableRequest()); |
if (!$transaction->isDeferred()) { # If the transaction is deferred we'll get to it. |
if (!$transaction->isDeferred()) { # If the transaction is deferred we'll get to it. |
my $client = $transaction->getClient(); |
my $client = $transaction->getClient(); |
Debug(1," Replying con_lost to ".$transaction->getRequest()); |
Debug(1," Replying con_lost to ".$transaction->getRequest()); |
Line 684 sub FailTransaction {
|
Line 689 sub FailTransaction {
|
} |
} |
|
|
=pod |
=pod |
|
|
=head1 EmptyQueue |
=head1 EmptyQueue |
|
|
Fails all items in the work queue with con_lost. |
Fails all items in the work queue with con_lost. |
Note that each item in the work queue is a transaction. |
Note that each item in the work queue is a transaction. |
|
|
=cut |
=cut |
|
|
sub EmptyQueue { |
sub EmptyQueue { |
$ConnectionRetriesLeft--; # Counts as connection failure too. |
$ConnectionRetriesLeft--; # Counts as connection failure too. |
while($WorkQueue->Count()) { |
while($WorkQueue->Count()) { |
Line 705 sub EmptyQueue {
|
Line 712 sub EmptyQueue {
|
Close all connections open on lond prior to exit e.g. |
Close all connections open on lond prior to exit e.g. |
|
|
=cut |
=cut |
|
|
sub CloseAllLondConnections { |
sub CloseAllLondConnections { |
foreach my $Socket (keys %ActiveConnections) { |
foreach my $Socket (keys %ActiveConnections) { |
if(exists($ActiveTransactions{$Socket})) { |
if(exists($ActiveTransactions{$Socket})) { |
Line 713 sub CloseAllLondConnections {
|
Line 721 sub CloseAllLondConnections {
|
KillSocket($Socket); |
KillSocket($Socket); |
} |
} |
} |
} |
=cut |
|
|
|
=pod |
=pod |
|
|
Line 735 Parameters:
|
Line 742 Parameters:
|
|
|
nonzero if we are allowed to create a new connection. |
nonzero if we are allowed to create a new connection. |
|
|
|
|
=cut |
=cut |
|
|
sub KillSocket { |
sub KillSocket { |
my $Socket = shift; |
my $Socket = shift; |
|
|
Line 1149 sub LondWritable {
|
Line 1156 sub LondWritable {
|
=pod |
=pod |
|
|
=cut |
=cut |
|
|
sub QueueDelayed { |
sub QueueDelayed { |
Debug(3,"QueueDelayed called"); |
Debug(3,"QueueDelayed called"); |
|
|
Line 1557 into the status file.
|
Line 1565 into the status file.
|
|
|
We also use this to reset the retries count in order to allow the |
We also use this to reset the retries count in order to allow the |
client to retry connections with a previously dead server. |
client to retry connections with a previously dead server. |
|
|
=cut |
=cut |
|
|
sub ChildStatus { |
sub ChildStatus { |
Line 1565 sub ChildStatus {
|
Line 1574 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; |
|
UpdateStatus(); |
} |
} |
|
|
=pod |
=pod |
Line 1605 sub SignalledToDeath {
|
Line 1619 sub SignalledToDeath {
|
chomp($signal); |
chomp($signal); |
Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost " |
Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost " |
."died through "."\"$signal\""); |
."died through "."\"$signal\""); |
LogPerm("F:lonc: $$ on $RemoteHost signalled to death: " |
#LogPerm("F:lonc: $$ on $RemoteHost signalled to death: " |
."\"$signal\""); |
# ."\"$signal\""); |
exit 0; |
exit 0; |
|
|
} |
} |
|
|
|
=pod |
|
|
=head2 ToggleDebug |
=head2 ToggleDebug |
|
|
This sub toggles trace debugging on and off. |
This sub toggles trace debugging on and off. |
Line 1626 sub ToggleDebug {
|
Line 1642 sub ToggleDebug {
|
|
|
} |
} |
|
|
|
=pod |
|
|
=head2 ChildProcess |
=head2 ChildProcess |
|
|
This sub implements a child process for a single lonc daemon. |
This sub implements a child process for a single lonc daemon. |
Line 2056 sub CheckKids {
|
Line 2074 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. |
|
} |
} |
|
|
} |
} |
Line 2162 sub really_kill_them_all_dammit
|
Line 2179 sub really_kill_them_all_dammit
|
unlink("$execdir/logs/lonc.pid"); |
unlink("$execdir/logs/lonc.pid"); |
} |
} |
} |
} |
|
|
=pod |
=pod |
|
|
=head1 Terminate |
=head1 Terminate |