version 1.24, 2004/02/09 10:57:37
|
version 1.30, 2004/06/01 10:05:16
|
Line 89 sub ReadConfig {
|
Line 89 sub ReadConfig {
|
# to build up the hosts table. |
# to build up the hosts table. |
# |
# |
sub ReadForeignConfig { |
sub ReadForeignConfig { |
my $MyHost = shift; |
|
my $Filename = shift; |
my ($MyHost, $Filename) = @_; |
|
|
&Debug(4, "ReadForeignConfig $MyHost $Filename\n"); |
&Debug(4, "ReadForeignConfig $MyHost $Filename\n"); |
|
|
Line 108 sub ReadForeignConfig {
|
Line 108 sub ReadForeignConfig {
|
} |
} |
|
|
sub Debug { |
sub Debug { |
my $level = shift; |
|
my $message = shift; |
my ($level, $message) = @_; |
|
|
if ($level < $DebugLevel) { |
if ($level < $DebugLevel) { |
print($message."\n"); |
print($message."\n"); |
} |
} |
Line 143 old state.
|
Line 144 old state.
|
=cut |
=cut |
|
|
sub Transition { |
sub Transition { |
my $self = shift; |
|
my $newstate = shift; |
my ($self, $newstate) = @_; |
|
|
my $oldstate = $self->{State}; |
my $oldstate = $self->{State}; |
$self->{State} = $newstate; |
$self->{State} = $newstate; |
$self->{TimeoutRemaining} = $self->{TimeoutValue}; |
$self->{TimeoutRemaining} = $self->{TimeoutValue}; |
Line 174 host the remote lond is on. This host is
|
Line 176 host the remote lond is on. This host is
|
=cut |
=cut |
|
|
sub new { |
sub new { |
my $class = shift; # class name. |
|
my $Hostname = shift; # Name of host to connect to. |
my ($class, $Hostname, $Port) = @_; |
my $Port = shift; # Port to connect |
|
|
|
if (!$ConfigRead) { |
if (!$ConfigRead) { |
ReadConfig(); |
ReadConfig(); |
Line 279 sub Readable {
|
Line 280 sub Readable {
|
my $self = shift; |
my $self = shift; |
my $socket = $self->{Socket}; |
my $socket = $self->{Socket}; |
my $data = ''; |
my $data = ''; |
my $rv = $socket->recv($data, POSIX::BUFSIZ, 0); |
my $rv; |
|
if ($socket) { |
|
eval { |
|
$rv = $socket->recv($data, POSIX::BUFSIZ, 0); |
|
} |
|
} else { |
|
$self->Transition("Disconnected"); |
|
return -1; |
|
} |
my $errno = $! + 0; # Force numeric context. |
my $errno = $! + 0; # Force numeric context. |
|
|
unless (defined($rv) && length $data) {# Read failed, |
unless (defined($rv) && length $data) {# Read failed, |
Line 300 sub Readable {
|
Line 309 sub Readable {
|
|
|
&Debug(9,"Received from host: ".$data); |
&Debug(9,"Received from host: ".$data); |
$self->{TransactionReply} .= $data; |
$self->{TransactionReply} .= $data; |
if($self->{TransactionReply} =~ /(.*\n)/) { |
if($self->{TransactionReply} =~ m/\n$/) { |
&Debug(8,"Readable End of line detected"); |
&Debug(8,"Readable End of line detected"); |
if ($self->{State} eq "Initialized") { # We received the challenge: |
if ($self->{State} eq "Initialized") { # We received the challenge: |
if($self->{TransactionReply} eq "refused\n") { # Remote doesn't have |
if($self->{TransactionReply} eq "refused\n") { # Remote doesn't have |
Line 317 sub Readable {
|
Line 326 sub Readable {
|
$self->Transition("ChallengeReceived"); |
$self->Transition("ChallengeReceived"); |
$self->{TimeoutRemaining} = $self->{TimeoutValue}; |
$self->{TimeoutRemaining} = $self->{TimeoutValue}; |
return 0; |
return 0; |
} elsif ($self->{State} eq "ChallengeReplied") { |
} elsif ($self->{State} eq "ChallengeReplied") { |
if($self->{TransactionReply} ne "ok\n") { |
if($self->{TransactionReply} ne "ok\n") { |
$self->Transition("Disconnected"); |
$self->Transition("Disconnected"); |
$socket->close(); |
$socket->close(); |
return -1; |
return -1; |
} |
} |
$self->Transition("RequestingVersion"); |
$self->Transition("RequestingVersion"); |
$self->{InformReadable} = 0; |
$self->{InformReadable} = 0; |
$self->{InformWritable} = 1; |
$self->{InformWritable} = 1; |
$self->{TransactionRequest} = "version\n"; |
$self->{TransactionRequest} = "version\n"; |
return 0; |
return 0; |
} elsif ($self->{State} eq "ReadingVersionString") { |
} elsif ($self->{State} eq "ReadingVersionString") { |
$self->{LondVersion} = chomp($self->{TransactionReply}); |
$self->{LondVersion} = chomp($self->{TransactionReply}); |
$self->Transition("SetHost"); |
$self->Transition("SetHost"); |
$self->{InformReadable} = 0; |
$self->{InformReadable} = 0; |
$self->{InformWritable} = 1; |
$self->{InformWritable} = 1; |
my $peer = $self->{LoncapaHim}; |
my $peer = $self->{LoncapaHim}; |
$self->{TransactionRequest}= "sethost:$peer\n"; |
$self->{TransactionRequest}= "sethost:$peer\n"; |
return 0; |
return 0; |
} elsif ($self->{State} eq "HostSet") { # should be ok. |
} elsif ($self->{State} eq "HostSet") { # should be ok. |
if($self->{TransactionReply} ne "ok\n") { |
if($self->{TransactionReply} ne "ok\n") { |
$self->Transition("Disconnected"); |
$self->Transition("Disconnected"); |
$socket->close(); |
$socket->close(); |
return -1; |
return -1; |
} |
} |
$self->Transition("RequestingKey"); |
$self->Transition("RequestingKey"); |
$self->{InformReadable} = 0; |
$self->{InformReadable} = 0; |
$self->{InformWritable} = 1; |
$self->{InformWritable} = 1; |
$self->{TransactionRequest} = "ekey\n"; |
$self->{TransactionRequest} = "ekey\n"; |
return 0; |
return 0; |
} elsif ($self->{State} eq "ReceivingKey") { |
} elsif ($self->{State} eq "ReceivingKey") { |
my $buildkey = $self->{TransactionReply}; |
my $buildkey = $self->{TransactionReply}; |
my $key = $self->{LoncapaHim}.$perlvar{'lonHostID'}; |
my $key = $self->{LoncapaHim}.$perlvar{'lonHostID'}; |
Line 413 Returns 0 if successful, or -1 if not.
|
Line 422 Returns 0 if successful, or -1 if not.
|
sub Writable { |
sub Writable { |
my $self = shift; # Get reference to the object. |
my $self = shift; # Get reference to the object. |
my $socket = $self->{Socket}; |
my $socket = $self->{Socket}; |
my $nwritten = $socket->send($self->{TransactionRequest}, 0); |
my $nwritten; |
|
if ($socket) { |
|
eval { |
|
$nwritten = $socket->send($self->{TransactionRequest}, 0); |
|
} |
|
} else { |
|
# For whatever reason, there's no longer a socket left. |
|
|
|
|
|
$self->Transition("Disconnected"); |
|
return -1; |
|
} |
my $errno = $! + 0; |
my $errno = $! + 0; |
unless (defined $nwritten) { |
unless (defined $nwritten) { |
if($errno != POSIX::EINTR) { |
if($errno != POSIX::EINTR) { |
Line 516 timout, and to request writability notif
|
Line 536 timout, and to request writability notif
|
=cut |
=cut |
|
|
sub InitiateTransaction { |
sub InitiateTransaction { |
my $self = shift; |
|
my $data = shift; |
my ($self, $data) = @_; |
|
|
Debug(1, "initiating transaction: ".$data); |
Debug(1, "initiating transaction: ".$data); |
if($self->{State} ne "Idle") { |
if($self->{State} ne "Idle") { |
Line 568 established callback or undef if there w
|
Line 588 established callback or undef if there w
|
=cut |
=cut |
|
|
sub SetTimeoutCallback { |
sub SetTimeoutCallback { |
my $self = shift; |
|
my $callback = shift; |
my ($self, $callback) = @_; |
|
|
my $oldCallback = $self->{TimeoutCallback}; |
my $oldCallback = $self->{TimeoutCallback}; |
$self->{TimeoutCallback} = $callback; |
$self->{TimeoutCallback} = $callback; |
return $oldCallback; |
return $oldCallback; |
Line 697 The output string can be directly sent t
|
Line 718 The output string can be directly sent t
|
=cut |
=cut |
|
|
sub Encrypt { |
sub Encrypt { |
my $self = shift; # Reference to the object. |
|
my $request = shift; # Text to send. |
my ($self, $request) = @_; |
|
|
|
|
# Split the encrypt: off the request and figure out it's length. |
# Split the encrypt: off the request and figure out it's length. |
Line 740 Decrypt a response from the server. The
|
Line 761 Decrypt a response from the server. The
|
=cut |
=cut |
|
|
sub Decrypt { |
sub Decrypt { |
my $self = shift; # Recover reference to object |
|
my $encrypted = shift; # This is the encrypted data. |
my ($self, $encrypted) = @_; |
|
|
# Bust up the response into length, and encryptedstring: |
# Bust up the response into length, and encryptedstring: |
|
|