version 1.27, 2003/10/07 11:23:03
|
version 1.47, 2004/06/01 10:02:13
|
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.27 2003/10/07 11:23:03 foxr |
|
# Installed and tested code to process reinit in parent server. |
|
# |
|
# Revision 1.26 2003/09/30 11:11:17 foxr |
|
# Add book-keeping hashes to support the re-init procedure. |
|
# |
|
# Revision 1.25 2003/09/23 11:22:14 foxr |
|
# Tested ability to receive sigusr2 This is now logged and must be |
|
# properly implemented as a re-read of hosts and re-init of appropriate |
|
# children. |
|
# |
|
# Revision 1.24 2003/09/16 09:46:42 foxr |
|
# Added skeletal infrastructure to support SIGUSR2 update hosts request. |
|
# |
|
# Revision 1.23 2003/09/15 09:24:49 foxr |
|
# Add use strict and fix all the fallout from that. |
|
# |
|
# Revision 1.22 2003/09/02 10:34:47 foxr |
|
# - Fix errors in host dead detection logic (too many cases where the |
|
# retries left were not getting incremented or just not checked). |
|
# - Added some additional status to the ps axuww display: |
|
# o Remaining retries on a host. |
|
# o >>> DEAD <<< indicator if I've given up on a host. |
|
# - Tested the SIGHUP will reset the retries remaining count (thanks to |
|
# the above status stuff, and get allow the loncnew to re-try again |
|
# on the host (thanks to the log). |
|
# |
|
# Revision 1.21 2003/08/26 09:19:51 foxr |
|
# How embarrassing... put in the SocketTimeout function in loncnew and forgot |
|
# to actually hook it into the LondTransaction. Added this to MakeLondConnection |
|
# where it belongs... hopefully transactions (not just connection attempts) will |
|
# timeout more speedily than the socket errors will catch it. |
|
# |
|
# Revision 1.20 2003/08/25 18:48:11 albertel |
|
# - fixing a forgotten ; |
|
# |
|
# Revision 1.19 2003/08/19 09:31:46 foxr |
|
# Get socket directory from configuration rather than the old hard coded test |
|
# way that I forgot to un-hard code. |
|
# |
|
# Revision 1.18 2003/08/06 09:52:29 foxr |
|
# Also needed to remember to fail in-flight transactions if their sends fail. |
|
# |
|
# Revision 1.17 2003/08/03 00:44:31 foxr |
|
# 1. Correct handling of connection failure: Assume it means the host is |
|
# unreachable and fail all of the queued transactions. Note that the |
|
# inflight transactions should fail on their own time due either to timeout |
|
# or send/receive failures. |
|
# 2. Correct handling of logs for forced death signals. Pull the signal |
|
# from the event watcher. |
|
# |
|
# Revision 1.16 2003/07/29 02:33:05 foxr |
|
# Add SIGINT processing to child processes to toggle annoying trace mode |
|
# on/off.. will try to use this to isolate the compute boud process issue. |
|
# |
|
# Revision 1.15 2003/07/15 02:07:05 foxr |
|
# Added code for lonc/lond transaction timeouts. Who knows if it works right. |
|
# The intent is for a timeout to fail any transaction in progress and kill |
|
# off the sockt that timed out. |
|
# |
|
# Revision 1.14 2003/07/03 02:10:18 foxr |
|
# 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 the 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 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 152 use LONCAPA::Configuration;
|
Line 63 use LONCAPA::Configuration;
|
use LONCAPA::HashIterator; |
use LONCAPA::HashIterator; |
|
|
|
|
# |
|
# Disable all signals we might receive from outside for now. |
|
# |
|
|
|
|
|
# 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 175 my $MaxConnectionCount = 10; # Will get
|
Line 81 my $MaxConnectionCount = 10; # Will get
|
my $ClientConnection = 0; # Uniquifier for client events. |
my $ClientConnection = 0; # Uniquifier for client events. |
|
|
my $DebugLevel = 0; |
my $DebugLevel = 0; |
my $NextDebugLevel= 10; # So Sigint can toggle this. |
my $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. |
# |
# |
Line 192 my $ConnectionCount = 0;
|
Line 100 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. |
|
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 201 my $ConnectionRetriesLeft=5; # Number of
|
Line 110 my $ConnectionRetriesLeft=5; # Number of
|
# |
# |
my %LogFormats; |
my %LogFormats; |
|
|
$LogFormats{"CRITICAL"} = "<font color=red>CRITICAL: %s</font>"; |
$LogFormats{"CRITICAL"} = "<font color='red'>CRITICAL: %s</font>"; |
$LogFormats{"SUCCESS"} = "<font color=green>SUCCESS: %s</font>"; |
$LogFormats{"SUCCESS"} = "<font color='green'>SUCCESS: %s</font>"; |
$LogFormats{"INFO"} = "<font color=yellow>INFO: %s</font>"; |
$LogFormats{"INFO"} = "<font color='yellow'>INFO: %s</font>"; |
$LogFormats{"WARNING"} = "<font color=blue>WARNING: %s</font>"; |
$LogFormats{"WARNING"} = "<font color='blue'>WARNING: %s</font>"; |
$LogFormats{"DEFAULT"} = " %s "; |
$LogFormats{"DEFAULT"} = " %s "; |
|
|
|
|
Line 247 host and the time will be formatted into
|
Line 156 host and the time will be formatted into
|
=cut |
=cut |
|
|
sub Log { |
sub Log { |
my $severity = shift; |
|
my $message = shift; |
my ($severity, $message) = @_; |
|
|
if(!$LogFormats{$severity}) { |
if(!$LogFormats{$severity}) { |
$severity = "DEFAULT"; |
$severity = "DEFAULT"; |
} |
} |
Line 284 Returns the name of the host that a sock
|
Line 193 Returns the name of the host that a sock
|
=cut |
=cut |
|
|
sub GetPeername { |
sub GetPeername { |
my $connection = shift; |
|
my $AdrFamily = shift; |
|
|
my ($connection, $AdrFamily) = @_; |
|
|
my $peer = $connection->peername(); |
my $peer = $connection->peername(); |
my $peerport; |
my $peerport; |
my $peerip; |
my $peerip; |
Line 299 sub GetPeername {
|
Line 210 sub GetPeername {
|
return $peerfile; |
return $peerfile; |
} |
} |
} |
} |
#----------------------------- Timer management ------------------------ |
|
=pod |
=pod |
|
|
=head2 Debug |
=head2 Debug |
Line 309 Invoked to issue a debug message.
|
Line 219 Invoked to issue a debug message.
|
=cut |
=cut |
|
|
sub Debug { |
sub Debug { |
my $level = shift; |
|
my $message = shift; |
my ($level, $message) = @_; |
|
|
if ($level <= $DebugLevel) { |
if ($level <= $DebugLevel) { |
Log("INFO", "-Debug- $message host = $RemoteHost"); |
Log("INFO", "-Debug- $message host = $RemoteHost"); |
} |
} |
} |
} |
|
|
sub SocketDump { |
sub SocketDump { |
my $level = shift; |
|
my $socket= shift; |
my ($level, $socket) = @_; |
|
|
if($level <= $DebugLevel) { |
if($level <= $DebugLevel) { |
$socket->Dump(); |
$socket->Dump(); |
} |
} |
Line 351 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"); |
|
Debug(0, " SocketTimeout called: "); |
|
$Socket->Dump(); |
|
if(exists($ActiveTransactions{$Socket})) { |
|
FailTransaction($ActiveTransactions{$Socket}); |
|
} |
KillSocket($Socket); # A transaction timeout also counts as |
KillSocket($Socket); # A transaction timeout also counts as |
# a connection failure: |
# a connection failure: |
$ConnectionRetriesLeft--; |
$ConnectionRetriesLeft--; |
|
if($ConnectionRetriesLeft <= 0) { |
|
Log("CRITICAL", "Host marked dead: ".GetServerHost()); |
|
} |
|
|
} |
} |
|
#----------------------------- Timer management ------------------------ |
|
|
=pod |
=pod |
|
|
Line 390 sub Tick {
|
Line 312 sub Tick {
|
# |
# |
# For each inflight transaction, tick down its timeout counter. |
# For each inflight transaction, tick down its timeout counter. |
# |
# |
foreach my $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 403 sub Tick {
|
Line 329 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"); |
my $successCount = 0; |
my $successCount = 0; |
for (my $i =0; $i < $Connections; $i++) { |
for (my $i =0; $i < $Connections; $i++) { |
$successCount += MakeLondConnection(); |
$successCount += MakeLondConnection(); |
} |
} |
if($successCount == 0) { # All connections failed: |
if($successCount == 0) { # All connections failed: |
Debug(1,"Work in queue failed to make any connectiouns\n"); |
Debug(5,"Work in queue failed to make any connectiouns\n"); |
EmptyQueue(); # Fail pending transactions with con_lost. |
EmptyQueue(); # Fail pending transactions with con_lost. |
|
CloseAllLondConnections(); # Should all be closed but.... |
} |
} |
} else { |
} else { |
ShowStatus(GetServerHost()." >>> DEAD!!! <<<"); |
ShowStatus(GetServerHost()." >>> DEAD!!! <<<"); |
Debug(1,"Work in queue, but gave up on connections..flushing\n"); |
Debug(5,"Work in queue, but gave up on connections..flushing\n"); |
EmptyQueue(); # Connections can't be established. |
EmptyQueue(); # Connections can't be established. |
|
CloseAllLondConnections(); # Should all already be closed but... |
} |
} |
|
|
} |
} |
Line 439 Trigger disconnections of idle sockets.
|
Line 367 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 461 sub ServerToIdle {
|
Line 389 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: |
|
|
my $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 519 sub ClientWritable {
|
Line 447 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 590 The transaction that is being completed.
|
Line 518 The transaction that is being completed.
|
=cut |
=cut |
|
|
sub CompleteTransaction { |
sub CompleteTransaction { |
&Debug(6,"Complete transaction"); |
&Debug(5,"Complete transaction"); |
my $Socket = shift; |
|
my $Transaction = shift; |
my ($Socket, $Transaction) = @_; |
|
|
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"); |
Line 603 sub CompleteTransaction {
|
Line 534 sub CompleteTransaction {
|
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 619 sub CompleteTransaction {
|
Line 552 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 $data = shift; |
|
|
|
|
my ($Transaction, $data) = @_; |
|
|
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 637 sub StartClientReply {
|
Line 569 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 647 sub StartClientReply {
|
Line 581 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 656 Parameters:
|
Line 589 Parameters:
|
|
|
The LondTransaction we are failing. |
The LondTransaction we are failing. |
|
|
|
|
=cut |
=cut |
|
|
sub FailTransaction { |
sub FailTransaction { |
Line 667 sub FailTransaction {
|
Line 601 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 697 Close all connections open on lond prior
|
Line 628 Close all connections open on lond prior
|
=cut |
=cut |
sub CloseAllLondConnections { |
sub CloseAllLondConnections { |
foreach my $Socket (keys %ActiveConnections) { |
foreach my $Socket (keys %ActiveConnections) { |
KillSocket($Socket); |
if(exists($ActiveTransactions{$Socket})) { |
|
FailTransaction($ActiveTransactions{$Socket}); |
|
} |
|
KillSocket($Socket); |
} |
} |
} |
} |
=cut |
=cut |
Line 741 sub KillSocket {
|
Line 675 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 774 The connection must echo the challenge b
|
Line 709 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 828 sub LondReadable {
|
Line 774 sub LondReadable {
|
&Debug(2, "Socket->Readable returned: $status"); |
&Debug(2, "Socket->Readable returned: $status"); |
|
|
if($status != 0) { |
if($status != 0) { |
# bad return from socket read. Currently this means that |
# bad return from socket read. Currently this means that |
# The socket has become disconnected. We fail the transaction. |
# The socket has become disconnected. We fail the transaction. |
|
|
Log("WARNING", |
Log("WARNING", |
Line 846 sub LondReadable {
|
Line 792 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 870 sub LondReadable {
|
Line 831 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 |
# Note that a trasition to idle indicates a live lond |
Line 878 sub LondReadable {
|
Line 847 sub LondReadable {
|
$ConnectionRetriesLeft = $ConnectionRetries; # success resets the count |
$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 899 sub LondReadable {
|
Line 868 sub LondReadable {
|
|
|
|
|
} else { |
} else { |
# Invalid state. |
# Invalid state. |
Debug(4, "Invalid state in LondReadable"); |
Debug(4, "Invalid state in LondReadable"); |
} |
} |
} |
} |
Line 981 sub LondWritable {
|
Line 950 sub LondWritable {
|
|
|
SocketDump(6,$Socket); |
SocketDump(6,$Socket); |
|
|
if ($State eq "Connected") { |
# If the socket is writable, we must always write. |
|
# Only by writing will we undergo state transitions. |
if ($Socket->Writable() != 0) { |
# Old logic wrote in state specific code below, however |
# The write resulted in an error. |
# That forces us at least through another invocation of |
# We'll treat this as if the socket got disconnected: |
# this function after writability is possible again. |
Log("WARNING", "Connection to ".$RemoteHost. |
# This logic also factors out common code for handling |
" has been disconnected"); |
# 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}); |
FailTransaction($ActiveTransactions{$Socket}); |
$Watcher->cancel(); |
|
KillSocket($Socket); |
|
return; |
|
} |
} |
# "init" is being sent... |
$Watcher->cancel(); |
|
KillSocket($Socket); |
|
return; |
|
} |
|
|
|
|
|
|
|
if ($State eq "Connected") { |
|
|
|
# "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 1003 sub LondWritable {
|
Line 987 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 1045 sub LondWritable {
|
Line 1032 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 1125 sub MakeLondConnection {
|
Line 1102 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. |
Line 1137 sub MakeLondConnection {
|
Line 1114 sub MakeLondConnection {
|
# 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); |
Line 1190 The text of the request to send.
|
Line 1167 The text of the request to send.
|
=cut |
=cut |
|
|
sub StartRequest { |
sub StartRequest { |
my $Lond = shift; |
|
my $Request = shift; # This is a LondTransaction. |
my ($Lond, $Request) = @_; |
|
|
Debug(6, "StartRequest: ".$Request->getRequest()); |
Debug(6, "StartRequest: ".$Request->getRequest()); |
|
|
Line 1240 sub QueueTransaction {
|
Line 1217 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) { |
if($ConnectionRetriesLeft > 0) { |
if($ConnectionRetriesLeft > 0) { |
Debug(4,"Starting additional lond connection"); |
Debug(5,"Starting additional lond connection"); |
if(MakeLondConnection() == 0) { |
if(MakeLondConnection() == 0) { |
EmptyQueue(); # Fail transactions, can't make connection. |
EmptyQueue(); # Fail transactions, can't make connection. |
|
CloseAllLondConnections; # Should all be closed but... |
} |
} |
} 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. |
|
CloseAllLondConnections; # Should all be closed but.. |
} |
} |
} |
} |
} else { # Can start the request: |
} else { # Can start the request: |
Line 1282 sub ClientRequest {
|
Line 1261 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 1293 sub ClientRequest {
|
Line 1272 sub ClientRequest {
|
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 eq "close_connection_exit\n") { |
if($data eq "close_connection_exit\n") { |
Log("CRITICAL", |
Log("CRITICAL", |
"Request Close Connection ... exiting"); |
"Request Close Connection ... exiting"); |
Line 1301 sub ClientRequest {
|
Line 1280 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 1409 sub SetupLoncListener {
|
Line 1391 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 1419 into the status file.
|
Line 1419 into the status file.
|
We also use this to reset the retries count in order to allow the |
We also use this to reset the retries count in order to allow the |
client to retry connections with a previously dead server. |
client to retry connections with a previously dead server. |
=cut |
=cut |
|
|
sub ChildStatus { |
sub ChildStatus { |
my $event = shift; |
my $event = shift; |
my $watcher = $event->w; |
my $watcher = $event->w; |
Line 1428 sub ChildStatus {
|
Line 1429 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: |
|
# |
|
if ($DebugLevel > 2) { |
|
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; |
$ConnectionRetriesLeft = $ConnectionRetries; |
} |
} |
|
|
Line 1492 sub ChildProcess {
|
Line 1509 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 1586 ShowStatus("Forking node servers");
|
Line 1605 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()) { |
|
|
Line 1774 sub Restart {
|
Line 1794 sub Restart {
|
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 |