version 1.35, 2003/12/12 09:57:28
|
version 1.41, 2004/02/09 13:39:28
|
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) |
# |
# |
|
|
use strict; |
use strict; |
Line 63 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 89 my $DebugLevel = 0;
|
Line 84 my $DebugLevel = 0;
|
my $NextDebugLevel= 2; # 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 105 my $Status = ""; # Current stat
|
Line 102 my $Status = ""; # Current stat
|
my $RecentLogEntry = ""; |
my $RecentLogEntry = ""; |
my $ConnectionRetries=2; # Number of connection retries allowed. |
my $ConnectionRetries=2; # Number of connection retries allowed. |
my $ConnectionRetriesLeft=2; # 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 261 sub ShowStatus {
|
Line 259 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(); |
KillSocket($Socket); # A transaction timeout also counts as |
KillSocket($Socket); # A transaction timeout also counts as |
# a connection failure: |
# a connection failure: |
$ConnectionRetriesLeft--; |
$ConnectionRetriesLeft--; |
Line 511 sub CompleteTransaction {
|
Line 511 sub CompleteTransaction {
|
|
|
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 655 sub KillSocket {
|
Line 658 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. |
# |
# |
Line 688 The connection must echo the challenge b
|
Line 691 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 742 sub LondReadable {
|
Line 756 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 760 sub LondReadable {
|
Line 774 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 784 sub LondReadable {
|
Line 813 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 813 sub LondReadable {
|
Line 850 sub LondReadable {
|
|
|
|
|
} else { |
} else { |
# Invalid state. |
# Invalid state. |
Debug(4, "Invalid state in LondReadable"); |
Debug(4, "Invalid state in LondReadable"); |
} |
} |
} |
} |
Line 907 sub LondWritable {
|
Line 944 sub LondWritable {
|
KillSocket($Socket); |
KillSocket($Socket); |
return; |
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 917 sub LondWritable {
|
Line 954 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, |
Line 936 sub LondWritable {
|
Line 973 sub LondWritable {
|
|
|
$Watcher->cb(\&LondReadable); |
$Watcher->cb(\&LondReadable); |
$Watcher->poll("r"); |
$Watcher->poll("r"); |
|
} elsif ($State eq "RequestingVersion") { |
|
# Sending the peer a version request... |
|
|
|
if($Socket->Writable() != 0) { |
|
$Watcher->cancel(); |
|
KillSocket($Socket); |
|
return; |
|
} |
|
} 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... |
|
|
|
if($Socket->Writable() != 0) { |
|
$Watcher->cancel(); |
|
KillSocket($Socket); |
|
return; |
|
} |
|
} 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. |
Line 959 sub LondWritable {
|
Line 1026 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: |
|
|
Line 1215 sub ClientRequest {
|
Line 1283 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 1323 sub SetupLoncListener {
|
Line 1394 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 1342 sub ChildStatus {
|
Line 1431 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; |
$ConnectionRetriesLeft = $ConnectionRetries; |
} |
} |
|
|
Line 1406 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"); |