|
version 1.17, 2003/08/03 00:44:31
|
version 1.39, 2004/01/13 09:57:18
|
|
Line 35
|
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.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 |
|
| # Get all of the signals to work correctly. |
|
| # |
|
| # Revision 1.13 2003/07/02 01:31:55 foxr |
|
| # Added kill -HUP logic (restart). |
|
| # |
|
| # Revision 1.11 2003/06/25 01:54:44 foxr |
|
| # Fix more problems with transaction failure. |
|
| # |
|
| # Revision 1.10 2003/06/24 02:46:04 foxr |
|
| # 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 |
|
| # going or else 6the client will permanently give up on dead servers. |
|
| # |
|
| # 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 POSIX; |
|
Line 112 use LONCAPA::HashIterator;
|
Line 66 use LONCAPA::HashIterator;
|
| # |
# |
| # Disable all signals we might receive from outside for now. |
# 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 |
|
Line 130 my %perlvar = %{$perlvarref};
|
Line 78 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= 10; # So Sigint can toggle this. |
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 153 my $ConnectionCount = 0;
|
Line 105 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 $RecentLogEntry = ""; |
| my $ConnectionRetries=5; # Number of connection retries allowed. |
my $ConnectionRetries=2; # Number of connection retries allowed. |
| my $ConnectionRetriesLeft=5; # Number of connection retries remaining. |
my $ConnectionRetriesLeft=2; # Number of connection retries remaining. |
| |
|
| # |
# |
| # The hash below gives the HTML format for log messages |
# The hash below gives the HTML format for log messages |
|
Line 252 sub GetPeername {
|
Line 204 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 260 sub GetPeername {
|
Line 212 sub GetPeername {
|
| return $peerfile; |
return $peerfile; |
| } |
} |
| } |
} |
| #----------------------------- Timer management ------------------------ |
|
| =pod |
=pod |
| |
|
| =head2 Debug |
=head2 Debug |
|
Line 273 sub Debug {
|
Line 224 sub Debug {
|
| my $level = shift; |
my $level = shift; |
| my $message = shift; |
my $message = shift; |
| if ($level <= $DebugLevel) { |
if ($level <= $DebugLevel) { |
| Log("INFO", "-Debug- $message host = $RemotHost"); |
Log("INFO", "-Debug- $message host = $RemoteHost"); |
| } |
} |
| } |
} |
| |
|
|
Line 312 sub ShowStatus {
|
Line 263 sub ShowStatus {
|
| =cut |
=cut |
| sub SocketTimeout { |
sub SocketTimeout { |
| my $Socket = shift; |
my $Socket = shift; |
| |
Log("WARNING", "A socket timeout was detected"); |
| KillSocket($Socket); |
Debug(0, " SocketTimeout called: "); |
| |
$Socket->Dump(); |
| |
KillSocket($Socket); # A transaction timeout also counts as |
| |
# a connection failure: |
| |
$ConnectionRetriesLeft--; |
| } |
} |
| |
#----------------------------- Timer management ------------------------ |
| |
|
| =pod |
=pod |
| |
|
|
Line 327 Invoked each timer tick.
|
Line 283 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 336 sub Tick {
|
Line 296 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 { |
|
Line 345 sub Tick {
|
Line 305 sub Tick {
|
| # |
# |
| # For each inflight transaction, tick down its timeout counter. |
# For each inflight transaction, tick down its timeout counter. |
| # |
# |
| foreach $item (keys %ActiveTransactions) { |
|
| my $Socket = $ActiveTransactions{$item}->getServer(); |
foreach my $item (keys %ActiveConnections) { |
| $Socket->Tick(); |
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. |
|
Line 358 sub Tick {
|
Line 322 sub Tick {
|
| if ($ConnectionRetriesLeft > 0) { |
if ($ConnectionRetriesLeft > 0) { |
| my $Connections = ($Requests <= $MaxConnectionCount) ? |
my $Connections = ($Requests <= $MaxConnectionCount) ? |
| $Requests : $MaxConnectionCount; |
$Requests : $MaxConnectionCount; |
| Debug(1,"Work but no connections, start ".$Connections." of them"); |
Debug(5,"Work but no connections, start ".$Connections." of them"); |
| for ($i =0; $i < $Connections; $i++) { |
my $successCount = 0; |
| MakeLondConnection(); |
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. |
| } |
} |
| } else { |
} else { |
| Debug(1,"Work in queue, but gave up on connections..flushing\n"); |
ShowStatus(GetServerHost()." >>> DEAD!!! <<<"); |
| |
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 388 Trigger disconnections of idle sockets.
|
Line 358 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 410 sub ServerToIdle {
|
Line 380 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 468 sub ClientWritable {
|
Line 438 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 539 The transaction that is being completed.
|
Line 509 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:$Client:".$Transaction->getRequest()); |
LogPerm("S:$Transaction->getClient() :".$Transaction->getRequest()); |
| unlink $Transaction->getFile(); |
unlink $Transaction->getFile(); |
| } |
} |
| } |
} |
|
Line 578 sub StartClientReply {
|
Line 551 sub StartClientReply {
|
| &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 616 sub FailTransaction {
|
Line 588 sub FailTransaction {
|
| 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 627 sub FailTransaction {
|
Line 602 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 641 Close all connections open on lond prior
|
Line 617 Close all connections open on lond prior
|
| |
|
| =cut |
=cut |
| sub CloseAllLondConnections { |
sub CloseAllLondConnections { |
| foreach $Socket (keys %ActiveConnections) { |
foreach my $Socket (keys %ActiveConnections) { |
| KillSocket($Socket); |
KillSocket($Socket); |
| } |
} |
| } |
} |
|
Line 686 sub KillSocket {
|
Line 662 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(); |
| } |
} |
| } |
} |
| |
|
|
Line 762 sub LondReadable {
|
Line 738 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. |
|
Line 783 sub LondReadable {
|
Line 759 sub LondReadable {
|
| } |
} |
| $Watcher->cancel(); |
$Watcher->cancel(); |
| KillSocket($Socket); |
KillSocket($Socket); |
| |
$ConnectionRetriesLeft--; # Counts as connection failure |
| return; |
return; |
| } |
} |
| SocketDump(6,$Socket); |
SocketDump(6,$Socket); |
|
Line 816 sub LondReadable {
|
Line 793 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(5,"Completing transaction!!"); |
| CompleteTransaction($Socket, |
CompleteTransaction($Socket, |
| $ActiveTransactions{$Socket}); |
$ActiveTransactions{$Socket}); |
| } else { |
} else { |
|
Line 928 sub LondWritable {
|
Line 909 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 1027 sub QueueDelayed {
|
Line 1009 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 1065 sub MakeLondConnection {
|
Line 1046 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--; |
$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 |
| # 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 1140 sub StartRequest {
|
Line 1122 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 1179 sub QueueTransaction {
|
Line 1161 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) { |
| if(MakeLondConnection() == 0) { |
Debug(5,"Starting additional lond connection"); |
| EmptyQueue(); # Fail transactions, can't make 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: |
|
Line 1216 sub ClientRequest {
|
Line 1203 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); |
|
Line 1235 sub ClientRequest {
|
Line 1222 sub ClientRequest {
|
| 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 1343 sub SetupLoncListener {
|
Line 1333 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 |
=pod |
| |
|
| =head2 ChildStatus |
=head2 ChildStatus |
|
Line 1350 sub SetupLoncListener {
|
Line 1358 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 1360 sub ChildStatus {
|
Line 1370 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"; |
| |
# |
| |
# 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 |
|
Line 1423 sub ChildProcess {
|
Line 1448 sub ChildProcess {
|
| Event->signal(signal => "USR1", |
Event->signal(signal => "USR1", |
| cb => \&ChildStatus, |
cb => \&ChildStatus, |
| data => "USR1"); |
data => "USR1"); |
| |
Event->signal(signal => "USR2", |
| |
cb => \&ToggleTransactionLogging); |
| Event->signal(signal => "INT", |
Event->signal(signal => "INT", |
| cb => \&ToggleDebug, |
cb => \&ToggleDebug, |
| data => "INT"); |
data => "INT"); |
|
Line 1455 sub CreateChild {
|
Line 1482 sub CreateChild {
|
| 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 |
| $RemoteHost = "Parent"; |
$RemoteHost = "Parent"; |
| $ChildHash{$pid} = $RemoteHost; |
$ChildHash{$pid} = $host; |
| |
$HostToPid{$host}= $pid; |
| sigprocmask(SIG_UNBLOCK, $sigset); |
sigprocmask(SIG_UNBLOCK, $sigset); |
| |
|
| } else { # child. |
} else { # child. |
| ShowStatus("Connected to ".$RemoteHost); |
ShowStatus("Connected to ".$RemoteHost); |
| $SIG{INT} = DEFAULT; |
$SIG{INT} = 'DEFAULT'; |
| sigprocmask(SIG_UNBLOCK, $sigset); |
sigprocmask(SIG_UNBLOCK, $sigset); |
| ChildProcess; # Does not return. |
ChildProcess; # Does not return. |
| } |
} |
|
Line 1500 if ($childpid != 0) {
|
Line 1528 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); |
|
Line 1516 ShowStatus("Forking node servers");
|
Line 1544 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"; |
$RemoteHost = "Parent Server"; |
|
Line 1537 $SIG{INT} = \&Terminate;
|
Line 1567 $SIG{INT} = \&Terminate;
|
| $SIG{TERM} = \&Terminate; |
$SIG{TERM} = \&Terminate; |
| $SIG{HUP} = \&Restart; |
$SIG{HUP} = \&Restart; |
| $SIG{USR1} = \&CheckKids; |
$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 1571 sub CheckKids {
|
Line 1603 sub CheckKids {
|
| my $now=time; |
my $now=time; |
| my $local=localtime($now); |
my $local=localtime($now); |
| print $fh "LONC status $local - parent $$ \n\n"; |
print $fh "LONC status $local - parent $$ \n\n"; |
| foreach $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. |
sleep 1; # Wait so file doesn't intermix. |
|
Line 1580 sub CheckKids {
|
Line 1612 sub CheckKids {
|
| |
|
| =pod |
=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 |
=head1 Restart |
| |
|
| Signal handler for HUP... all children are killed and |
Signal handler for HUP... all children are killed and |
|
Line 1589 the config file.
|
Line 1729 the config file.
|
| =cut |
=cut |
| |
|
| sub Restart { |
sub Restart { |
| KillThemAll; # First kill all the children. |
&KillThemAll; # First kill all the children. |
| Log("CRITICAL", "Restarting"); |
Log("CRITICAL", "Restarting"); |
| my $execdir = $perlvar{'lonDaemons'}; |
my $execdir = $perlvar{'lonDaemons'}; |
| unlink("$execdir/logs/lonc.pid"); |
unlink("$execdir/logs/lonc.pid"); |
| exec("$execdir/lonc"); |
exec("$execdir/loncnew"); |
| } |
} |
| |
|
| =pod |
=pod |
|
Line 1608 SIGHUP. Responds to sigint and sigterm.
|
Line 1748 SIGHUP. Responds to sigint and sigterm.
|
| sub KillThemAll { |
sub KillThemAll { |
| Debug(2, "Kill them all!!"); |
Debug(2, "Kill them all!!"); |
| local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die. |
local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die. |
| foreach $pid (keys %ChildHash) { |
foreach my $pid (keys %ChildHash) { |
| my $serving = $ChildHash{$pid}; |
my $serving = $ChildHash{$pid}; |
| 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"); |
![[BACK]](/icons/back.gif){kind=icon}
Return to loncnew CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom