version 1.43, 2004/02/17 15:09:08
|
version 1.47, 2004/06/01 10:02:13
|
Line 110 my $LondVersion = "unknown"; # Versi
|
Line 110 my $LondVersion = "unknown"; # Versi
|
# |
# |
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 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 193 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 217 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 515 The transaction that is being completed.
|
Line 519 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 550 sub CompleteTransaction {
|
Line 554 sub CompleteTransaction {
|
=cut |
=cut |
|
|
sub StartClientReply { |
sub StartClientReply { |
my $Transaction = shift; |
|
my $data = shift; |
|
|
|
|
my ($Transaction, $data) = @_; |
|
|
my $Client = $Transaction->getClient(); |
my $Client = $Transaction->getClient(); |
|
|
Line 1164 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 1269 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 1416 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 1432 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(); |
|
$i++; |
|
} |
} |
} |
$ConnectionRetriesLeft = $ConnectionRetries; |
$ConnectionRetriesLeft = $ConnectionRetries; |
} |
} |