version 1.51, 2004/08/26 12:35:10
|
version 1.53, 2004/09/20 09:34:31
|
Line 105 my $ConnectionRetriesLeft=2; # Number of
|
Line 105 my $ConnectionRetriesLeft=2; # Number of
|
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 $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 |
# The hash below gives the HTML format for log messages |
# given a severity. |
# given a severity. |
Line 269 sub ShowStatus {
|
Line 265 sub ShowStatus {
|
sub SocketTimeout { |
sub SocketTimeout { |
my $Socket = shift; |
my $Socket = shift; |
Log("WARNING", "A socket timeout was detected"); |
Log("WARNING", "A socket timeout was detected"); |
Debug(0, " SocketTimeout called: "); |
Debug(5, " SocketTimeout called: "); |
$Socket->Dump(0); |
$Socket->Dump(0); |
if(exists($ActiveTransactions{$Socket})) { |
if(exists($ActiveTransactions{$Socket})) { |
FailTransaction($ActiveTransactions{$Socket}); |
FailTransaction($ActiveTransactions{$Socket}); |
Line 278 sub SocketTimeout {
|
Line 274 sub SocketTimeout {
|
# a connection failure: |
# a connection failure: |
$ConnectionRetriesLeft--; |
$ConnectionRetriesLeft--; |
if($ConnectionRetriesLeft <= 0) { |
if($ConnectionRetriesLeft <= 0) { |
Log("CRITICAL", "Host marked dead: ".GetServerHost()); |
Log("CRITICAL", "Host marked DEAD: ".GetServerHost()); |
} |
} |
|
|
} |
} |
Line 294 Invoked each timer tick.
|
Line 290 Invoked each timer tick.
|
|
|
|
|
sub Tick { |
sub Tick { |
|
my ($Event) = @_; |
|
my $clock_watcher = $Event->w; |
|
|
my $client; |
my $client; |
if($ConnectionRetriesLeft > 0) { |
if($ConnectionRetriesLeft > 0) { |
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount |
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount |
Line 307 sub Tick {
|
Line 306 sub Tick {
|
|
|
if($IdleConnections->Count() && |
if($IdleConnections->Count() && |
($WorkQueue->Count() == 0)) { # Idle connections and nothing to do? |
($WorkQueue->Count() == 0)) { # Idle connections and nothing to do? |
$IdleSeconds+=$TickLength; |
$IdleSeconds++; |
if($IdleSeconds > $IdleTimeout) { # Prune a connection... |
if($IdleSeconds > $IdleTimeout) { # Prune a connection... |
my $Socket = $IdleConnections->pop(); |
my $Socket = $IdleConnections->pop(); |
KillSocket($Socket); |
KillSocket($Socket); |
if ($IdleConnections->Count() == 0) { |
IdleSeconds = 0; # Otherwise all connections get trimmed to fast. |
&SetupTimer($LongTickLength); |
|
} |
|
} |
} |
} else { |
} else { |
$IdleSeconds = 0; # Reset idle count if not idle. |
$IdleSeconds = 0; # Reset idle count if not idle. |
Line 358 sub Tick {
|
Line 355 sub Tick {
|
} |
} |
if ($ConnectionCount == 0) { |
if ($ConnectionCount == 0) { |
$KeyMode = ""; |
$KeyMode = ""; |
|
$clock_watcher->cancel(); |
} |
} |
} |
} |
|
|
Line 377 Trigger disconnections of idle sockets.
|
Line 375 Trigger disconnections of idle sockets.
|
|
|
=cut |
=cut |
|
|
my $timer; |
|
sub SetupTimer { |
sub SetupTimer { |
my ($newLength)=@_; |
Debug(6, "SetupTimer"); |
Debug(6, "SetupTimer $TickLength->$newLength"); |
Event->timer(interval => 1, cb => \&Tick ); |
$TickLength=$newLength; |
|
if ($timer) { $timer->cancel; } |
|
$timer=Event->timer(interval => $TickLength, cb => \&Tick ); |
|
} |
} |
|
|
=pod |
=pod |
Line 483 sub ClientWritable {
|
Line 477 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!! |
if($result == 0) { # client hung up on us!! |
Log("INFO", "lonc pipe client hung up on us!"); |
# Log("INFO", "lonc pipe client hung up on us!"); |
$Watcher->cancel; |
$Watcher->cancel; |
$Socket->shutdown(2); |
$Socket->shutdown(2); |
$Socket->close(); |
$Socket->close(); |
Line 611 Parameters:
|
Line 605 Parameters:
|
|
|
sub FailTransaction { |
sub FailTransaction { |
my $transaction = shift; |
my $transaction = shift; |
Log("WARNING", "Failing transaction ".$transaction->getRequest()); |
|
|
# If the socket is dead, that's already logged. |
|
|
|
if ($ConnectionRetriesLeft > 0) { |
|
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(); |
Line 1145 sub MakeLondConnection {
|
Line 1145 sub MakeLondConnection {
|
data => $Connection, |
data => $Connection, |
desc => 'Connection to lond server'); |
desc => 'Connection to lond server'); |
$ActiveConnections{$Connection} = $event; |
$ActiveConnections{$Connection} = $event; |
|
if ($ConnectionCount == 0) { |
|
&SetupTimer; # Need to handle timeouts with connections... |
|
} |
$ConnectionCount++; |
$ConnectionCount++; |
Debug(4, "Connection count = ".$ConnectionCount); |
Debug(4, "Connection count = ".$ConnectionCount); |
if($ConnectionCount == 1) { # First Connection: |
if($ConnectionCount == 1) { # First Connection: |
Line 1243 sub QueueTransaction {
|
Line 1245 sub QueueTransaction {
|
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... |
} |
} |
&SetupTimer($ShortTickLength); |
|
} else { |
} else { |
ShowStatus(GetServerHost()." >>> DEAD !!!! <<<"); |
ShowStatus(GetServerHost()." >>> DEAD !!!! <<<"); |
EmptyQueue(); # It's worse than that ... he's dead Jim. |
EmptyQueue(); # It's worse than that ... he's dead Jim. |
Line 1533 sub ChildProcess {
|
Line 1534 sub ChildProcess {
|
cb => \&ToggleDebug, |
cb => \&ToggleDebug, |
data => "INT"); |
data => "INT"); |
|
|
SetupTimer($LongTickLength); |
|
|
|
SetupLoncListener(); |
SetupLoncListener(); |
|
|
Line 1556 sub ChildProcess {
|
Line 1556 sub ChildProcess {
|
# Create a new child for host passed in: |
# Create a new child for host passed in: |
|
|
sub CreateChild { |
sub CreateChild { |
|
my $host = shift; |
|
|
my $sigset = POSIX::SigSet->new(SIGINT); |
my $sigset = POSIX::SigSet->new(SIGINT); |
sigprocmask(SIG_BLOCK, $sigset); |
sigprocmask(SIG_BLOCK, $sigset); |
my $host = shift; |
|
$RemoteHost = $host; |
$RemoteHost = $host; |
Log("CRITICAL", "Forking server for ".$host); |
Log("CRITICAL", "Forking server for ".$host); |
my $pid = fork; |
my $pid = fork; |
Line 1829 sub KillThemAll {
|
Line 1830 sub KillThemAll {
|
local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die. |
local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die. |
foreach my $pid (keys %ChildHash) { |
foreach my $pid (keys %ChildHash) { |
my $serving = $ChildHash{$pid}; |
my $serving = $ChildHash{$pid}; |
Debug(2, "Killing lonc for $serving pid = $pid"); |
ShowStatus("Nicely Killing lonc for $serving pid = $pid"); |
ShowStatus("Killing lonc for $serving pid = $pid"); |
Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid"); |
Log("CRITICAL", "Killing lonc for $serving pid = $pid"); |
|
kill 'QUIT' => $pid; |
kill 'QUIT' => $pid; |
delete($ChildHash{$pid}); |
|
} |
} |
my $execdir = $perlvar{'lonDaemons'}; |
|
unlink("$execdir/logs/lonc.pid"); |
|
|
|
} |
} |
|
|
|
|
|
# |
|
# Kill all children via KILL. Just in case the |
|
# first shot didn't get them. |
|
|
|
sub really_kill_them_all_dammit |
|
{ |
|
Debug(2, "Kill them all Dammit"); |
|
local($SIG{CHLD} = 'IGNORE'); # In case some purist reenabled them. |
|
foreach my $pid (keys %ChildHash) { |
|
my $serving = $ChildHash{$pid}; |
|
&ShowStatus("Nastily killing lonc for $serving pid = $pid"); |
|
Log("CRITICAL", "Nastily killing lonc for $serving pid = $pid"); |
|
kill 'KILL' => $pid; |
|
delete($ChildHash{$pid}); |
|
my $execdir = $perlvar{'lonDaemons'}; |
|
unlink("$execdir/logs/lonc.pid"); |
|
} |
|
} |
=pod |
=pod |
|
|
=head1 Terminate |
=head1 Terminate |
Line 1849 Terminate the system.
|
Line 1866 Terminate the system.
|
=cut |
=cut |
|
|
sub Terminate { |
sub Terminate { |
KillThemAll; |
&Log("CRITICAL", "Asked to kill children.. first be nice..."); |
|
&KillThemAll; |
|
# |
|
# By now they really should all be dead.. but just in case |
|
# send them all SIGKILL's after a bit of waiting: |
|
|
|
sleep(4); |
|
&Log("CRITICAL", "Now kill children nasty"); |
|
&really_kill_them_all_dammit; |
Log("CRITICAL","Master process exiting"); |
Log("CRITICAL","Master process exiting"); |
exit 0; |
exit 0; |
|
|