version 1.35, 2003/12/12 09:57:28
|
version 1.40, 2004/02/09 10:58:03
|
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 726 transaction is in progress, the socket a
|
Line 740 transaction is in progress, the socket a
|
|
|
sub LondReadable { |
sub LondReadable { |
|
|
my $Event = shift; |
my $Event = shift; |
my $Watcher = $Event->w; |
my $Watcher = $Event->w; |
my $Socket = $Watcher->data; |
my $Socket = $Watcher->data; |
my $client = undef; |
my $client = undef; |
|
|
&Debug(6,"LondReadable called state = ".$Socket->GetState()); |
&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(); |
my $status = $Socket->Readable(); |
|
|
|
&Debug(2, "Socket->Readable returned: $status"); |
|
|
|
if($status != 0) { |
|
# bad return from socket read. Currently this means that |
|
# The socket has become disconnected. We fail the transaction. |
|
|
|
Log("WARNING", |
|
"Lond connection lost."); |
|
if(exists($ActiveTransactions{$Socket})) { |
|
FailTransaction($ActiveTransactions{$Socket}); |
|
} |
|
$Watcher->cancel(); |
|
KillSocket($Socket); |
|
$ConnectionRetriesLeft--; # Counts as connection failure |
|
return; |
|
} |
|
SocketDump(6,$Socket); |
|
|
&Debug(2, "Socket->Readable returned: $status"); |
$State = $Socket->GetState(); # Update in case of transition. |
|
&Debug(6, "After read, state is ".$State); |
if($status != 0) { |
|
# bad return from socket read. Currently this means that |
|
# The socket has become disconnected. We fail the transaction. |
|
|
|
Log("WARNING", |
|
"Lond connection lost."); |
|
if(exists($ActiveTransactions{$Socket})) { |
|
FailTransaction($ActiveTransactions{$Socket}); |
|
} |
|
$Watcher->cancel(); |
|
KillSocket($Socket); |
|
$ConnectionRetriesLeft--; # Counts as connection failure |
|
return; |
|
} |
|
SocketDump(6,$Socket); |
|
|
|
$State = $Socket->GetState(); # Update in case of transition. |
|
&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") { |
} elsif ($State eq "RequestingKey") { |
# 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") { |
# The ok was received. Now we need to request the key |
# The ok was received. Now we need to request the key |
# That requires us to be writable: |
# That requires us to be writable: |
|
|
$Watcher->cb(\&LondWritable); |
$Watcher->cb(\&LondWritable); |
$Watcher->poll("w"); |
$Watcher->poll("w"); |
|
|
} 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 |
# on the other end so reset the connection retries. |
# on the other end so reset the connection retries. |
# |
# |
$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(5,"Completing transaction!!"); |
Debug(5,"Completing transaction!!"); |
CompleteTransaction($Socket, |
CompleteTransaction($Socket, |
$ActiveTransactions{$Socket}); |
$ActiveTransactions{$Socket}); |
} else { |
} else { |
Log("SUCCESS", "Connection ".$ConnectionCount." to " |
Log("SUCCESS", "Connection ".$ConnectionCount." to " |
.$RemoteHost." now ready for action"); |
.$RemoteHost." now ready for action"); |
} |
} |
ServerToIdle($Socket); # Next work unit or idle. |
ServerToIdle($Socket); # Next work unit or idle. |
|
|
} elsif ($State eq "SendingRequest") { |
} elsif ($State eq "SendingRequest") { |
# We need to be writable for this and probably don't belong |
# We need to be writable for this and probably don't belong |
# here inthe first place. |
# here inthe first place. |
|
|
Deubg(6, "SendingRequest state encountered in readable"); |
Deubg(6, "SendingRequest state encountered in readable"); |
$Watcher->poll("w"); |
$Watcher->poll("w"); |
$Watcher->cb(\&LondWritable); |
$Watcher->cb(\&LondWritable); |
|
|
} elsif ($State eq "ReceivingReply") { |
} elsif ($State eq "ReceivingReply") { |
|
|
|
|
} else { |
} else { |
# Invalid state. |
# Invalid state. |
Debug(4, "Invalid state in LondReadable"); |
Debug(4, "Invalid state in LondReadable"); |
} |
} |
} |
} |
|
|
=pod |
=pod |
Line 895 sub LondWritable {
|
Line 932 sub LondWritable {
|
|
|
SocketDump(6,$Socket); |
SocketDump(6,$Socket); |
|
|
if ($State eq "Connected") { |
if ($State eq "Connected") { |
|
|
if ($Socket->Writable() != 0) { |
if ($Socket->Writable() != 0) { |
# The write resulted in an error. |
# The write resulted in an error. |
# 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}); |
FailTransaction($ActiveTransactions{$Socket}); |
$Watcher->cancel(); |
$Watcher->cancel(); |
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 |
# to watching for readability: |
# to watching for readability: |
|
|
$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) { |
if($Socket->Writable() != 0) { |
|
|
$Watcher->cancel(); |
$Watcher->cancel(); |
KillSocket($Socket); |
KillSocket($Socket); |
return; |
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") { |
} elsif ($State eq "RequestingKey") { |
# Sending the peer a version request... |
# At this time we're requesting the key. |
|
# again, this is essentially a no-op. |
if($Socket->Writable() != 0) { |
# we'll write the next chunk until the |
$Watcher->cancel(); |
# state changes. |
KillSocket($Socket); |
|
return; |
if($Socket->Writable() != 0) { |
} |
# Write resulted in an error. |
} 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") { |
|
# At this time we're requesting the key. |
|
# 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") { |
|
# Now we need to wait for the key |
|
# to come back from the peer: |
|
|
$Watcher->cancel(); |
$Watcher->cb(\&LondReadable); |
KillSocket($Socket); |
$Watcher->poll("r"); |
return; |
|
|
|
} |
|
} elsif ($State eq "ReceivingKey") { |
|
# Now we need to wait for the key |
|
# to come back from the peer: |
|
|
|
$Watcher->cb(\&LondReadable); |
|
$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($Socket->Writable() != 0) { |
|
|
if(exists($ActiveTransactions{$Socket})) { |
if(exists($ActiveTransactions{$Socket})) { |
Debug(3, "Lond connection lost, failing transactions"); |
Debug(3, "Lond connection lost, failing transactions"); |
FailTransaction($ActiveTransactions{$Socket}); |
FailTransaction($ActiveTransactions{$Socket}); |
} |
} |
$Watcher->cancel(); |
$Watcher->cancel(); |
KillSocket($Socket); |
KillSocket($Socket); |
return; |
return; |
|
|
} |
} |
|
|
} elsif ($State eq "ReceivingReply") { |
} elsif ($State eq "ReceivingReply") { |
# The send has completed. Wait for the |
# The send has completed. Wait for the |
# data to come in for a reply. |
# data to come in for a reply. |
Debug(8,"Writable sent request/receiving reply"); |
Debug(8,"Writable sent request/receiving reply"); |
$Watcher->cb(\&LondReadable); |
$Watcher->cb(\&LondReadable); |
$Watcher->poll("r"); |
$Watcher->poll("r"); |
|
|
|
} else { |
|
# Control only passes here on an error: |
|
# the socket state does not match any |
|
# of the known states... so an error |
|
# must be logged. |
|
|
} else { |
&Debug(4, "Invalid socket state ".$State."\n"); |
# Control only passes here on an error: |
} |
# the socket state does not match any |
|
# of the known states... so an error |
|
# must be logged. |
|
|
|
&Debug(4, "Invalid socket state ".$State."\n"); |
|
} |
|
|
|
} |
} |
=pod |
=pod |
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"); |