version 1.41, 2004/02/09 13:39:28
|
version 1.51, 2004/08/26 12:35:10
|
Line 82 my $ClientConnection = 0; # Uniquifier f
|
Line 82 my $ClientConnection = 0; # Uniquifier f
|
|
|
my $DebugLevel = 0; |
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= 600; # Wait 10 minutes before pruning connections. |
|
|
my $LogTransactions = 0; # When True, all transactions/replies get logged. |
my $LogTransactions = 0; # When True, all transactions/replies get logged. |
|
|
Line 103 my $RecentLogEntry = "";
|
Line 103 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. |
my $LondVersion = "unknown"; # Version of lond we talk with. |
|
my $KeyMode = ""; # e.g. ssl, local, insecure from last connect. |
|
|
|
my $LongTickLength = 10000000; #Tick Frequency when Idle |
|
my $ShortTickLength = 1; #Tick Frequency when Active (many places in |
|
# the code assume this is one) |
|
my $TickLength = $ShortTickLength;#number of seconds to wait until ticking |
# |
# |
# The hash below gives the HTML format for log messages |
# The hash below gives the HTML format for log messages |
# given a severity. |
# given a severity. |
# |
# |
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 156 host and the time will be formatted into
|
Line 161 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 193 Returns the name of the host that a sock
|
Line 198 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 217 Invoked to issue a debug message.
|
Line 224 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(-1); # Ensure it will get dumped. |
} |
} |
} |
} |
|
|
Line 261 sub SocketTimeout {
|
Line 270 sub SocketTimeout {
|
my $Socket = shift; |
my $Socket = shift; |
Log("WARNING", "A socket timeout was detected"); |
Log("WARNING", "A socket timeout was detected"); |
Debug(0, " SocketTimeout called: "); |
Debug(0, " SocketTimeout called: "); |
$Socket->Dump(); |
$Socket->Dump(0); |
|
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 ------------------------ |
#----------------------------- Timer management ------------------------ |
|
|
Line 281 sub Tick {
|
Line 297 sub Tick {
|
my $client; |
my $client; |
if($ConnectionRetriesLeft > 0) { |
if($ConnectionRetriesLeft > 0) { |
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount |
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount |
." Retries remaining: ".$ConnectionRetriesLeft); |
." Retries remaining: ".$ConnectionRetriesLeft |
|
." ($KeyMode)"); |
} else { |
} else { |
ShowStatus(GetServerHost()." >> DEAD <<"); |
ShowStatus(GetServerHost()." >> DEAD <<"); |
} |
} |
Line 290 sub Tick {
|
Line 307 sub Tick {
|
|
|
if($IdleConnections->Count() && |
if($IdleConnections->Count() && |
($WorkQueue->Count() == 0)) { # Idle connections and nothing to do? |
($WorkQueue->Count() == 0)) { # Idle connections and nothing to do? |
$IdleSeconds++; |
$IdleSeconds+=$TickLength; |
if($IdleSeconds > $IdleTimeout) { # Prune a connection... |
if($IdleSeconds > $IdleTimeout) { # Prune a connection... |
my $Socket = $IdleConnections->pop(); |
my $Socket = $IdleConnections->pop(); |
KillSocket($Socket); |
KillSocket($Socket); |
|
if ($IdleConnections->Count() == 0) { |
|
&SetupTimer($LongTickLength); |
|
} |
} |
} |
} else { |
} else { |
$IdleSeconds = 0; # Reset idle count if not idle. |
$IdleSeconds = 0; # Reset idle count if not idle. |
Line 326 sub Tick {
|
Line 346 sub Tick {
|
if($successCount == 0) { # All connections failed: |
if($successCount == 0) { # All connections failed: |
Debug(5,"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(5,"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... |
} |
} |
|
|
} |
} |
|
if ($ConnectionCount == 0) { |
|
$KeyMode = ""; |
|
} |
} |
} |
|
|
=pod |
=pod |
Line 352 Trigger disconnections of idle sockets.
|
Line 377 Trigger disconnections of idle sockets.
|
|
|
=cut |
=cut |
|
|
|
my $timer; |
sub SetupTimer { |
sub SetupTimer { |
Debug(6, "SetupTimer"); |
my ($newLength)=@_; |
Event->timer(interval => 1, cb => \&Tick ); |
Debug(6, "SetupTimer $TickLength->$newLength"); |
|
$TickLength=$newLength; |
|
if ($timer) { $timer->cancel; } |
|
$timer=Event->timer(interval => $TickLength, cb => \&Tick ); |
} |
} |
|
|
=pod |
=pod |
Line 374 long enough, it will be shut down and re
|
Line 403 long enough, it will be shut down and re
|
|
|
sub ServerToIdle { |
sub ServerToIdle { |
my $Socket = shift; # Get the socket. |
my $Socket = shift; # Get the socket. |
|
$KeyMode = $Socket->{AuthenticationMode}; |
delete($ActiveTransactions{$Socket}); # Server has no transaction |
delete($ActiveTransactions{$Socket}); # Server has no transaction |
|
|
&Debug(5, "Server to idle"); |
&Debug(5, "Server to idle"); |
Line 506 The transaction that is being completed.
|
Line 536 The transaction that is being completed.
|
|
|
sub CompleteTransaction { |
sub CompleteTransaction { |
&Debug(5,"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. |
Line 521 sub CompleteTransaction {
|
Line 551 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 537 sub CompleteTransaction {
|
Line 569 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(); |
|
|
Line 554 sub StartClientReply {
|
Line 586 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 564 sub StartClientReply {
|
Line 598 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 573 Parameters:
|
Line 606 Parameters:
|
|
|
The LondTransaction we are failing. |
The LondTransaction we are failing. |
|
|
|
|
=cut |
=cut |
|
|
sub FailTransaction { |
sub FailTransaction { |
Line 584 sub FailTransaction {
|
Line 618 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 614 Close all connections open on lond prior
|
Line 645 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 666 sub KillSocket {
|
Line 700 sub KillSocket {
|
# |
# |
if($ConnectionCount == 0) { |
if($ConnectionCount == 0) { |
EmptyQueue(); |
EmptyQueue(); |
|
CloseAllLondConnections; # Should all already be closed but... |
} |
} |
} |
} |
|
|
Line 932 sub LondWritable {
|
Line 967 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; |
|
} |
} |
|
$Watcher->cancel(); |
|
KillSocket($Socket); |
|
return; |
|
} |
|
|
|
|
|
|
|
if ($State eq "Connected") { |
|
|
# "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 960 sub LondWritable {
|
Line 1010 sub LondWritable {
|
# 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. |
Line 975 sub LondWritable {
|
Line 1018 sub LondWritable {
|
$Watcher->poll("r"); |
$Watcher->poll("r"); |
} elsif ($State eq "RequestingVersion") { |
} elsif ($State eq "RequestingVersion") { |
# Sending the peer a version request... |
# Sending the peer a version request... |
|
|
if($Socket->Writable() != 0) { |
|
$Watcher->cancel(); |
|
KillSocket($Socket); |
|
return; |
|
} |
|
} elsif ($State eq "ReadingVersionString") { |
} elsif ($State eq "ReadingVersionString") { |
# Transition to read since we have sent the |
# Transition to read since we have sent the |
# version command and now just need to read the |
# version command and now just need to read the |
Line 991 sub LondWritable {
|
Line 1029 sub LondWritable {
|
|
|
} elsif ($State eq "SetHost") { |
} elsif ($State eq "SetHost") { |
# Setting the remote domain... |
# Setting the remote domain... |
|
|
if($Socket->Writable() != 0) { |
|
$Watcher->cancel(); |
|
KillSocket($Socket); |
|
return; |
|
} |
|
} elsif ($State eq "HostSet") { |
} elsif ($State eq "HostSet") { |
# Back to readable to get the ok. |
# Back to readable to get the ok. |
|
|
Line 1007 sub LondWritable {
|
Line 1040 sub LondWritable {
|
} 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 1030 sub LondWritable {
|
Line 1053 sub LondWritable {
|
# 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 1172 The text of the request to send.
|
Line 1184 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 1229 sub QueueTransaction {
|
Line 1241 sub QueueTransaction {
|
Debug(5,"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... |
} |
} |
|
&SetupTimer($ShortTickLength); |
} 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 1275 sub ClientRequest {
|
Line 1290 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 1422 into the status file.
|
Line 1437 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 1434 sub ChildStatus {
|
Line 1450 sub ChildStatus {
|
# |
# |
# Write out information about each of the connections: |
# Write out information about each of the connections: |
# |
# |
print $fh "Active connection statuses: \n"; |
if ($DebugLevel > 2) { |
my $i = 1; |
print $fh "Active connection statuses: \n"; |
print STDERR "================================= Socket Status Dump:\n"; |
my $i = 1; |
foreach my $item (keys %ActiveConnections) { |
print STDERR "================================= Socket Status Dump:\n"; |
my $Socket = $ActiveConnections{$item}->data; |
foreach my $item (keys %ActiveConnections) { |
my $state = $Socket->GetState(); |
my $Socket = $ActiveConnections{$item}->data; |
print $fh "Connection $i State: $state\n"; |
my $state = $Socket->GetState(); |
print STDERR "---------------------- Connection $i \n"; |
print $fh "Connection $i State: $state\n"; |
$Socket->Dump(); |
print STDERR "---------------------- Connection $i \n"; |
$i++; |
$Socket->Dump(-1); # Ensure it gets dumped.. |
|
$i++; |
|
} |
} |
} |
$ConnectionRetriesLeft = $ConnectionRetries; |
$ConnectionRetriesLeft = $ConnectionRetries; |
} |
} |
Line 1515 sub ChildProcess {
|
Line 1533 sub ChildProcess {
|
cb => \&ToggleDebug, |
cb => \&ToggleDebug, |
data => "INT"); |
data => "INT"); |
|
|
SetupTimer(); |
SetupTimer($LongTickLength); |
|
|
SetupLoncListener(); |
SetupLoncListener(); |
|
|