version 1.9, 2003/06/13 02:38:43
|
version 1.42, 2004/02/17 09:43:21
|
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 36
|
Line 35
|
# - Add ability to create/negotiate lond connections (done). |
# - Add ability to create/negotiate lond connections (done). |
# - Add general logic for dispatching requests and timeouts. (done). |
# - Add general logic for dispatching requests and timeouts. (done). |
# - Add support for the lonc/lond requests. (done). |
# - Add support for the lonc/lond requests. (done). |
# - Add logging/status monitoring. |
# - Add logging/status monitoring. (done) |
# - Add Signal handling - HUP restarts. USR1 status report. |
# - Add Signal handling - HUP restarts. USR1 status report. (done) |
# - Add Configuration file I/O (done). |
# - Add Configuration file I/O (done). |
# - Add management/status request interface. |
# - Add management/status request interface. (done) |
# - Add deferred request capability. (done) |
# - Add deferred request capability. (done) |
# - Detect transmission timeouts. |
# - Detect transmission timeouts. (done) |
# |
|
|
|
# Change log: |
|
# $Log$ |
|
# Revision 1.9 2003/06/13 02:38:43 foxr |
|
# Add logging in 'expected format' |
|
# |
|
# Revision 1.8 2003/06/11 02:04:35 foxr |
|
# Support delayed transactions... this is done uniformly by encapsulating |
|
# transactions in an object ... a LondTransaction that is implemented by |
|
# LondTransaction.pm |
|
# |
|
# Revision 1.7 2003/06/03 01:59:39 foxr |
|
# complete coding to support deferred transactions. |
|
# |
|
# |
# |
|
|
|
use strict; |
use lib "/home/httpd/lib/perl/"; |
use lib "/home/httpd/lib/perl/"; |
use lib "/home/foxr/newloncapa/types"; |
|
use Event qw(:DEFAULT ); |
use Event qw(:DEFAULT ); |
use POSIX qw(:signal_h); |
use POSIX qw(:signal_h); |
|
use POSIX; |
use IO::Socket; |
use IO::Socket; |
use IO::Socket::INET; |
use IO::Socket::INET; |
use IO::Socket::UNIX; |
use IO::Socket::UNIX; |
Line 78 use LONCAPA::Configuration;
|
Line 63 use LONCAPA::Configuration;
|
use LONCAPA::HashIterator; |
use LONCAPA::HashIterator; |
|
|
|
|
# |
|
# Disable all signals we might receive from outside for now. |
|
# |
|
$SIG{QUIT} = IGNORE; |
|
$SIG{HUP} = IGNORE; |
|
$SIG{USR1} = IGNORE; |
|
$SIG{INT} = IGNORE; |
|
$SIG{CHLD} = IGNORE; |
|
$SIG{__DIE__} = IGNORE; |
|
|
|
|
|
# Read the httpd configuration file to get perl variables |
# Read the httpd configuration file to get perl variables |
# normally set in apache modules: |
# normally set in apache modules: |
|
|
Line 99 my %perlvar = %{$perlvarref};
|
Line 73 my %perlvar = %{$perlvarref};
|
# parent and shared variables. |
# parent and shared variables. |
|
|
my %ChildHash; # by pid -> host. |
my %ChildHash; # by pid -> host. |
|
my %HostToPid; # By host -> pid. |
|
my %HostHash; # by loncapaname -> IP. |
|
|
|
|
my $MaxConnectionCount = 10; # Will get from config later. |
my $MaxConnectionCount = 10; # Will get from config later. |
my $ClientConnection = 0; # Uniquifier for client events. |
my $ClientConnection = 0; # Uniquifier for client events. |
|
|
my $DebugLevel = 0; |
my $DebugLevel = 0; |
|
my $NextDebugLevel= 2; # So Sigint can toggle this. |
my $IdleTimeout= 3600; # Wait an hour before pruning connections. |
my $IdleTimeout= 3600; # Wait an hour before pruning connections. |
|
|
|
my $LogTransactions = 0; # When True, all transactions/replies get logged. |
|
|
# |
# |
# 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 120 my $WorkQueue = Queue->new(); # Qu
|
Line 99 my $WorkQueue = Queue->new(); # Qu
|
my $ConnectionCount = 0; |
my $ConnectionCount = 0; |
my $IdleSeconds = 0; # Number of seconds idle. |
my $IdleSeconds = 0; # Number of seconds idle. |
my $Status = ""; # Current status string. |
my $Status = ""; # Current status string. |
|
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. |
|
|
# |
# |
# The hash below gives the HTML format for log messages |
# The hash below gives the HTML format for log messages |
Line 134 $LogFormats{"INFO"} = "<font color=y
|
Line 116 $LogFormats{"INFO"} = "<font color=y
|
$LogFormats{"WARNING"} = "<font color=blue>WARNING: %s</font>"; |
$LogFormats{"WARNING"} = "<font color=blue>WARNING: %s</font>"; |
$LogFormats{"DEFAULT"} = " %s "; |
$LogFormats{"DEFAULT"} = " %s "; |
|
|
my $lastlog = ''; # Used for status reporting. |
|
|
|
|
=pod |
|
|
|
=head2 LogPerm |
|
|
|
Makes an entry into the permanent log file. |
|
|
|
=cut |
|
sub LogPerm { |
|
my $message=shift; |
|
my $execdir=$perlvar{'lonDaemons'}; |
|
my $now=time; |
|
my $local=localtime($now); |
|
my $fh=IO::File->new(">>$execdir/logs/lonnet.perm.log"); |
|
print $fh "$now:$message:$local\n"; |
|
} |
|
|
=pod |
=pod |
|
|
Line 179 sub Log {
|
Line 177 sub Log {
|
my $execdir = $perlvar{'lonDaemons'}; |
my $execdir = $perlvar{'lonDaemons'}; |
my $fh = IO::File->new(">>$execdir/logs/lonc.log"); |
my $fh = IO::File->new(">>$execdir/logs/lonc.log"); |
my $msg = sprintf($finalformat, $message); |
my $msg = sprintf($finalformat, $message); |
|
$RecentLogEntry = $msg; |
print $fh $msg; |
print $fh $msg; |
|
|
|
|
} |
} |
|
|
|
|
Line 200 sub GetPeername {
|
Line 200 sub GetPeername {
|
my $peerip; |
my $peerip; |
if($AdrFamily == AF_INET) { |
if($AdrFamily == AF_INET) { |
($peerport, $peerip) = sockaddr_in($peer); |
($peerport, $peerip) = sockaddr_in($peer); |
my $peername = gethostbyaddr($iaddr, $AdrFamily); |
my $peername = gethostbyaddr($peerip, $AdrFamily); |
return $peername; |
return $peername; |
} elsif ($AdrFamily == AF_UNIX) { |
} elsif ($AdrFamily == AF_UNIX) { |
my $peerfile; |
my $peerfile; |
Line 208 sub GetPeername {
|
Line 208 sub GetPeername {
|
return $peerfile; |
return $peerfile; |
} |
} |
} |
} |
#----------------------------- Timer management ------------------------ |
|
=pod |
=pod |
|
|
=head2 Debug |
=head2 Debug |
Line 221 sub Debug {
|
Line 220 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 = $RemoteHost"); |
} |
} |
} |
} |
|
|
Line 238 sub SocketDump {
|
Line 237 sub SocketDump {
|
=head2 ShowStatus |
=head2 ShowStatus |
|
|
Place some text as our pid status. |
Place some text as our pid status. |
|
and as what we return in a SIGUSR1 |
|
|
=cut |
=cut |
sub ShowStatus { |
sub ShowStatus { |
my $status = shift; |
my $state = shift; |
$0 = "lonc: ".$status; |
my $now = time; |
$Status = $status; # Make available for logging. |
my $local = localtime($now); |
|
$Status = $local.": ".$state; |
|
$0='lonc: '.$state.' '.$local; |
|
} |
|
|
|
=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; |
|
Log("WARNING", "A socket timeout was detected"); |
|
Debug(0, " SocketTimeout called: "); |
|
$Socket->Dump(); |
|
if(exists($ActiveTransactions{$Socket})) { |
|
FailTransaction($ActiveTransactions{$Socket}); |
|
} |
|
KillSocket($Socket); # A transaction timeout also counts as |
|
# a connection failure: |
|
$ConnectionRetriesLeft--; |
|
if($ConnectionRetriesLeft <= 0) { |
|
Log("CRITICAL", "Host marked dead: ".GetServerHost()); |
|
} |
|
|
} |
} |
|
#----------------------------- Timer management ------------------------ |
|
|
=pod |
=pod |
|
|
Line 258 Invoked each timer tick.
|
Line 286 Invoked each timer tick.
|
|
|
sub Tick { |
sub Tick { |
my $client; |
my $client; |
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount); |
if($ConnectionRetriesLeft > 0) { |
Debug(6, "Tick"); |
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount |
Debug(6, " Current connection count: ".$ConnectionCount); |
." Retries remaining: ".$ConnectionRetriesLeft); |
foreach $client (keys %ActiveClients) { |
} else { |
Debug(7, " Have client: with id: ".$ActiveClients{$client}); |
ShowStatus(GetServerHost()." >> DEAD <<"); |
} |
} |
# Is it time to prune connection count: |
# Is it time to prune connection count: |
|
|
Line 271 sub Tick {
|
Line 299 sub Tick {
|
($WorkQueue->Count() == 0)) { # Idle connections and nothing to do? |
($WorkQueue->Count() == 0)) { # Idle connections and nothing to do? |
$IdleSeconds++; |
$IdleSeconds++; |
if($IdleSeconds > $IdleTimeout) { # Prune a connection... |
if($IdleSeconds > $IdleTimeout) { # Prune a connection... |
$Socket = $IdleConnections->pop(); |
my $Socket = $IdleConnections->pop(); |
KillSocket($Socket); |
KillSocket($Socket); |
} |
} |
} 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 my $item (keys %ActiveConnections) { |
|
my $State = $ActiveConnections{$item}->data->GetState(); |
|
if ($State ne 'Idle') { |
|
Debug(5,"Ticking Socket $State $item"); |
|
$ActiveConnections{$item}->data->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. |
# |
# |
|
|
my $Requests = $WorkQueue->Count(); |
my $Requests = $WorkQueue->Count(); |
if (($ConnectionCount == 0) && ($Requests > 0)) { |
if (($ConnectionCount == 0) && ($Requests > 0)) { |
my $Connections = ($Requests <= $MaxConnectionCount) ? |
if ($ConnectionRetriesLeft > 0) { |
$Requests : $MaxConnectionCount; |
my $Connections = ($Requests <= $MaxConnectionCount) ? |
Debug(1,"Work but no connections, starting ".$Connections." of them"); |
$Requests : $MaxConnectionCount; |
for ($i =0; $i < $Connections; $i++) { |
Debug(5,"Work but no connections, start ".$Connections." of them"); |
MakeLondConnection(); |
my $successCount = 0; |
|
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"); |
|
EmptyQueue(); # Fail pending transactions with con_lost. |
|
CloseAllLondConnections(); # Should all be closed but.... |
|
} |
|
} else { |
|
ShowStatus(GetServerHost()." >>> DEAD!!! <<<"); |
|
Debug(5,"Work in queue, but gave up on connections..flushing\n"); |
|
EmptyQueue(); # Connections can't be established. |
|
CloseAllLondConnections(); # Should all already be closed but... |
} |
} |
|
|
} |
} |
Line 312 Trigger disconnections of idle sockets.
|
Line 363 Trigger disconnections of idle sockets.
|
|
|
sub SetupTimer { |
sub SetupTimer { |
Debug(6, "SetupTimer"); |
Debug(6, "SetupTimer"); |
Event->timer(interval => 1, debug => 1, cb => \&Tick ); |
Event->timer(interval => 1, cb => \&Tick ); |
} |
} |
|
|
=pod |
=pod |
Line 334 sub ServerToIdle {
|
Line 385 sub ServerToIdle {
|
my $Socket = shift; # Get the socket. |
my $Socket = shift; # Get the socket. |
delete($ActiveTransactions{$Socket}); # Server has no transaction |
delete($ActiveTransactions{$Socket}); # Server has no transaction |
|
|
&Debug(6, "Server to idle"); |
&Debug(5, "Server to idle"); |
|
|
# If there's work to do, start the transaction: |
# If there's work to do, start the transaction: |
|
|
$reqdata = $WorkQueue->dequeue(); # This is a LondTransaction |
my $reqdata = $WorkQueue->dequeue(); # This is a LondTransaction |
unless($reqdata eq undef) { |
if ($reqdata ne undef) { |
Debug(9, "Queue gave request data: ".$reqdata->getRequest()); |
Debug(5, "Queue gave request data: ".$reqdata->getRequest()); |
&StartRequest($Socket, $reqdata); |
&StartRequest($Socket, $reqdata); |
|
|
} else { |
} else { |
|
|
# There's no work waiting, so push the server to idle list. |
# There's no work waiting, so push the server to idle list. |
&Debug(8, "No new work requests, server connection going idle"); |
&Debug(5, "No new work requests, server connection going idle"); |
$IdleConnections->push($Socket); |
$IdleConnections->push($Socket); |
} |
} |
} |
} |
Line 392 sub ClientWritable {
|
Line 443 sub ClientWritable {
|
# request. |
# request. |
|
|
&Debug(9,"Send result is ".$result." Defined: ".defined($result)); |
&Debug(9,"Send result is ".$result." Defined: ".defined($result)); |
if(defined($result)) { |
if($result ne undef) { |
&Debug(9, "send result was defined"); |
&Debug(9, "send result was defined"); |
if($result == length($Data)) { # Entire string sent. |
if($result == length($Data)) { # Entire string sent. |
&Debug(9, "ClientWritable data all written"); |
&Debug(9, "ClientWritable data all written"); |
Line 410 sub ClientWritable {
|
Line 461 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 457 The transaction that is being completed.
|
Line 514 The transaction that is being completed.
|
=cut |
=cut |
|
|
sub CompleteTransaction { |
sub CompleteTransaction { |
&Debug(6,"Complete transaction"); |
&Debug(5,"Complete transaction"); |
my $Socket = shift; |
my $Socket = shift; |
my $Transaction = shift; |
my $Transaction = shift; |
|
|
if (!$Transaction->isDeferred()) { # Normal transaction |
if (!$Transaction->isDeferred()) { # Normal transaction |
my $data = $Socket->GetReply(); # Data to send. |
my $data = $Socket->GetReply(); # Data to send. |
|
if($LogTransactions) { |
|
Log("SUCCESS", "Reply from lond: '$data'"); |
|
} |
StartClientReply($Transaction, $data); |
StartClientReply($Transaction, $data); |
} else { # Delete deferred transaction file. |
} else { # Delete deferred transaction file. |
Log("SUCCESS", "A delayed transaction was completed"); |
Log("SUCCESS", "A delayed transaction was completed"); |
|
LogPerm("S:$Transaction->getClient() :".$Transaction->getRequest()); |
unlink $Transaction->getFile(); |
unlink $Transaction->getFile(); |
} |
} |
} |
} |
|
|
=pod |
=pod |
|
|
=head1 StartClientReply |
=head1 StartClientReply |
|
|
Initiates a reply to a client where the reply data is a parameter. |
Initiates a reply to a client where the reply data is a parameter. |
Line 485 sub CompleteTransaction {
|
Line 548 sub CompleteTransaction {
|
The data to send to apached client. |
The data to send to apached client. |
|
|
=cut |
=cut |
|
|
sub StartClientReply { |
sub StartClientReply { |
my $Transaction = shift; |
my $Transaction = shift; |
my $data = shift; |
my $data = shift; |
|
|
|
|
my $Client = $Transaction->getClient(); |
my $Client = $Transaction->getClient(); |
|
|
&Debug(8," Reply was: ".$data); |
&Debug(8," Reply was: ".$data); |
my $Serial = $ActiveClients{$Client}; |
my $Serial = $ActiveClients{$Client}; |
my $desc = sprintf("Connection to lonc client %d", |
my $desc = sprintf("Connection to lonc client %d", |
|
|
$Serial); |
$Serial); |
Event->io(fd => $Client, |
Event->io(fd => $Client, |
poll => "w", |
poll => "w", |
Line 502 sub StartClientReply {
|
Line 566 sub StartClientReply {
|
cb => \&ClientWritable, |
cb => \&ClientWritable, |
data => $data); |
data => $data); |
} |
} |
|
|
=pod |
=pod |
|
|
=head2 FailTransaction |
=head2 FailTransaction |
|
|
Finishes a transaction with failure because the associated lond socket |
Finishes a transaction with failure because the associated lond socket |
Line 512 sub StartClientReply {
|
Line 578 sub StartClientReply {
|
- The transaction is 'live' in which case we initiate the sending |
- The transaction is 'live' in which case we initiate the sending |
of "con_lost" to the client. |
of "con_lost" to the client. |
|
|
Deleting the transaction means killing it from the |
Deleting the transaction means killing it from the %ActiveTransactions hash. |
%ActiveTransactions hash. |
|
|
|
Parameters: |
Parameters: |
|
|
Line 521 Parameters:
|
Line 586 Parameters:
|
|
|
The LondTransaction we are failing. |
The LondTransaction we are failing. |
|
|
|
|
=cut |
=cut |
|
|
sub FailTransaction { |
sub FailTransaction { |
my $transaction = shift; |
my $transaction = shift; |
my $Lond = $transaction->getServer(); |
Log("WARNING", "Failing transaction ".$transaction->getRequest()); |
if (!$client->isDeferred()) { # If the transaction is deferred we'll get to it. |
Debug(1, "Failing transaction: ".$transaction->getRequest()); |
my $client = $transcation->getClient(); |
if (!$transaction->isDeferred()) { # If the transaction is deferred we'll get to it. |
StartClientReply($client, "con_lost"); |
my $client = $transaction->getClient(); |
|
Debug(1," Replying con_lost to ".$transaction->getRequest()); |
|
StartClientReply($transaction, "con_lost\n"); |
} |
} |
# not needed, done elsewhere if active. |
|
# delete $ActiveTransactions{$Lond}; |
|
|
|
} |
} |
|
|
Line 543 sub FailTransaction {
|
Line 609 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 557 Close all connections open on lond prior
|
Line 624 Close all connections open on lond prior
|
|
|
=cut |
=cut |
sub CloseAllLondConnections { |
sub CloseAllLondConnections { |
foreach $Socket (keys %ActiveConnections) { |
foreach my $Socket (keys %ActiveConnections) { |
KillSocket($Socket); |
if(exists($ActiveTransactions{$Socket})) { |
|
FailTransaction($ActiveTransactions{$Socket}); |
|
} |
|
KillSocket($Socket); |
} |
} |
} |
} |
=cut |
=cut |
Line 588 nonzero if we are allowed to create a ne
|
Line 658 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 601 sub KillSocket {
|
Line 672 sub KillSocket {
|
} |
} |
if(exists($ActiveConnections{$Socket})) { |
if(exists($ActiveConnections{$Socket})) { |
delete($ActiveConnections{$Socket}); |
delete($ActiveConnections{$Socket}); |
|
$ConnectionCount--; |
|
if ($ConnectionCount < 0) { $ConnectionCount = 0; } |
} |
} |
$ConnectionCount--; |
|
|
|
# If the connection count has gone to zero and there is work in the |
# If the connection count has gone to zero and there is work in the |
# 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(); |
|
CloseAllLondConnections; # Should all already be closed but... |
} |
} |
} |
} |
|
|
Line 634 The connection must echo the challenge b
|
Line 706 The connection must echo the challenge b
|
The challenge has been replied to. The we are receiveing the |
The challenge has been replied to. The we are receiveing the |
'ok' from the partner. |
'ok' from the partner. |
|
|
|
=head3 State=ReadingVersionString |
|
|
|
We have requested the lond version and are reading the |
|
version back. Upon completion, we'll store the version away |
|
for future use(?). |
|
|
|
=head3 State=HostSet |
|
|
|
We have selected the domain name of our peer (multhomed hosts) |
|
and are getting the reply (presumably ok) back. |
|
|
=head3 State=RequestingKey |
=head3 State=RequestingKey |
|
|
The ok has been received and we need to send the request for |
The ok has been received and we need to send the request for |
Line 677 sub LondReadable {
|
Line 760 sub LondReadable {
|
my $Socket = $Watcher->data; |
my $Socket = $Watcher->data; |
my $client = undef; |
my $client = undef; |
|
|
&Debug(6,"LondReadable called state = ".$State); |
&Debug(6,"LondReadable called state = ".$Socket->GetState()); |
|
|
|
|
my $State = $Socket->GetState(); # All action depends on the state. |
my $State = $Socket->GetState(); # All action depends on the state. |
|
|
SocketDump(6, $Socket); |
SocketDump(6, $Socket); |
|
my $status = $Socket->Readable(); |
|
|
|
&Debug(2, "Socket->Readable returned: $status"); |
|
|
if($Socket->Readable() != 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 701 sub LondReadable {
|
Line 789 sub LondReadable {
|
$State = $Socket->GetState(); # Update in case of transition. |
$State = $Socket->GetState(); # Update in case of transition. |
&Debug(6, "After read, state is ".$State); |
&Debug(6, "After read, state is ".$State); |
|
|
if($State eq "Initialized") { |
if($State eq "Initialized") { |
|
|
|
|
} elsif ($State eq "ChallengeReceived") { |
} elsif ($State eq "ChallengeReceived") { |
# The challenge must be echoed back; The state machine |
# The challenge must be echoed back; The state machine |
# in the connection takes care of setting that up. Just |
# in the connection takes care of setting that up. Just |
# need to transition to writable: |
# need to transition to writable: |
|
|
$Watcher->cb(\&LondWritable); |
$Watcher->cb(\&LondWritable); |
$Watcher->poll("w"); |
$Watcher->poll("w"); |
|
|
} elsif ($State eq "ChallengeReplied") { |
} elsif ($State eq "ChallengeReplied") { |
|
|
|
} elsif ($State eq "RequestingVersion") { |
|
# Need to ask for the version... that is writiability: |
|
|
|
$Watcher->cb(\&LondWritable); |
|
$Watcher->poll("w"); |
|
|
|
} elsif ($State eq "ReadingVersionString") { |
|
# Read the rest of the version string... |
|
} elsif ($State eq "SetHost") { |
|
# Need to request the actual domain get set... |
|
|
|
$Watcher->cb(\&LondWritable); |
|
$Watcher->poll("w"); |
|
} elsif ($State eq "HostSet") { |
|
# Reading the 'ok' from the peer. |
|
|
} elsif ($State eq "RequestingKey") { |
} elsif ($State eq "RequestingKey") { |
# The ok was received. Now we need to request the key |
# The ok was received. Now we need to request the key |
Line 725 sub LondReadable {
|
Line 828 sub LondReadable {
|
} elsif ($State eq "ReceivingKey") { |
} elsif ($State eq "ReceivingKey") { |
|
|
} elsif ($State eq "Idle") { |
} elsif ($State eq "Idle") { |
|
|
|
# This is as good a spot as any to get the peer version |
|
# string: |
|
|
|
if($LondVersion eq "unknown") { |
|
$LondVersion = $Socket->PeerVersion(); |
|
Log("INFO", "Connected to lond version: $LondVersion"); |
|
} |
# 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(5,"Completing transaction!!"); |
CompleteTransaction($Socket, |
CompleteTransaction($Socket, |
$ActiveTransactions{$Socket}); |
$ActiveTransactions{$Socket}); |
} else { |
} else { |
Line 750 sub LondReadable {
|
Line 865 sub LondReadable {
|
|
|
|
|
} else { |
} else { |
# Invalid state. |
# Invalid state. |
Debug(4, "Invalid state in LondReadable"); |
Debug(4, "Invalid state in LondReadable"); |
} |
} |
} |
} |
Line 832 sub LondWritable {
|
Line 947 sub LondWritable {
|
|
|
SocketDump(6,$Socket); |
SocketDump(6,$Socket); |
|
|
|
# If the socket is writable, we must always write. |
|
# Only by writing will we undergo state transitions. |
|
# Old logic wrote in state specific code below, however |
|
# That forces us at least through another invocation of |
|
# this function after writability is possible again. |
|
# This logic also factors out common code for handling |
|
# write failures... in all cases, write failures |
|
# Kill the socket. |
|
# This logic makes the branches of the >big< if below |
|
# so that the writing states are actually NO-OPs. |
|
|
|
if ($Socket->Writable() != 0) { |
|
# The write resulted in an error. |
|
# We'll treat this as if the socket got disconnected: |
|
Log("WARNING", "Connection to ".$RemoteHost. |
|
" has been disconnected"); |
|
if(exists($ActiveTransactions{$Socket})) { |
|
FailTransaction($ActiveTransactions{$Socket}); |
|
} |
|
$Watcher->cancel(); |
|
KillSocket($Socket); |
|
return; |
|
} |
|
|
|
|
|
|
if ($State eq "Connected") { |
if ($State eq "Connected") { |
|
|
if ($Socket->Writable() != 0) { |
|
# The write resulted in an error. |
|
# We'll treat this as if the socket got disconnected: |
|
Log("WARNING", "Connection to ".$RemoteHost. |
|
" has been disconnected"); |
|
$Watcher->cancel(); |
|
KillSocket($Socket); |
|
return; |
|
} |
|
# "init" is being sent... |
# "init" is being sent... |
|
|
|
|
} elsif ($State eq "Initialized") { |
} elsif ($State eq "Initialized") { |
|
|
# Now that init was sent, we switch |
# Now that init was sent, we switch |
Line 853 sub LondWritable {
|
Line 984 sub LondWritable {
|
|
|
$Watcher->cb(\&LondReadable); |
$Watcher->cb(\&LondReadable); |
$Watcher->poll("r"); |
$Watcher->poll("r"); |
|
|
} elsif ($State eq "ChallengeReceived") { |
} elsif ($State eq "ChallengeReceived") { |
# We received the challenge, now we |
# We received the challenge, now we |
# are echoing it back. This is a no-op, |
# are echoing it back. This is a no-op, |
# we're waiting for the state to change |
# we're waiting for the state to change |
|
|
if($Socket->Writable() != 0) { |
|
|
|
$Watcher->cancel(); |
|
KillSocket($Socket); |
|
return; |
|
} |
|
|
|
} elsif ($State eq "ChallengeReplied") { |
} elsif ($State eq "ChallengeReplied") { |
# The echo was sent back, so we switch |
# The echo was sent back, so we switch |
# to watching readability. |
# to watching readability. |
|
|
$Watcher->cb(\&LondReadable); |
$Watcher->cb(\&LondReadable); |
$Watcher->poll("r"); |
$Watcher->poll("r"); |
|
} elsif ($State eq "RequestingVersion") { |
|
# Sending the peer a version request... |
|
|
|
} elsif ($State eq "ReadingVersionString") { |
|
# Transition to read since we have sent the |
|
# version command and now just need to read the |
|
# version string from the peer: |
|
|
|
$Watcher->cb(\&LondReadable); |
|
$Watcher->poll("r"); |
|
|
|
} elsif ($State eq "SetHost") { |
|
# Setting the remote domain... |
|
|
|
} elsif ($State eq "HostSet") { |
|
# Back to readable to get the ok. |
|
|
|
$Watcher->cb(\&LondReadable); |
|
$Watcher->poll("r"); |
|
|
|
|
} elsif ($State eq "RequestingKey") { |
} elsif ($State eq "RequestingKey") { |
# At this time we're requesting the key. |
# At this time we're requesting the key. |
# again, this is essentially a no-op. |
# again, this is essentially a no-op. |
# we'll write the next chunk until the |
|
# state changes. |
|
|
|
if($Socket->Writable() != 0) { |
|
# Write resulted in an error. |
|
|
|
$Watcher->cancel(); |
|
KillSocket($Socket); |
|
return; |
|
|
|
} |
|
} elsif ($State eq "ReceivingKey") { |
} elsif ($State eq "ReceivingKey") { |
# Now we need to wait for the key |
# Now we need to wait for the key |
# to come back from the peer: |
# to come back from the peer: |
Line 895 sub LondWritable {
|
Line 1029 sub LondWritable {
|
$Watcher->poll("r"); |
$Watcher->poll("r"); |
|
|
} elsif ($State eq "SendingRequest") { |
} elsif ($State eq "SendingRequest") { |
|
|
# At this time we are sending a request to the |
# At this time we are sending a request to the |
# peer... write the next chunk: |
# peer... write the next chunk: |
|
|
if($Socket->Writable() != 0) { |
|
|
|
if(exists($ActiveTransactions{$Socket})) { |
|
Debug(3, "Lond connection lost, failing transactions"); |
|
FailTransaction($ActiveTransactions{$Socket}); |
|
} |
|
$Watcher->cancel(); |
|
KillSocket($Socket); |
|
return; |
|
|
|
} |
|
|
|
} elsif ($State eq "ReceivingReply") { |
} elsif ($State eq "ReceivingReply") { |
# The send has completed. Wait for the |
# The send has completed. Wait for the |
Line 938 sub QueueDelayed {
|
Line 1062 sub QueueDelayed {
|
Debug(4, "Delayed path: ".$path); |
Debug(4, "Delayed path: ".$path); |
opendir(DIRHANDLE, $path); |
opendir(DIRHANDLE, $path); |
|
|
@alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE; |
my @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE; |
Debug(4, "Got ".$alldelayed." delayed files"); |
|
closedir(DIRHANDLE); |
closedir(DIRHANDLE); |
my $dfname; |
my $dfname; |
my $reqfile; |
my $reqfile; |
Line 949 sub QueueDelayed {
|
Line 1072 sub QueueDelayed {
|
my $Handle = IO::File->new($reqfile); |
my $Handle = IO::File->new($reqfile); |
my $cmd = <$Handle>; |
my $cmd = <$Handle>; |
chomp $cmd; # There may or may not be a newline... |
chomp $cmd; # There may or may not be a newline... |
$cmd = $cmd."\ny"; # now for sure there's exactly one newline. |
$cmd = $cmd."\n"; # now for sure there's exactly one newline. |
my $Transaction = LondTransaction->new($cmd); |
my $Transaction = LondTransaction->new($cmd); |
$Transaction->SetDeferred($reqfile); |
$Transaction->SetDeferred($reqfile); |
QueueTransaction($Transaction); |
QueueTransaction($Transaction); |
Line 976 sub MakeLondConnection {
|
Line 1099 sub MakeLondConnection {
|
my $Connection = LondConnection->new(&GetServerHost(), |
my $Connection = LondConnection->new(&GetServerHost(), |
&GetServerPort()); |
&GetServerPort()); |
|
|
if($Connection == undef) { # Needs to be more robust later. |
if($Connection eq undef) { # Needs to be more robust later. |
Log("CRITICAL","Failed to make a connection with lond."); |
Log("CRITICAL","Failed to make a connection with lond."); |
|
$ConnectionRetriesLeft--; |
|
return 0; # Failure. |
} else { |
} else { |
|
|
# 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 |
# exchange underway. |
# exchange underway. |
# |
# |
my $Socket = $Connection->GetSocket(); |
my $Socket = $Connection->GetSocket(); |
if($Socket == undef) { |
if($Socket eq undef) { |
die "did not get a socket from the connection"; |
die "did not get a socket from the connection"; |
} else { |
} else { |
&Debug(9,"MakeLondConnection got socket: ".$Socket); |
&Debug(9,"MakeLondConnection got socket: ".$Socket); |
} |
} |
|
|
|
$Connection->SetTimeoutCallback(\&SocketTimeout); |
$event = Event->io(fd => $Socket, |
|
|
my $event = Event->io(fd => $Socket, |
poll => 'w', |
poll => 'w', |
cb => \&LondWritable, |
cb => \&LondWritable, |
data => $Connection, |
data => $Connection, |
Line 1006 sub MakeLondConnection {
|
Line 1133 sub MakeLondConnection {
|
} |
} |
Log("SUCESS", "Created connection ".$ConnectionCount |
Log("SUCESS", "Created connection ".$ConnectionCount |
." to host ".GetServerHost()); |
." to host ".GetServerHost()); |
|
return 1; # Return success. |
} |
} |
|
|
} |
} |
Line 1047 sub StartRequest {
|
Line 1175 sub StartRequest {
|
$ActiveTransactions{$Lond} = $Request; |
$ActiveTransactions{$Lond} = $Request; |
|
|
$Lond->InitiateTransaction($Request->getRequest()); |
$Lond->InitiateTransaction($Request->getRequest()); |
$event = Event->io(fd => $Socket, |
my $event = Event->io(fd => $Socket, |
poll => "w", |
poll => "w", |
cb => \&LondWritable, |
cb => \&LondWritable, |
data => $Lond, |
data => $Lond, |
Line 1086 sub QueueTransaction {
|
Line 1214 sub QueueTransaction {
|
|
|
my $LondSocket = $IdleConnections->pop(); |
my $LondSocket = $IdleConnections->pop(); |
if(!defined $LondSocket) { # Need to queue request. |
if(!defined $LondSocket) { # Need to queue request. |
Debug(8,"Must queue..."); |
Debug(5,"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(5,"Starting additional lond connection"); |
|
if(MakeLondConnection() == 0) { |
|
EmptyQueue(); # Fail transactions, can't make connection. |
|
CloseAllLondConnections; # Should all be closed but... |
|
} |
|
} else { |
|
ShowStatus(GetServerHost()." >>> DEAD !!!! <<<"); |
|
EmptyQueue(); # It's worse than that ... he's dead Jim. |
|
CloseAllLondConnections; # Should all be closed but.. |
|
} |
} |
} |
} else { # Can start the request: |
} else { # Can start the request: |
Debug(8,"Can start..."); |
Debug(8,"Can start..."); |
Line 1103 sub QueueTransaction {
|
Line 1240 sub QueueTransaction {
|
=pod |
=pod |
|
|
=head2 ClientRequest |
=head2 ClientRequest |
|
|
Callback that is called when data can be read from the UNIX domain |
Callback that is called when data can be read from the UNIX domain |
socket connecting us with an apache server process. |
socket connecting us with an apache server process. |
|
|
Line 1122 sub ClientRequest {
|
Line 1258 sub ClientRequest {
|
my $rv = $socket->recv($thisread, POSIX::BUFSIZ, 0); |
my $rv = $socket->recv($thisread, POSIX::BUFSIZ, 0); |
Debug(8, "rcv: data length = ".length($thisread) |
Debug(8, "rcv: data length = ".length($thisread) |
." read =".$thisread); |
." read =".$thisread); |
unless (defined $rv && length($thisread)) { |
unless (defined $rv && length($thisread)) { |
# Likely eof on socket. |
# Likely eof on socket. |
Debug(5,"Client Socket closed on lonc for ".$RemoteHost); |
Debug(5,"Client Socket closed on lonc for ".$RemoteHost); |
close($socket); |
close($socket); |
$watcher->cancel(); |
$watcher->cancel(); |
delete($ActiveClients{$socket}); |
delete($ActiveClients{$socket}); |
|
return; |
} |
} |
Debug(8,"Data: ".$data." this read: ".$thisread); |
Debug(8,"Data: ".$data." this read: ".$thisread); |
$data = $data.$thisread; # Append new data. |
$data = $data.$thisread; # Append new data. |
$watcher->data($data); |
$watcher->data($data); |
if($data =~ /(.*\n)/) { # Request entirely read. |
if($data =~ /(.*\n)/) { # Request entirely read. |
if($data == "close_connection_exit\n") { |
if($data eq "close_connection_exit\n") { |
Log("CRITICAL", |
Log("CRITICAL", |
"Request Close Connection ... exiting"); |
"Request Close Connection ... exiting"); |
CloseAllLondConnections(); |
CloseAllLondConnections(); |
exit; |
exit; |
} |
} |
Debug(8, "Complete transaction received: ".$data); |
Debug(8, "Complete transaction received: ".$data); |
|
if($LogTransactions) { |
|
Log("SUCCESS", "Transaction: '$data'"); # Transaction has \n. |
|
} |
my $Transaction = LondTransaction->new($data); |
my $Transaction = LondTransaction->new($data); |
$Transaction->SetClient($socket); |
$Transaction->SetClient($socket); |
QueueTransaction($Transaction); |
QueueTransaction($Transaction); |
Line 1248 sub SetupLoncListener {
|
Line 1388 sub SetupLoncListener {
|
fd => $socket); |
fd => $socket); |
} |
} |
|
|
|
# |
|
# Toggle transaction logging. |
|
# Implicit inputs: |
|
# LogTransactions |
|
# Implicit Outputs: |
|
# LogTransactions |
|
sub ToggleTransactionLogging { |
|
print STDERR "Toggle transaction logging...\n"; |
|
if(!$LogTransactions) { |
|
$LogTransactions = 1; |
|
} else { |
|
$LogTransactions = 0; |
|
} |
|
|
|
|
|
Log("SUCCESS", "Toggled transaction logging: $LogTransactions \n"); |
|
} |
|
|
|
=pod |
|
|
|
=head2 ChildStatus |
|
|
|
Child USR1 signal handler to report the most recent status |
|
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; |
|
|
|
Debug(2, "Reporting child status because : ".$watcher->data); |
|
my $docdir = $perlvar{'lonDocRoot'}; |
|
my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt"); |
|
print $fh $$."\t".$RemoteHost."\t".$Status."\t". |
|
$RecentLogEntry."\n"; |
|
# |
|
# 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++; |
|
} |
|
$ConnectionRetriesLeft = $ConnectionRetries; |
|
} |
|
|
=pod |
=pod |
|
|
|
=head2 SignalledToDeath |
|
|
|
Called in response to a signal that causes a chid process to die. |
|
|
|
=cut |
|
|
|
|
|
sub SignalledToDeath { |
|
my $event = shift; |
|
my $watcher= $event->w; |
|
|
|
Debug(2,"Signalled to death! via ".$watcher->data); |
|
my ($signal) = $watcher->data; |
|
chomp($signal); |
|
Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost " |
|
."died through "."\"$signal\""); |
|
LogPerm("F:lonc: $$ on $RemoteHost signalled to death: " |
|
."\"$signal\""); |
|
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 1259 This sub implements a child process for
|
Line 1490 This sub implements a child process for
|
sub ChildProcess { |
sub ChildProcess { |
|
|
|
|
# For now turn off signals. |
# |
|
# Signals must be handled by the Event framework... |
$SIG{QUIT} = IGNORE; |
# |
$SIG{HUP} = IGNORE; |
|
$SIG{USR1} = IGNORE; |
Event->signal(signal => "QUIT", |
$SIG{INT} = IGNORE; |
cb => \&SignalledToDeath, |
$SIG{CHLD} = IGNORE; |
data => "QUIT"); |
$SIG{__DIE__} = IGNORE; |
Event->signal(signal => "HUP", |
|
cb => \&ChildStatus, |
|
data => "HUP"); |
|
Event->signal(signal => "USR1", |
|
cb => \&ChildStatus, |
|
data => "USR1"); |
|
Event->signal(signal => "USR2", |
|
cb => \&ToggleTransactionLogging); |
|
Event->signal(signal => "INT", |
|
cb => \&ToggleDebug, |
|
data => "INT"); |
|
|
SetupTimer(); |
SetupTimer(); |
|
|
Line 1278 sub ChildProcess {
|
Line 1519 sub ChildProcess {
|
|
|
# Setup the initial server connection: |
# Setup the initial server connection: |
|
|
&MakeLondConnection(); |
# &MakeLondConnection(); // let first work requirest do it. |
|
|
|
|
if($ConnectionCount == 0) { |
|
Debug(1,"Could not make initial connection..\n"); |
|
Debug(1,"Will retry when there's work to do\n"); |
|
} |
|
Debug(9,"Entering event loop"); |
Debug(9,"Entering event loop"); |
my $ret = Event::loop(); # Start the main event loop. |
my $ret = Event::loop(); # Start the main event loop. |
|
|
Line 1294 sub ChildProcess {
|
Line 1532 sub ChildProcess {
|
# Create a new child for host passed in: |
# Create a new child for host passed in: |
|
|
sub CreateChild { |
sub CreateChild { |
|
my $sigset = POSIX::SigSet->new(SIGINT); |
|
sigprocmask(SIG_BLOCK, $sigset); |
my $host = shift; |
my $host = shift; |
$RemoteHost = $host; |
$RemoteHost = $host; |
Log("CRITICAL", "Forking server for ".$host); |
Log("CRITICAL", "Forking server for ".$host); |
$pid = fork; |
my $pid = fork; |
if($pid) { # Parent |
if($pid) { # Parent |
$ChildHash{$pid} = $RemoteHost; |
$RemoteHost = "Parent"; |
|
$ChildHash{$pid} = $host; |
|
$HostToPid{$host}= $pid; |
|
sigprocmask(SIG_UNBLOCK, $sigset); |
|
|
} else { # child. |
} else { # child. |
ShowStatus("Connected to ".$RemoteHost); |
ShowStatus("Connected to ".$RemoteHost); |
ChildProcess; |
$SIG{INT} = 'DEFAULT'; |
|
sigprocmask(SIG_UNBLOCK, $sigset); |
|
ChildProcess; # Does not return. |
} |
} |
|
|
} |
} |
Line 1337 if ($childpid != 0) {
|
Line 1583 if ($childpid != 0) {
|
# |
# |
|
|
ShowStatus("Parent writing pid file:"); |
ShowStatus("Parent writing pid file:"); |
$execdir = $perlvar{'lonDaemons'}; |
my $execdir = $perlvar{'lonDaemons'}; |
open (PIDSAVE, ">$execdir/logs/lonc.pid"); |
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 1351 ShowStatus("Forking node servers");
|
Line 1599 ShowStatus("Forking node servers");
|
|
|
Log("CRITICAL", "--------------- Starting children ---------------"); |
Log("CRITICAL", "--------------- Starting children ---------------"); |
|
|
|
LondConnection::ReadConfig; # Read standard config files. |
my $HostIterator = LondConnection::GetHostIterator; |
my $HostIterator = LondConnection::GetHostIterator; |
while (! $HostIterator->end()) { |
while (! $HostIterator->end()) { |
|
|
$hostentryref = $HostIterator->get(); |
my $hostentryref = $HostIterator->get(); |
CreateChild($hostentryref->[0]); |
CreateChild($hostentryref->[0]); |
|
$HostHash{$hostentryref->[0]} = $hostentryref->[4]; |
$HostIterator->next(); |
$HostIterator->next(); |
} |
} |
|
$RemoteHost = "Parent Server"; |
|
|
# Maintain the population: |
# Maintain the population: |
|
|
ShowStatus("Parent keeping the flock"); |
ShowStatus("Parent keeping the flock"); |
|
|
|
# |
|
# Set up parent signals: |
|
# |
|
|
|
$SIG{INT} = \&Terminate; |
|
$SIG{TERM} = \&Terminate; |
|
$SIG{HUP} = \&Restart; |
|
$SIG{USR1} = \&CheckKids; |
|
$SIG{USR2} = \&UpdateKids; # LonManage update request. |
|
|
while(1) { |
while(1) { |
$deadchild = wait(); |
my $deadchild = wait(); |
if(exists $ChildHash{$deadchild}) { # need to restart. |
if(exists $ChildHash{$deadchild}) { # need to restart. |
$deadhost = $ChildHash{$deadchild}; |
my $deadhost = $ChildHash{$deadchild}; |
|
delete($HostToPid{$deadhost}); |
delete($ChildHash{$deadchild}); |
delete($ChildHash{$deadchild}); |
Log("WARNING","Lost child pid= ".$deadchild. |
Log("WARNING","Lost child pid= ".$deadchild. |
"Connected to host ".$deadhost); |
"Connected to host ".$deadhost); |
Line 1375 while(1) {
|
Line 1637 while(1) {
|
} |
} |
} |
} |
|
|
|
|
|
|
|
=pod |
|
|
|
=head1 CheckKids |
|
|
|
Since kids do not die as easily in this implementation |
|
as the previous one, there is no need to restart the |
|
dead ones (all dead kids get restarted when they die!!) |
|
The only thing this function does is to pass USR1 to the |
|
kids so that they report their status. |
|
|
|
=cut |
|
|
|
sub CheckKids { |
|
Debug(2, "Checking status of children"); |
|
my $docdir = $perlvar{'lonDocRoot'}; |
|
my $fh = IO::File->new(">$docdir/lon-status/loncstatus.txt"); |
|
my $now=time; |
|
my $local=localtime($now); |
|
print $fh "LONC status $local - parent $$ \n\n"; |
|
foreach my $pid (keys %ChildHash) { |
|
Debug(2, "Sending USR1 -> $pid"); |
|
kill 'USR1' => $pid; # Tell Child to report status. |
|
sleep 1; # Wait so file doesn't intermix. |
|
} |
|
} |
|
|
|
=pod |
|
|
|
=head1 UpdateKids |
|
|
|
parent's SIGUSR2 handler. This handler: |
|
|
|
=item |
|
|
|
Rereads the hosts file. |
|
|
|
=item |
|
|
|
Kills off (via sigint) children for hosts that have disappeared. |
|
|
|
=item |
|
|
|
QUITs children for hosts that already exist (this just forces a status display |
|
and resets the connection retry count for that host. |
|
|
|
=item |
|
|
|
Starts new children for hosts that have been added to the hosts.tab file since |
|
the start of the master program and maintains them. |
|
|
|
=cut |
|
|
|
sub UpdateKids { |
|
|
|
Log("INFO", "Updating connections via SIGUSR2"); |
|
|
|
# Just in case we need to kill our own lonc, we wait a few seconds to |
|
# give it a chance to receive and relay lond's response to the |
|
# re-init command. |
|
# |
|
|
|
sleep(2); # Wait a couple of seconds. |
|
|
|
my %hosts; # Indexed by loncapa hostname, value=ip. |
|
|
|
# Need to re-read the host table: |
|
|
|
|
|
LondConnection::ReadConfig(); |
|
my $I = LondConnection::GetHostIterator; |
|
while (! $I->end()) { |
|
my $item = $I->get(); |
|
$hosts{$item->[0]} = $item->[4]; |
|
$I->next(); |
|
} |
|
|
|
# The logic below is written for clarity not for efficiency. |
|
# Since I anticipate that this function is only rarely called, that's |
|
# appropriate. There are certainly ways to combine the loops below, |
|
# and anyone wishing to obscure the logic is welcome to go for it. |
|
# Note that we don't re-direct sigchild. Instead we do what's needed |
|
# to the data structures that keep track of children to ensure that |
|
# when sigchild is honored, no new child is born. |
|
# |
|
|
|
# For each existing child; if it's host doesn't exist, kill the child. |
|
|
|
foreach my $child (keys %ChildHash) { |
|
my $oldhost = $ChildHash{$child}; |
|
if (!(exists $hosts{$oldhost})) { |
|
Log("CRITICAL", "Killing child for $oldhost host no longer exists"); |
|
delete $ChildHash{$child}; |
|
delete $HostToPid{$oldhost}; |
|
kill 'QUIT' => $child; |
|
} |
|
} |
|
# For each remaining existing child; if it's host's ip has changed, |
|
# Restart the child on the new IP. |
|
|
|
foreach my $child (keys %ChildHash) { |
|
my $oldhost = $ChildHash{$child}; |
|
my $oldip = $HostHash{$oldhost}; |
|
if ($hosts{$oldhost} ne $oldip) { |
|
|
|
# kill the old child. |
|
|
|
Log("CRITICAL", "Killing child for $oldhost host ip has changed..."); |
|
delete $ChildHash{$child}; |
|
delete $HostToPid{$oldhost}; |
|
kill 'QUIT' => $child; |
|
|
|
# Do the book-keeping needed to start a new child on the |
|
# new ip. |
|
|
|
$HostHash{$oldhost} = $hosts{$oldhost}; |
|
CreateChild($oldhost); |
|
} |
|
} |
|
# Finally, for each new host, not in the host hash, create a |
|
# enter the host and create a new child. |
|
# Force a status display of any existing process. |
|
|
|
foreach my $host (keys %hosts) { |
|
if(!(exists $HostHash{$host})) { |
|
Log("INFO", "New host $host discovered in hosts.tab..."); |
|
$HostHash{$host} = $hosts{$host}; |
|
CreateChild($host); |
|
} else { |
|
kill 'HUP' => $HostToPid{$host}; # status display. |
|
} |
|
} |
|
} |
|
|
|
|
|
=pod |
|
|
|
=head1 Restart |
|
|
|
Signal handler for HUP... all children are killed and |
|
we self restart. This is an el-cheapo way to re read |
|
the config file. |
|
|
|
=cut |
|
|
|
sub Restart { |
|
&KillThemAll; # First kill all the children. |
|
Log("CRITICAL", "Restarting"); |
|
my $execdir = $perlvar{'lonDaemons'}; |
|
unlink("$execdir/logs/lonc.pid"); |
|
exec("$execdir/loncnew"); |
|
} |
|
|
|
=pod |
|
|
|
=head1 KillThemAll |
|
|
|
Signal handler that kills all children by sending them a |
|
SIGHUP. Responds to sigint and sigterm. |
|
|
|
=cut |
|
|
|
sub KillThemAll { |
|
Debug(2, "Kill them all!!"); |
|
local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die. |
|
foreach my $pid (keys %ChildHash) { |
|
my $serving = $ChildHash{$pid}; |
|
Debug(2, "Killing lonc for $serving pid = $pid"); |
|
ShowStatus("Killing lonc for $serving pid = $pid"); |
|
Log("CRITICAL", "Killing lonc for $serving pid = $pid"); |
|
kill 'QUIT' => $pid; |
|
delete($ChildHash{$pid}); |
|
} |
|
my $execdir = $perlvar{'lonDaemons'}; |
|
unlink("$execdir/logs/lonc.pid"); |
|
|
|
} |
|
|
|
=pod |
|
|
|
=head1 Terminate |
|
|
|
Terminate the system. |
|
|
|
=cut |
|
|
|
sub Terminate { |
|
KillThemAll; |
|
Log("CRITICAL","Master process exiting"); |
|
exit 0; |
|
|
|
} |
|
=pod |
|
|
=head1 Theory |
=head1 Theory |
|
|
The event class is used to build this as a single process with an |
The event class is used to build this as a single process with an |