version 1.5, 2003/06/13 02:38:30
|
version 1.11, 2003/09/30 10:46:57
|
Line 27
|
Line 27
|
# |
# |
package LondConnection; |
package LondConnection; |
|
|
|
use strict; |
use IO::Socket; |
use IO::Socket; |
use IO::Socket::INET; |
use IO::Socket::INET; |
use IO::Handle; |
use IO::Handle; |
Line 37 use Crypt::IDEA;
|
Line 38 use Crypt::IDEA;
|
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
use LONCAPA::HashIterator; |
use LONCAPA::HashIterator; |
|
|
my $DebugLevel=4; |
my $DebugLevel=0; |
|
|
# Read the configuration file for apache to get the perl |
# Read the configuration file for apache to get the perl |
# variable set. |
# variable set. |
Line 70 Dump the internal state of the object: F
|
Line 71 Dump the internal state of the object: F
|
|
|
sub Dump { |
sub Dump { |
my $self = shift; |
my $self = shift; |
|
my $key; |
|
my $value; |
print "Dumping LondConnectionObject:\n"; |
print "Dumping LondConnectionObject:\n"; |
while(($key, $value) = each %$self) { |
while(($key, $value) = each %$self) { |
print "$key -> $value\n"; |
print "$key -> $value\n"; |
Line 145 sub new {
|
Line 148 sub new {
|
TimeoutCallback => undef, |
TimeoutCallback => undef, |
TransitionCallback => undef, |
TransitionCallback => undef, |
Timeoutable => 0, |
Timeoutable => 0, |
TimeoutValue => 60, |
TimeoutValue => 30, |
TimeoutRemaining => 0, |
TimeoutRemaining => 0, |
CipherKey => "", |
CipherKey => "", |
Cipher => undef}; |
Cipher => undef}; |
bless($self, $class); |
bless($self, $class); |
unless ($self->{Socket} = IO::Socket::INET->new(PeerHost => $self->{Host}, |
unless ($self->{Socket} = IO::Socket::INET->new(PeerHost => $self->{Host}, |
PeerPort => $self->{Port}, |
PeerPort => $self->{Port}, |
Type => SOCK_STREAM, |
Type => SOCK_STREAM, |
Proto => "tcp")) { |
Proto => "tcp", |
|
Timeout => 5)) { |
return undef; # Inidicates the socket could not be made. |
return undef; # Inidicates the socket could not be made. |
} |
} |
# |
# |
Line 161 sub new {
|
Line 165 sub new {
|
# |
# |
$self->Transition("Connected"); |
$self->Transition("Connected"); |
$self->{InformWritable} = 1; # When socket is writable we send init |
$self->{InformWritable} = 1; # When socket is writable we send init |
|
$self->{Timeoutable} = 1; # Timeout allowed during startup negotiation. |
$self->{TransactionRequest} = "init\n"; |
$self->{TransactionRequest} = "init\n"; |
|
|
# |
# |
# Set socket to nonblocking I/O. |
# Set socket to nonblocking I/O. |
# |
# |
my $socket = $self->{Socket}; |
my $socket = $self->{Socket}; |
$flags = fcntl($socket->fileno, F_GETFL,0); |
my $flags = fcntl($socket->fileno, F_GETFL,0); |
if($flags == -1) { |
if($flags == -1) { |
$socket->close; |
$socket->close; |
return undef; |
return undef; |
Line 215 sub Readable {
|
Line 220 sub Readable {
|
my $rv = $socket->recv($data, POSIX::BUFSIZ, 0); |
my $rv = $socket->recv($data, POSIX::BUFSIZ, 0); |
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, |
if(($errno == POSIX::EWOULDBLOCK) || |
if(($errno == POSIX::EWOULDBLOCK) || |
($errno == POSIX::EAGAIN) || |
($errno == POSIX::EAGAIN) || |
($errno == POSIX::EINTR) || |
($errno == POSIX::EINTR)) { |
($errno == 0)) { |
|
return 0; |
return 0; |
} |
} |
|
|
Line 237 sub Readable {
|
Line 241 sub Readable {
|
if($self->{TransactionReply} =~ /(.*\n)/) { |
if($self->{TransactionReply} =~ /(.*\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") { # Remote doesn't have |
if($self->{TransactionReply} eq "refused\n") { # Remote doesn't have |
|
|
$self->Transition("Disconnected"); # in host tables. |
$self->Transition("Disconnected"); # in host tables. |
$socket->close(); |
$socket->close(); |
Line 337 sub Writable {
|
Line 341 sub Writable {
|
} |
} |
|
|
} |
} |
if (($rv >= 0) || |
if (($nwritten >= 0) || |
($errno == POSIX::EWOULDBLOCK) || |
($errno == POSIX::EWOULDBLOCK) || |
($errno == POSIX::EAGAIN) || |
($errno == POSIX::EAGAIN) || |
($errno == POSIX::EINTR) || |
($errno == POSIX::EINTR) || |
Line 654 sub Decrypt {
|
Line 658 sub Decrypt {
|
# Decode the data in 8 byte blocks. The string is encoded |
# Decode the data in 8 byte blocks. The string is encoded |
# as hex digits so there are two characters per byte: |
# as hex digits so there are two characters per byte: |
|
|
$decrpyted = ""; |
my $decrypted = ""; |
for(my $index = 0; $index < length($EncryptedString); |
for(my $index = 0; $index < length($EncryptedString); |
$index += 16) { |
$index += 16) { |
$decrypted .= $self->{Cipher}->decrypt( |
$decrypted .= $self->{Cipher}->decrypt( |
Line 685 are used as follows:
|
Line 689 are used as follows:
|
[1] - LonCapa domain name. |
[1] - LonCapa domain name. |
[2] - Loncapa role (e.g. library or access). |
[2] - Loncapa role (e.g. library or access). |
[3] - DNS name server hostname. |
[3] - DNS name server hostname. |
[4] - IP address (result of e.g. nslooup [3]). |
[4] - IP address (result of e.g. nslookup [3]). |
[5] - Maximum connection count. |
[5] - Maximum connection count. |
[6] - Idle timeout for reducing connection count. |
[6] - Idle timeout for reducing connection count. |
[7] - Minimum connection count. |
[7] - Minimum connection count. |