version 1.14, 2003/07/03 02:10:18
|
version 1.22, 2003/09/02 10:34:47
|
Line 7
|
Line 7
|
# Copyright Michigan State University Board of Trustees |
# Copyright Michigan State University Board of Trustees |
# |
# |
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
# |
## LON-CAPA is free software; you can redistribute it and/or modify |
# LON-CAPA is free software; you can redistribute it and/or modify |
|
# it under the terms of the GNU General Public License as published by |
# it under the terms of the GNU General Public License as published by |
# the Free Software Foundation; either version 2 of the License, or |
# the Free Software Foundation; either version 2 of the License, or |
# (at your option) any later version. |
# (at your option) any later version. |
Line 27
|
Line 26
|
# http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
# |
# |
# |
# |
# new lonc handles n requestors spread out bver m connections to londs. |
# new lonc handles n request out bver m connections to londs. |
# This module is based on the Event class. |
# This module is based on the Event class. |
# Development iterations: |
# Development iterations: |
# - Setup basic event loop. (done) |
# - Setup basic event loop. (done) |
Line 46
|
Line 45
|
|
|
# Change log: |
# Change log: |
# $Log$ |
# $Log$ |
|
# 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 |
# Revision 1.14 2003/07/03 02:10:18 foxr |
# Get all of the signals to work correctly. |
# Get all of the signals to work correctly. |
# |
# |
Line 58
|
Line 100
|
# Revision 1.10 2003/06/24 02:46:04 foxr |
# Revision 1.10 2003/06/24 02:46:04 foxr |
# Put a limit on the number of times we'll retry a connection. |
# 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 |
# Start getting the signal stuff put in as well...note that need to get signals |
# going or else 6the client will permanently give up on dead servers. |
# going or else the client will permanently give up on dead servers. |
# |
# |
# Revision 1.9 2003/06/13 02:38:43 foxr |
# Revision 1.9 2003/06/13 02:38:43 foxr |
# Add logging in 'expected format' |
# Add logging in 'expected format' |
Line 120 my $MaxConnectionCount = 10; # Will get
|
Line 162 my $MaxConnectionCount = 10; # Will get
|
my $ClientConnection = 0; # Uniquifier for client events. |
my $ClientConnection = 0; # Uniquifier for client events. |
|
|
my $DebugLevel = 0; |
my $DebugLevel = 0; |
|
my $NextDebugLevel= 10; # So Sigint can toggle this. |
my $IdleTimeout= 3600; # Wait an hour before pruning connections. |
my $IdleTimeout= 3600; # Wait an hour before pruning connections. |
|
|
# |
# |
# The variables below are only used by the child processes. |
# The variables below are only used by the child processes. |
# |
# |
my $RemoteHost; # Name of host child is talking to. |
my $RemoteHost; # Name of host child is talking to. |
my $UnixSocketDir= "/home/httpd/sockets"; |
my $UnixSocketDir= $perlvar{'lonSockDir'}; |
my $IdleConnections = Stack->new(); # Set of idle connections |
my $IdleConnections = Stack->new(); # Set of idle connections |
my %ActiveConnections; # Connections to the remote lond. |
my %ActiveConnections; # Connections to the remote lond. |
my %ActiveTransactions; # LondTransactions in flight. |
my %ActiveTransactions; # LondTransactions in flight. |
Line 256 sub Debug {
|
Line 299 sub Debug {
|
my $level = shift; |
my $level = shift; |
my $message = shift; |
my $message = shift; |
if ($level <= $DebugLevel) { |
if ($level <= $DebugLevel) { |
print $message." host = ".$RemoteHost."\n"; |
Log("INFO", "-Debug- $message host = $RemotHost"); |
} |
} |
} |
} |
|
|
Line 286 sub ShowStatus {
|
Line 329 sub ShowStatus {
|
|
|
=pod |
=pod |
|
|
|
=head 2 SocketTimeout |
|
|
|
Called when an action on the socket times out. The socket is |
|
destroyed and any active transaction is failed. |
|
|
|
|
|
=cut |
|
sub SocketTimeout { |
|
my $Socket = shift; |
|
|
|
KillSocket($Socket); # A transaction timeout also counts as |
|
# a connection failure: |
|
$ConnectionRetriesLeft--; |
|
} |
|
|
|
=pod |
|
|
=head2 Tick |
=head2 Tick |
|
|
Invoked each timer tick. |
Invoked each timer tick. |
Line 295 Invoked each timer tick.
|
Line 355 Invoked each timer tick.
|
|
|
sub Tick { |
sub Tick { |
my $client; |
my $client; |
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount); |
if($ConnectionRetriesLeft > 0) { |
|
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount |
|
." Retries remaining: ".$ConnectionRetriesLeft); |
|
} else { |
|
ShowStatus(GetServerHost()." >> DEAD <<"); |
|
} |
# Is it time to prune connection count: |
# Is it time to prune connection count: |
|
|
|
|
Line 310 sub Tick {
|
Line 374 sub Tick {
|
} else { |
} else { |
$IdleSeconds = 0; # Reset idle count if not idle. |
$IdleSeconds = 0; # Reset idle count if not idle. |
} |
} |
|
# |
|
# For each inflight transaction, tick down its timeout counter. |
|
# |
|
foreach $item (keys %ActiveTransactions) { |
|
my $Socket = $ActiveTransactions{$item}->getServer(); |
|
$Socket->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. |
# |
# |
Line 321 sub Tick {
|
Line 391 sub Tick {
|
my $Connections = ($Requests <= $MaxConnectionCount) ? |
my $Connections = ($Requests <= $MaxConnectionCount) ? |
$Requests : $MaxConnectionCount; |
$Requests : $MaxConnectionCount; |
Debug(1,"Work but no connections, start ".$Connections." of them"); |
Debug(1,"Work but no connections, start ".$Connections." of them"); |
|
my $successCount = 0; |
for ($i =0; $i < $Connections; $i++) { |
for ($i =0; $i < $Connections; $i++) { |
MakeLondConnection(); |
$successCount += MakeLondConnection(); |
|
} |
|
if($successCount == 0) { # All connections failed: |
|
Debug(1,"Work in queue failed to make any connectiouns\n"); |
|
EmptyQueue(); # Fail pending transactions with con_lost. |
} |
} |
} else { |
} else { |
|
ShowStatus(GetServerHost()." >>> DEAD!!! <<<"); |
Debug(1,"Work in queue, but gave up on connections..flushing\n"); |
Debug(1,"Work in queue, but gave up on connections..flushing\n"); |
EmptyQueue(); # Connections can't be established. |
EmptyQueue(); # Connections can't be established. |
} |
} |
Line 448 sub ClientWritable {
|
Line 524 sub ClientWritable {
|
|
|
} else { # Partial string sent. |
} else { # Partial string sent. |
$Watcher->data(substr($Data, $result)); |
$Watcher->data(substr($Data, $result)); |
|
if($result == 0) { # client hung up on us!! |
|
Log("INFO", "lonc pipe client hung up on us!"); |
|
$Watcher->cancel; |
|
$Socket->shutdown(2); |
|
$Socket->close(); |
|
} |
} |
} |
|
|
} else { # Error of some sort... |
} else { # Error of some sort... |
Line 565 Parameters:
|
Line 647 Parameters:
|
|
|
sub FailTransaction { |
sub FailTransaction { |
my $transaction = shift; |
my $transaction = shift; |
|
Log("WARNING", "Failing transaction ".$transaction->getRequest()); |
Debug(1, "Failing transaction: ".$transaction->getRequest()); |
Debug(1, "Failing transaction: ".$transaction->getRequest()); |
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()); |
StartClientReply($transaction, "con_lost\n"); |
StartClientReply($transaction, "con_lost\n"); |
} |
} |
|
if($ConnectionRetriesLeft <= 0) { |
|
Log("CRITICAL", "Host marked dead: ".GetServerHost()); |
|
} |
|
|
} |
} |
|
|
Line 582 sub FailTransaction {
|
Line 668 sub FailTransaction {
|
|
|
=cut |
=cut |
sub EmptyQueue { |
sub EmptyQueue { |
|
$ConnectionRetriesLeft--; # Counts as connection failure too. |
while($WorkQueue->Count()) { |
while($WorkQueue->Count()) { |
my $request = $WorkQueue->dequeue(); # This is a transaction |
my $request = $WorkQueue->dequeue(); # This is a transaction |
FailTransaction($request); |
FailTransaction($request); |
Line 627 nonzero if we are allowed to create a ne
|
Line 714 nonzero if we are allowed to create a ne
|
sub KillSocket { |
sub KillSocket { |
my $Socket = shift; |
my $Socket = shift; |
|
|
|
Log("WARNING", "Shutting down a socket"); |
$Socket->Shutdown(); |
$Socket->Shutdown(); |
|
|
# If the socket came from the active connection set, |
# If the socket came from the active connection set, |
Line 647 sub KillSocket {
|
Line 735 sub KillSocket {
|
# work queue, the work all gets failed with con_lost. |
# work queue, the work all gets failed with con_lost. |
# |
# |
if($ConnectionCount == 0) { |
if($ConnectionCount == 0) { |
EmptyQueue; |
EmptyQueue(); |
} |
} |
} |
} |
|
|
Line 723 sub LondReadable {
|
Line 811 sub LondReadable {
|
|
|
SocketDump(6, $Socket); |
SocketDump(6, $Socket); |
my $status = $Socket->Readable(); |
my $status = $Socket->Readable(); |
|
|
&Debug(2, "Socket->Readable returned: $status"); |
&Debug(2, "Socket->Readable returned: $status"); |
|
|
if($status != 0) { |
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. |
# The socket has become disconnected. We fail the transaction. |
|
|
|
Log("WARNING", |
|
"Lond connection lost."); |
if(exists($ActiveTransactions{$Socket})) { |
if(exists($ActiveTransactions{$Socket})) { |
Debug(3,"Lond connection lost failing transaction"); |
|
FailTransaction($ActiveTransactions{$Socket}); |
FailTransaction($ActiveTransactions{$Socket}); |
} |
} |
$Watcher->cancel(); |
$Watcher->cancel(); |
KillSocket($Socket); |
KillSocket($Socket); |
|
$ConnectionRetriesLeft--; # Counts as connection failure |
return; |
return; |
} |
} |
SocketDump(6,$Socket); |
SocketDump(6,$Socket); |
Line 768 sub LondReadable {
|
Line 859 sub LondReadable {
|
} elsif ($State eq "Idle") { |
} elsif ($State eq "Idle") { |
# If necessary, complete a transaction and then go into the |
# If necessary, complete a transaction and then go into the |
# idle queue. |
# idle queue. |
|
# Note that a trasition to idle indicates a live lond |
|
# on the other end so reset the connection retries. |
|
# |
|
$ConnectionRetriesLeft = $ConnectionRetries; # success resets the count |
$Watcher->cancel(); |
$Watcher->cancel(); |
if(exists($ActiveTransactions{$Socket})) { |
if(exists($ActiveTransactions{$Socket})) { |
Debug(8,"Completing transaction!!"); |
Debug(8,"Completing transaction!!"); |
Line 880 sub LondWritable {
|
Line 975 sub LondWritable {
|
# We'll treat this as if the socket got disconnected: |
# We'll treat this as if the socket got disconnected: |
Log("WARNING", "Connection to ".$RemoteHost. |
Log("WARNING", "Connection to ".$RemoteHost. |
" has been disconnected"); |
" has been disconnected"); |
|
FailTransaction($ActiveTransactions{$Socket}); |
$Watcher->cancel(); |
$Watcher->cancel(); |
KillSocket($Socket); |
KillSocket($Socket); |
return; |
return; |
Line 1022 sub MakeLondConnection {
|
Line 1118 sub MakeLondConnection {
|
$ConnectionRetriesLeft--; |
$ConnectionRetriesLeft--; |
return 0; # Failure. |
return 0; # Failure. |
} else { |
} else { |
$ConnectionRetriesLeft = $ConnectionRetries; # success resets the count |
|
# The connection needs to have writability |
# The connection needs to have writability |
# monitored in order to send the init sequence |
# monitored in order to send the init sequence |
# that starts the whole authentication/key |
# that starts the whole authentication/key |
Line 1035 sub MakeLondConnection {
|
Line 1131 sub MakeLondConnection {
|
&Debug(9,"MakeLondConnection got socket: ".$Socket); |
&Debug(9,"MakeLondConnection got socket: ".$Socket); |
} |
} |
|
|
|
$Connection->SetTimeoutCallback(\&SocketTimeout); |
|
|
$event = Event->io(fd => $Socket, |
$event = Event->io(fd => $Socket, |
poll => 'w', |
poll => 'w', |
cb => \&LondWritable, |
cb => \&LondWritable, |
Line 1134 sub QueueTransaction {
|
Line 1231 sub QueueTransaction {
|
Debug(8,"Must queue..."); |
Debug(8,"Must queue..."); |
$WorkQueue->enqueue($requestData); |
$WorkQueue->enqueue($requestData); |
if($ConnectionCount < $MaxConnectionCount) { |
if($ConnectionCount < $MaxConnectionCount) { |
Debug(4,"Starting additional lond connection"); |
if($ConnectionRetriesLeft > 0) { |
MakeLondConnection(); |
Debug(4,"Starting additional lond connection"); |
|
if(MakeLondConnection() == 0) { |
|
EmptyQueue(); # Fail transactions, can't make connection. |
|
} |
|
} else { |
|
ShowStatus(GetServerHost()." >>> DEAD !!!! <<<"); |
|
EmptyQueue(); # It's worse than that ... he's dead Jim. |
|
} |
} |
} |
} else { # Can start the request: |
} else { # Can start the request: |
Debug(8,"Can start..."); |
Debug(8,"Can start..."); |
Line 1300 sub SetupLoncListener {
|
Line 1404 sub SetupLoncListener {
|
Child USR1 signal handler to report the most recent status |
Child USR1 signal handler to report the most recent status |
into the status file. |
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 |
=cut |
sub ChildStatus { |
sub ChildStatus { |
my $event = shift; |
my $event = shift; |
Line 1310 sub ChildStatus {
|
Line 1416 sub ChildStatus {
|
my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt"); |
my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt"); |
print $fh $$."\t".$RemoteHost."\t".$Status."\t". |
print $fh $$."\t".$RemoteHost."\t".$Status."\t". |
$RecentLogEntry."\n"; |
$RecentLogEntry."\n"; |
|
$ConnectionRetriesLeft = $ConnectionRetries; |
} |
} |
|
|
=pod |
=pod |
Line 1326 sub SignalledToDeath {
|
Line 1433 sub SignalledToDeath {
|
my $watcher= $event->w; |
my $watcher= $event->w; |
|
|
Debug(2,"Signalled to death! via ".$watcher->data); |
Debug(2,"Signalled to death! via ".$watcher->data); |
my ($signal) = @_; |
my ($signal) = $watcher->data; |
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\""); |
die("Signal abnormal end"); |
|
exit 0; |
exit 0; |
|
|
} |
} |
|
|
|
=head2 ToggleDebug |
|
|
|
This sub toggles trace debugging on and off. |
|
|
|
=cut |
|
|
|
sub ToggleDebug { |
|
my $Current = $DebugLevel; |
|
$DebugLevel = $NextDebugLevel; |
|
$NextDebugLevel = $Current; |
|
|
|
Log("SUCCESS", "New debugging level for $RemoteHost now $DebugLevel"); |
|
|
|
} |
|
|
=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 1348 sub ChildProcess {
|
Line 1470 sub ChildProcess {
|
# |
# |
# Signals must be handled by the Event framework... |
# Signals must be handled by the Event framework... |
# |
# |
# $SIG{QUIT} = \&SignalledToDeath; |
|
# $SIG{HUP} = \&ChildStatus; |
|
# $SIG{USR1} = IGNORE; |
|
# $SIG{INT} = DEFAULT; |
|
# $SIG{CHLD} = IGNORE; |
|
# $SIG{__DIE__} = \&SignalledToDeath; |
|
|
|
Event->signal(signal => "QUIT", |
Event->signal(signal => "QUIT", |
cb => \&SignalledToDeath, |
cb => \&SignalledToDeath, |
Line 1364 sub ChildProcess {
|
Line 1480 sub ChildProcess {
|
Event->signal(signal => "USR1", |
Event->signal(signal => "USR1", |
cb => \&ChildStatus, |
cb => \&ChildStatus, |
data => "USR1"); |
data => "USR1"); |
|
Event->signal(signal => "INT", |
|
cb => \&ToggleDebug, |
|
data => "INT"); |
|
|
SetupTimer(); |
SetupTimer(); |
|
|
Line 1395 sub CreateChild {
|
Line 1514 sub CreateChild {
|
Log("CRITICAL", "Forking server for ".$host); |
Log("CRITICAL", "Forking server for ".$host); |
$pid = fork; |
$pid = fork; |
if($pid) { # Parent |
if($pid) { # Parent |
|
$RemoteHost = "Parent"; |
$ChildHash{$pid} = $RemoteHost; |
$ChildHash{$pid} = $RemoteHost; |
sigprocmask(SIG_UNBLOCK, $sigset); |
sigprocmask(SIG_UNBLOCK, $sigset); |
|
|
Line 1442 open (PIDSAVE, ">$execdir/logs/lonc.pid"
|
Line 1562 open (PIDSAVE, ">$execdir/logs/lonc.pid"
|
print PIDSAVE "$$\n"; |
print PIDSAVE "$$\n"; |
close(PIDSAVE); |
close(PIDSAVE); |
|
|
|
|
|
|
if (POSIX::setsid() < 0) { |
if (POSIX::setsid() < 0) { |
print "Could not create new session\n"; |
print "Could not create new session\n"; |
exit -1; |
exit -1; |
Line 1536 sub Restart {
|
Line 1658 sub Restart {
|
=head1 KillThemAll |
=head1 KillThemAll |
|
|
Signal handler that kills all children by sending them a |
Signal handler that kills all children by sending them a |
SIGINT. Responds to sigint and sigterm. |
SIGHUP. Responds to sigint and sigterm. |
|
|
=cut |
=cut |
|
|
Line 1548 sub KillThemAll {
|
Line 1670 sub KillThemAll {
|
Debug(2, "Killing lonc for $serving pid = $pid"); |
Debug(2, "Killing lonc for $serving pid = $pid"); |
ShowStatus("Killing lonc for $serving pid = $pid"); |
ShowStatus("Killing lonc for $serving pid = $pid"); |
Log("CRITICAL", "Killing lonc for $serving pid = $pid"); |
Log("CRITICAL", "Killing lonc for $serving pid = $pid"); |
kill('INT', $pid); |
kill 'QUIT' => $pid; |
delete($ChildeHash{$pid}); |
delete($ChildHash{$pid}); |
} |
} |
my $execdir = $perlvar{'lonDaemons'}; |
my $execdir = $perlvar{'lonDaemons'}; |
unlink("$execdir/logs/lonc.pid"); |
unlink("$execdir/logs/lonc.pid"); |
ShowStatus("Killing the master process"); |
|
Log("CRITICAL", "Killing the master process."); |
|
} |
} |
|
|
=pod |
=pod |
Line 1567 Terminate the system.
|
Line 1688 Terminate the system.
|
|
|
sub Terminate { |
sub Terminate { |
KillThemAll; |
KillThemAll; |
exit; |
Log("CRITICAL","Master process exiting"); |
|
exit 0; |
|
|
} |
} |
=pod |
=pod |