version 1.1, 2003/04/18 02:39:57
|
version 1.41, 2006/08/11 20:07:52
|
Line 1
|
Line 1
|
# |
|
# This module defines and implements a class that represents |
# This module defines and implements a class that represents |
# a connection to a lond daemon. |
# a connection to a lond daemon. |
|
# |
|
# $Id$ |
|
# |
|
# Copyright Michigan State University Board of Trustees |
|
# |
|
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
|
# |
|
# LON-CAPA is free software; you can redistribute it and/or modify |
|
# it under the terms of the GNU General Public License as published by |
|
# the Free Software Foundation; either version 2 of the License, or |
|
# (at your option) any later version. |
|
# |
|
# LON-CAPA is distributed in the hope that it will be useful, |
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
# GNU General Public License for more details. |
|
# |
|
# You should have received a copy of the GNU General Public License |
|
# along with LON-CAPA; if not, write to the Free Software |
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
|
# |
|
# /home/httpd/html/adm/gpl.txt |
|
# |
|
# http://www.lon-capa.org/ |
|
# |
|
|
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 10 use IO::File;
|
Line 36 use IO::File;
|
use Fcntl; |
use Fcntl; |
use POSIX; |
use POSIX; |
use Crypt::IDEA; |
use Crypt::IDEA; |
use LONCAPA::Configuration; |
use LONCAPA::lonlocal; |
use LONCAPA::HashIterator; |
use LONCAPA::lonssl; |
|
|
|
|
my $DebugLevel=4; |
|
|
|
|
my $DebugLevel=0; |
|
my %hostshash; |
|
my %perlvar; |
|
my $LocalDns = ""; # Need not be defined for managers. |
|
my $InsecureOk; |
|
|
|
# |
|
# Set debugging level |
|
# |
|
sub SetDebug { |
|
$DebugLevel = shift; |
|
} |
|
|
|
# |
|
# The config read is done in this way to support the read of |
|
# the non-default configuration file in the |
|
# event we are being used outside of loncapa. |
|
# |
|
|
|
my $ConfigRead = 0; |
|
|
# Read the configuration file for apache to get the perl |
# Read the configuration file for apache to get the perl |
# variable set. |
# variables set. |
|
|
my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf'); |
sub ReadConfig { |
my %perlvar = %{$perlvarref}; |
Debug(8, "ReadConfig called"); |
my $hoststab = |
|
LONCAPA::Configuration::read_hosts( |
|
"$perlvar{'lonTabDir'}/hosts.tab") || |
|
die "Can't read host table!!"; |
|
my %hostshash = %{$hoststab}; |
|
|
|
close(CONFIG); |
my $perlvarref = read_conf('loncapa.conf'); |
|
%perlvar = %{$perlvarref}; |
|
my $hoststab = read_hosts( |
|
"$perlvar{lonTabDir}/hosts.tab") || |
|
die "Can't read host table!!"; |
|
%hostshash = %{$hoststab}; |
|
$ConfigRead = 1; |
|
|
|
my $myLonCapaName = $perlvar{lonHostID}; |
|
Debug(8, "My loncapa name is $myLonCapaName"); |
|
|
|
if(defined $hostshash{$myLonCapaName}) { |
|
Debug(8, "My loncapa name is in hosthash"); |
|
my @ConfigLine = @{$hostshash{$myLonCapaName}}; |
|
$LocalDns = $ConfigLine[3]; |
|
Debug(8, "Got local name $LocalDns"); |
|
} |
|
$InsecureOk = $perlvar{loncAllowInsecure}; |
|
|
|
Debug(3, "ReadConfig - LocalDNS = $LocalDns"); |
|
} |
|
|
|
# |
|
# Read a foreign configuration. |
|
# This sub is intended for the cases where the package |
|
# will be read from outside the LonCAPA environment, in that case |
|
# the client will need to explicitly provide: |
|
# - A file in hosts.tab format. |
|
# - Some idea of the 'lonCAPA' name of the local host (for building |
|
# the encryption key). |
|
# |
|
# Parameters: |
|
# MyHost - Name of this host as far as LonCAPA is concerned. |
|
# Filename - Name of a hosts.tab formatted file that will be used |
|
# to build up the hosts table. |
|
# |
|
sub ReadForeignConfig { |
|
|
|
my ($MyHost, $Filename) = @_; |
|
|
|
&Debug(4, "ReadForeignConfig $MyHost $Filename\n"); |
|
|
|
$perlvar{lonHostID} = $MyHost; # Rmember my host. |
|
my $hosttab = read_hosts($Filename) || |
|
die "Can't read hosts table!!"; |
|
%hostshash = %{$hosttab}; |
|
if($DebugLevel > 3) { |
|
foreach my $host (keys %hostshash) { |
|
print STDERR "host $host => $hostshash{$host}\n"; |
|
} |
|
} |
|
$ConfigRead = 1; |
|
|
|
my $myLonCapaName = $perlvar{lonHostID}; |
|
|
|
if(defined $hostshash{$myLonCapaName}) { |
|
my @ConfigLine = @{$hostshash{$myLonCapaName}}; |
|
$LocalDns = $ConfigLine[3]; |
|
} |
|
$InsecureOk = $perlvar{loncAllowInsecure}; |
|
|
|
Debug(3, "ReadForeignConfig - LocalDNS = $LocalDns"); |
|
|
|
} |
|
|
sub Debug { |
sub Debug { |
my $level = shift; |
|
my $message = shift; |
my ($level, $message) = @_; |
|
|
if ($level < $DebugLevel) { |
if ($level < $DebugLevel) { |
print($message."\n"); |
print STDERR ($message."\n"); |
} |
} |
} |
} |
=pod |
|
Dump the internal state of the object: For debugging purposes. |
=pod |
|
|
|
=head2 Dump |
|
|
|
Dump the internal state of the object: For debugging purposes, to stderr. |
|
|
=cut |
=cut |
|
|
sub Dump { |
sub Dump { |
my $self = shift; |
my $self = shift; |
print "Dumping LondConnectionObject:\n"; |
my $level = shift; |
|
my $now = time; |
|
my $local = localtime($now); |
|
|
|
if ($level >= $DebugLevel) { |
|
return; |
|
} |
|
|
|
|
|
my $key; |
|
my $value; |
|
print STDERR "[ $local ] Dumping LondConnectionObject:\n"; |
|
print STDERR join(':',caller(1))."\n"; |
while(($key, $value) = each %$self) { |
while(($key, $value) = each %$self) { |
print "$key -> $value\n"; |
print STDERR "$key -> $value\n"; |
} |
} |
print "-------------------------------\n"; |
print STDERR "-------------------------------\n"; |
} |
} |
|
|
=pod |
=pod |
Local function to do a state transition. If the state transition callback |
|
is defined it is called with two parameters: the self and the old state. |
Local function to do a state transition. If the state transition |
|
callback is defined it is called with two parameters: the self and the |
|
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 63 sub Transition {
|
Line 192 sub Transition {
|
} |
} |
} |
} |
|
|
|
|
|
|
=pod |
=pod |
Construct a new lond connection. |
|
Parameters (besides the class name) include: |
=head2 new |
=item hostname - host the remote lond is on. |
|
This host is a host in the hosts.tab file |
Construct a new lond connection. |
=item port - port number the remote lond is listening on. |
|
|
Parameters (besides the class name) include: |
|
|
|
=item hostname |
|
|
|
host the remote lond is on. This host is a host in the hosts.tab file |
|
|
|
=item port |
|
|
|
port number the remote lond is listening on. |
|
|
=cut |
=cut |
|
|
sub new { |
sub new { |
my $class = shift; # class name. |
my ($class, $DnsName, $Port) = @_; |
my $Hostname = shift; # Name of host to connect to. |
|
my $Port = shift; # Port to connect |
if (!$ConfigRead) { |
&Debug(4,$class."::new( ".$Hostname.",".$Port.")\n"); |
ReadConfig(); |
|
$ConfigRead = 1; |
|
} |
|
&Debug(4,$class."::new( ".$DnsName.",".$Port.")\n"); |
|
|
# The host must map to an entry in the hosts table: |
# The host must map to an entry in the hosts table: |
# We connect to the dns host that corresponds to that |
# We connect to the dns host that corresponds to that |
Line 82 sub new {
|
Line 227 sub new {
|
# negotion. In the objec these become the Host and |
# negotion. In the objec these become the Host and |
# LoncapaHim fields of the object respectively. |
# LoncapaHim fields of the object respectively. |
# |
# |
if (!exists $hostshash{$Hostname}) { |
if (!exists $hostshash{$DnsName}) { |
|
&Debug(8, "No Such host $DnsName"); |
return undef; # No such host!!! |
return undef; # No such host!!! |
} |
} |
my @ConfigLine = @{$hostshash{$Hostname}}; |
my @ConfigLine = @{$hostshash{$DnsName}}; |
my $DnsName = $ConfigLine[3]; # 4'th item is dns of host. |
my $Hostname = $ConfigLine[0]; # 0'th item is the msu id of host. |
Debug(5, "Connecting to ".$DnsName); |
Debug(5, "Connecting to ".$DnsName); |
|
# if it is me use loopback for connection |
|
if ($DnsName eq $LocalDns) { $DnsName="127.0.0.1"; } |
|
Debug(8, "Connecting to $DnsName I am $LocalDns"); |
# Now create the object... |
# Now create the object... |
my $self = { Host => $DnsName, |
my $self = { Host => $DnsName, |
LoncapaHim => $Hostname, |
LoncapaHim => $Hostname, |
Port => $Port, |
Port => $Port, |
State => "Initialized", |
State => "Initialized", |
TransactionRequest => "", |
AuthenticationMode => "", |
TransactionReply => "", |
TransactionRequest => "", |
InformReadable => 0, |
TransactionReply => "", |
InformWritable => 0, |
NextRequest => "", |
TimeoutCallback => undef, |
InformReadable => 0, |
TransitionCallback => undef, |
InformWritable => 0, |
Timeoutable => 0, |
TimeoutCallback => undef, |
TimeoutValue => 60, |
TransitionCallback => undef, |
TimeoutRemaining => 0, |
Timeoutable => 0, |
CipherKey => "", |
TimeoutValue => 30, |
Cipher => undef}; |
TimeoutRemaining => 0, |
|
LocalKeyFile => "", |
|
CipherKey => "", |
|
LondVersion => "Unknown", |
|
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 => 3)) { |
|
Debug(8, "Error? \n$@ \n$!"); |
return undef; # Inidicates the socket could not be made. |
return undef; # Inidicates the socket could not be made. |
} |
} |
|
my $socket = $self->{Socket}; # For local use only. |
|
# If we are local, we'll first try local auth mode, otherwise, we'll try |
|
# the ssl auth mode: |
|
|
|
my $key; |
|
my $keyfile; |
|
if ($DnsName eq '127.0.0.1') { |
|
$self->{AuthenticationMode} = "local"; |
|
($key, $keyfile) = lonlocal::CreateKeyFile(); |
|
Debug(8, "Local key: $key, stored in $keyfile"); |
|
|
|
# If I can't make the key file fall back to insecure if |
|
# allowed...else give up right away. |
|
|
|
if(!(defined $key) || !(defined $keyfile)) { |
|
if($InsecureOk) { |
|
$self->{AuthenticationMode} = "insecure"; |
|
$self->{TransactionRequest} = "init\n"; |
|
} |
|
else { |
|
$socket->close; |
|
return undef; |
|
} |
|
} |
|
$self->{TransactionRequest} = "init:local:$keyfile\n"; |
|
Debug(9, "Init string is init:local:$keyfile"); |
|
if(!$self->CreateCipher($key)) { # Nothing's going our way... |
|
$socket->close; |
|
return undef; |
|
} |
|
|
|
} |
|
else { |
|
# Remote peer: I'd like to do ssl, but if my host key or certificates |
|
# are not all installed, my only choice is insecure, if that's |
|
# allowed: |
|
|
|
my ($ca, $cert) = lonssl::CertificateFile; |
|
my $sslkeyfile = lonssl::KeyFile; |
|
|
|
if((defined $ca) && (defined $cert) && (defined $sslkeyfile)) { |
|
|
|
$self->{AuthenticationMode} = "ssl"; |
|
$self->{TransactionRequest} = "init:ssl\n"; |
|
} else { |
|
if($InsecureOk) { # Allowed to do insecure: |
|
$self->{AuthenticationMode} = "insecure"; |
|
$self->{TransactionRequest} = "init\n"; |
|
} |
|
else { # Not allowed to do insecure... |
|
$socket->close; |
|
return undef; |
|
} |
|
} |
|
} |
|
|
# |
# |
# We're connected. Set the state, and the events we'll accept: |
# We're connected. Set the state, and the events we'll accept: |
# |
# |
$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->{TransactionRequest} = "init\n"; |
$self->{Timeoutable} = 1; # Timeout allowed during startup negotiation. |
|
|
|
|
# |
# |
# 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, F_GETFL,0); |
if($flags == -1) { |
if(!$flags) { |
$socket->close; |
$socket->close; |
return undef; |
return undef; |
} |
} |
if(fcntl($socket, F_SETFL, $flags | O_NONBLOCK) == -1) { |
if(!fcntl($socket, F_SETFL, $flags | O_NONBLOCK)) { |
$socket->close; |
$socket->close; |
return undef; |
return undef; |
} |
} |
|
|
# return the object : |
# return the object : |
|
|
|
Debug(9, "Initial object state: "); |
|
$self->Dump(9); |
|
|
return $self; |
return $self; |
} |
} |
|
|
=pod |
=pod |
This member should be called when the Socket becomes readable. |
|
Until the read completes, action is state independet. Data are accepted |
=head2 Readable |
into the TransactionReply until a newline character is received. At that |
|
time actionis state dependent: |
This member should be called when the Socket becomes readable. Until |
=item Connected: in this case we received challenge, the state changes |
the read completes, action is state independet. Data are accepted into |
to ChallengeReceived, and we initiate a send with the challenge response. |
the TransactionReply until a newline character is received. At that |
=item ReceivingReply: In this case a reply has been received for a transaction, |
time actionis state dependent: |
the state goes to Idle and we disable write and read notification. |
|
=item ChallengeReeived: we just got what should be an ok\n and the |
=item Connected |
connection can now handle transactions. |
|
|
in this case we received challenge, the state changes to |
|
ChallengeReceived, and we initiate a send with the challenge response. |
|
|
|
=item ReceivingReply |
|
|
|
In this case a reply has been received for a transaction, the state |
|
goes to Idle and we disable write and read notification. |
|
|
|
=item ChallengeReeived |
|
|
|
we just got what should be an ok\n and the connection can now handle |
|
transactions. |
|
|
=cut |
=cut |
|
|
sub Readable { |
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; |
|
my $ConnectionMode = $self->{AuthenticationMode}; |
|
|
|
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, |
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 175 sub Readable {
|
Line 413 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") { # Remote doesn't have |
# Our init was replied to. What happens next depends both on |
|
# the actual init we sent (AuthenticationMode member data) |
$self->Transition("Disconnected"); # in host tables. |
# and the response: |
|
# AuthenticationMode == local: |
|
# Response ok: The key has been exchanged and |
|
# the key file destroyed. We can jump |
|
# into setting the host and requesting the |
|
# Later we'll also bypass key exchange. |
|
# Response digits: |
|
# Old style lond. Delete the keyfile. |
|
# If allowed fall back to insecure mode. |
|
# else close connection and fail. |
|
# Response other: |
|
# Failed local auth |
|
# Close connection and fail. |
|
# |
|
# AuthenticationMode == ssl: |
|
# Response ok:ssl |
|
# Response digits: |
|
# Response other: |
|
# Authentication mode == insecure |
|
# Response digits |
|
# Response other: |
|
|
|
my $Response = $self->{TransactionReply}; |
|
if($ConnectionMode eq "local") { |
|
if($Response =~ /^ok:local/) { # Good local auth. |
|
$self->ToVersionRequest(); |
|
return 0; |
|
} |
|
elsif ($Response =~/^[0-9]+/) { # Old style lond. |
|
return $self->CompleteInsecure(); |
|
|
|
} |
|
else { # Complete flop |
|
&Debug(3, "init:local : unrecognized reply"); |
|
$self->Transition("Disconnected"); |
|
$socket->close; |
|
return -1; |
|
} |
|
} |
|
elsif ($ConnectionMode eq "ssl") { |
|
if($Response =~ /^ok:ssl/) { # Good ssl... |
|
if($self->ExchangeKeysViaSSL()) { # Success skip to vsn stuff |
|
# Need to reset to non blocking: |
|
|
|
my $flags = fcntl($socket, F_GETFL, 0); |
|
fcntl($socket, F_SETFL, $flags | O_NONBLOCK); |
|
$self->ToVersionRequest(); |
|
return 0; |
|
} |
|
else { # Failed in ssl exchange. |
|
&Debug(3,"init:ssl failed key negotiation!"); |
|
$self->Transition("Disconnected"); |
|
$socket->close; |
|
return -1; |
|
} |
|
} |
|
elsif ($Response =~ /^[0-9]+/) { # Old style lond. |
|
return $self->CompleteInsecure(); |
|
} |
|
else { # Complete flop |
|
} |
|
} |
|
elsif ($ConnectionMode eq "insecure") { |
|
if($self->{TransactionReply} eq "refused\n") { # Remote doesn't have |
|
|
|
$self->Transition("Disconnected"); # in host tables. |
|
$socket->close(); |
|
return -1; |
|
|
|
} |
|
return $self->CompleteInsecure(); |
|
} |
|
else { |
|
&Debug(1,"Authentication mode incorrect"); |
|
die "BUG!!! LondConnection::Readable invalid authmode"; |
|
} |
|
|
|
|
|
} elsif ($self->{State} eq "ChallengeReplied") { |
|
if($self->{TransactionReply} ne "ok\n") { |
|
$self->Transition("Disconnected"); |
$socket->close(); |
$socket->close(); |
return -1; |
return -1; |
} |
} |
|
$self->ToVersionRequest(); |
|
return 0; |
|
|
&Debug(8," Transition out of Initialized"); |
} elsif ($self->{State} eq "ReadingVersionString") { |
$self->{TransactionRequest} = $self->{TransactionReply}; |
chomp($self->{TransactionReply}); |
$self->{InformWritable} = 1; |
$self->{LondVersion} = $self->{TransactionReply}; |
$self->{InformReadable} = 0; |
$self->Transition("SetHost"); |
$self->Transition("ChallengeReceived"); |
$self->{InformReadable} = 0; |
$self->{TimeoutRemaining} = $self->{TimeoutValue}; |
$self->{InformWritable} = 1; |
|
my $peer = $self->{LoncapaHim}; |
|
$self->{TransactionRequest}= "sethost:$peer\n"; |
return 0; |
return 0; |
} elsif ($self->{State} eq "ChallengeReplied") { # should be ok. |
} elsif ($self->{State} eq "HostSet") { # should be ok. |
if($self->{TransactionReply} != "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"); |
# If the auth mode is insecure we must still |
$self->{InformReadable} = 0; |
# exchange session keys. Otherwise, |
$self->{InformWritable} = 1; |
# we can just transition to idle. |
$self->{TransactionRequest} = "ekey\n"; |
|
return 0; |
if($ConnectionMode eq "insecure") { |
|
$self->Transition("RequestingKey"); |
|
$self->{InformReadable} = 0; |
|
$self->{InformWritable} = 1; |
|
$self->{TransactionRequest} = "ekey\n"; |
|
return 0; |
|
} |
|
else { |
|
$self->ToIdle(); |
|
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'}; |
$key=~tr/a-z/A-Z/; |
$key=~tr/a-z/A-Z/; |
$key=~tr/G-P/0-9/; |
$key=~tr/G-P/0-9/; |
$key=~tr/Q-Z/0-9/; |
$key=~tr/Q-Z/0-9/; |
$key=$key.$buildkey.$key.$buildkey.$key.$buildkey; |
$key =$key.$buildkey.$key.$buildkey.$key.$buildkey; |
$key=substr($key,0,32); |
$key = substr($key,0,32); |
my $cipherkey=pack("H32",$key); |
if(!$self->CreateCipher($key)) { |
$self->{Cipher} = new IDEA $cipherkey; |
|
if($self->{Cipher} == undef) { |
|
$self->Transition("Disconnected"); |
$self->Transition("Disconnected"); |
$socket->close(); |
$socket->close(); |
return -1; |
return -1; |
} else { |
} else { |
$self->Transition("Idle"); |
$self->ToIdle(); |
$self->{InformWritable} = 0; |
|
$self->{InformReadable} = 0; |
|
$self->{Timeoutable} = 0; |
|
return 0; |
return 0; |
} |
} |
} elsif ($self->{State} eq "ReceivingReply") { |
} elsif ($self->{State} eq "ReceivingReply") { |
Line 231 sub Readable {
|
Line 560 sub Readable {
|
my $answer = $self->{TransactionReply}; |
my $answer = $self->{TransactionReply}; |
if($answer =~ /^enc\:/) { |
if($answer =~ /^enc\:/) { |
$answer = $self->Decrypt($answer); |
$answer = $self->Decrypt($answer); |
$self->{TransactionReply} = $answer; |
$self->{TransactionReply} = "$answer\n"; |
} |
} |
|
# if we have a NextRequest do it immeadiately |
|
if ($self->{NextRequest}) { |
|
$self->{TransactionRequest} = $self->{NextRequest}; |
|
undef( $self->{NextRequest} ); |
|
$self->{TransactionReply} = ""; |
|
$self->{InformWritable} = 1; |
|
$self->{InformReadable} = 0; |
|
$self->{Timeoutable} = 1; |
|
$self->{TimeoutRemaining} = $self->{TimeoutValue}; |
|
$self->Transition("SendingRequest"); |
|
return 0; |
|
} else { |
# finish the transaction |
# finish the transaction |
|
|
$self->{InformWritable} = 0; |
$self->ToIdle(); |
$self->{InformReadable} = 0; |
return 0; |
$self->{Timeoutable} = 0; |
} |
$self->Transition("Idle"); |
|
return 0; |
|
} elsif ($self->{State} eq "Disconnected") { # No connection. |
} elsif ($self->{State} eq "Disconnected") { # No connection. |
return -1; |
return -1; |
} else { # Internal error: Invalid state. |
} else { # Internal error: Invalid state. |
Line 256 sub Readable {
|
Line 594 sub Readable {
|
|
|
|
|
=pod |
=pod |
This member should be called when the Socket becomes writable. |
|
The action is state independent. An attempt is made to drain the contents of |
This member should be called when the Socket becomes writable. |
the TransactionRequest member. Once this is drained, we mark the object |
|
as waiting for readability. |
The action is state independent. An attempt is made to drain the |
|
contents of the TransactionRequest member. Once this is drained, we |
|
mark the object as waiting for readability. |
|
|
Returns 0 if successful, or -1 if not. |
Returns 0 if successful, or -1 if not. |
|
|
=cut |
=cut |
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 276 sub Writable {
|
Line 627 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) || |
($errno == 0)) { |
($errno == 0)) { |
substr($self->{TransactionRequest}, 0, $nwritten) = ""; # rmv written part |
substr($self->{TransactionRequest}, 0, $nwritten) = ""; # rmv written part |
if(length $self->{TransactionRequest} == 0) { |
if(length $self->{TransactionRequest} == 0) { |
$self->{InformWritable} = 0; |
$self->{InformWritable} = 0; |
$self->{InformReadable} = 1; |
$self->{InformReadable} = 1; |
$self->{TransactionReply} = ''; |
$self->{TransactionReply} = ''; |
# |
# |
# Figure out the next state: |
# Figure out the next state: |
# |
# |
if($self->{State} eq "Connected") { |
if($self->{State} eq "Connected") { |
$self->Transition("Initialized"); |
$self->Transition("Initialized"); |
} elsif($self->{State} eq "ChallengeReceived") { |
} elsif($self->{State} eq "ChallengeReceived") { |
$self->Transition("ChallengeReplied"); |
$self->Transition("ChallengeReplied"); |
} elsif($self->{State} eq "RequestingKey") { |
} elsif($self->{State} eq "RequestingVersion") { |
$self->Transition("ReceivingKey"); |
$self->Transition("ReadingVersionString"); |
$self->{InformWritable} = 0; |
} elsif ($self->{State} eq "SetHost") { |
$self->{InformReadable} = 1; |
$self->Transition("HostSet"); |
$self->{TransactionReply} = ''; |
} elsif($self->{State} eq "RequestingKey") { |
} elsif ($self->{State} eq "SendingRequest") { |
$self->Transition("ReceivingKey"); |
$self->Transition("ReceivingReply"); |
# $self->{InformWritable} = 0; |
$self->{TimeoutRemaining} = $self->{TimeoutValue}; |
# $self->{InformReadable} = 1; |
} elsif ($self->{State} eq "Disconnected") { |
# $self->{TransactionReply} = ''; |
return -1; |
} elsif ($self->{State} eq "SendingRequest") { |
} |
$self->Transition("ReceivingReply"); |
return 0; |
$self->{TimeoutRemaining} = $self->{TimeoutValue}; |
} |
} elsif ($self->{State} eq "Disconnected") { |
} else { # The write failed (e.g. partner disconnected). |
return -1; |
$self->Transition("Disconnected"); |
} |
$socket->close(); |
return 0; |
return -1; |
} |
} |
} else { # The write failed (e.g. partner disconnected). |
|
$self->Transition("Disconnected"); |
|
$socket->close(); |
|
return -1; |
|
} |
|
|
} |
} |
=pod |
=pod |
|
|
|
=head2 Tick |
|
|
Tick is called every time unit by the event framework. It |
Tick is called every time unit by the event framework. It |
1. decrements the remaining timeout. |
|
2. If the timeout is zero, calls TimedOut indicating that the |
=item 1 decrements the remaining timeout. |
current operation timed out. |
|
|
=item 2 If the timeout is zero, calls TimedOut indicating that the current operation timed out. |
|
|
=cut |
=cut |
|
|
Line 328 sub Tick {
|
Line 687 sub Tick {
|
$self->TimedOut(); |
$self->TimedOut(); |
} |
} |
} |
} |
|
|
=pod |
=pod |
TimedOut - called on a timeout. If the timeout callback is defined, |
|
it is called with $self as its parameters. |
|
|
|
=cut |
=head2 TimedOut |
|
|
|
called on a timeout. If the timeout callback is defined, it is called |
|
with $self as its parameters. |
|
|
|
=cut |
|
|
sub TimedOut { |
sub TimedOut { |
|
|
my $self = shift; |
my $self = shift; |
Line 342 sub TimedOut {
|
Line 706 sub TimedOut {
|
&$callback(@args); |
&$callback(@args); |
} |
} |
} |
} |
|
|
=pod |
=pod |
Called to initiate a transaction. A transaction can only be initiated |
|
when the object is idle... otherwise an error is returned. |
=head2 InitiateTransaction |
A transaction consists of a request to the server that will have a reply. |
|
This member sets the request data in the TransactionRequest member, |
Called to initiate a transaction. A transaction can only be initiated |
makes the state SendingRequest and sets the data to allow a timout, |
when the object is idle... otherwise an error is returned. A |
and to request writability notification. |
transaction consists of a request to the server that will have a |
|
reply. This member sets the request data in the TransactionRequest |
|
member, makes the state SendingRequest and sets the data to allow a |
|
timout, and to request writability notification. |
|
|
=cut |
=cut |
|
|
sub InitiateTransaction { |
sub InitiateTransaction { |
my $self = shift; |
|
my $data = shift; |
|
|
|
|
my ($self, $data) = @_; |
|
|
|
Debug(1, "initiating transaction: ".$data); |
if($self->{State} ne "Idle") { |
if($self->{State} ne "Idle") { |
|
Debug(0," .. but not idle here\n"); |
return -1; # Error indicator. |
return -1; # Error indicator. |
} |
} |
# if the transaction is to be encrypted encrypt the data: |
# if the transaction is to be encrypted encrypt the data: |
|
(my $sethost, my $server,$data)=split(/:/,$data,3); |
|
|
if($data =~ /^encrypt\:/) { |
if($data =~ /^encrypt\:/) { |
$data = $self->Encrypt($data); |
$data = $self->Encrypt($data); |
} |
} |
|
|
# Setup the trasaction |
# Setup the trasaction |
|
# currently no version of lond supports inlining the sethost |
$self->{TransactionRequest} = $data; |
if ($self->PeerVersion() <= 321) { |
|
if ($server ne $self->{LoncapaHim}) { |
|
$self->{NextRequest} = $data; |
|
$self->{TransactionRequest} = "$sethost:$server\n"; |
|
$self->{LoncapaHim} = $server; |
|
} else { |
|
$self->{TransactionRequest} = $data; |
|
} |
|
} else { |
|
$self->{LoncapaHim} = $server; |
|
$self->{TransactionRequest} = "$sethost:$server:$data"; |
|
} |
$self->{TransactionReply} = ""; |
$self->{TransactionReply} = ""; |
$self->{InformWritable} = 1; |
$self->{InformWritable} = 1; |
$self->{InformReadable} = 0; |
$self->{InformReadable} = 0; |
Line 376 sub InitiateTransaction {
|
Line 760 sub InitiateTransaction {
|
|
|
|
|
=pod |
=pod |
Sets a callback for state transitions. Returns a reference to any |
|
prior established callback, or undef if there was none: |
=head2 SetStateTransitionCallback |
|
|
|
Sets a callback for state transitions. Returns a reference to any |
|
prior established callback, or undef if there was none: |
|
|
=cut |
=cut |
|
|
sub SetStateTransitionCallback { |
sub SetStateTransitionCallback { |
my $self = shift; |
my $self = shift; |
my $oldCallback = $self->{TransitionCallback}; |
my $oldCallback = $self->{TransitionCallback}; |
$self->{TransitionCallback} = shift; |
$self->{TransitionCallback} = shift; |
return $oldCallback; |
return $oldCallback; |
} |
} |
|
|
=pod |
=pod |
Sets the timeout callback. Returns a reference to any prior established |
|
callback or undef if there was none. |
=head2 SetTimeoutCallback |
|
|
|
Sets the timeout callback. Returns a reference to any prior |
|
established callback or undef if there was none. |
|
|
=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; |
} |
} |
|
|
=pod |
=pod |
GetState - selector for the object state. |
|
|
=head2 Shutdown: |
|
|
|
Shuts down the socket. |
|
|
=cut |
=cut |
|
|
|
sub Shutdown { |
|
my $self = shift; |
|
my $socket = $self->GetSocket(); |
|
Debug(5,"socket is -$socket-"); |
|
if ($socket) { |
|
# Ask lond to exit too. Non blocking so |
|
# there is no cost for failure. |
|
eval { |
|
$socket->send("exit\n", 0); |
|
$socket->shutdown(2); |
|
} |
|
} |
|
} |
|
|
|
=pod |
|
|
|
=head2 GetState |
|
|
|
selector for the object state. |
|
|
|
=cut |
|
|
sub GetState { |
sub GetState { |
my $self = shift; |
my $self = shift; |
return $self->{State}; |
return $self->{State}; |
} |
} |
|
|
=pod |
=pod |
GetSocket - selector for the object socket. |
|
|
=head2 GetSocket |
|
|
|
selector for the object socket. |
|
|
=cut |
=cut |
|
|
sub GetSocket { |
sub GetSocket { |
my $self = shift; |
my $self = shift; |
return $self->{Socket}; |
return $self->{Socket}; |
} |
} |
|
|
|
|
=pod |
=pod |
Return the state of the flag that indicates the object wants to be |
|
called when readable. |
=head2 WantReadable |
|
|
|
Return the state of the flag that indicates the object wants to be |
|
called when readable. |
|
|
=cut |
=cut |
|
|
sub WantReadable { |
sub WantReadable { |
my $self = shift; |
my $self = shift; |
|
|
return $self->{InformReadable}; |
return $self->{InformReadable}; |
} |
} |
|
|
=pod |
=pod |
Return the state of the flag that indicates the object wants write |
|
notification. |
=head2 WantWritable |
|
|
|
Return the state of the flag that indicates the object wants write |
|
notification. |
|
|
=cut |
=cut |
|
|
sub WantWritable { |
sub WantWritable { |
my $self = shift; |
my $self = shift; |
return $self->{InformWritable}; |
return $self->{InformWritable}; |
} |
} |
|
|
=pod |
=pod |
return the state of the flag that indicates the object wants to be informed |
|
of timeouts. |
=head2 WantTimeout |
|
|
|
return the state of the flag that indicates the object wants to be |
|
informed of timeouts. |
|
|
=cut |
=cut |
|
|
sub WantTimeout { |
sub WantTimeout { |
my $self = shift; |
my $self = shift; |
return $self->{Timeoutable}; |
return $self->{Timeoutable}; |
} |
} |
|
|
=pod |
=pod |
Returns the reply from the last transaction. |
|
|
=head2 GetReply |
|
|
|
Returns the reply from the last transaction. |
|
|
=cut |
=cut |
|
|
sub GetReply { |
sub GetReply { |
my $self = shift; |
my $self = shift; |
return $self->{TransactionReply}; |
return $self->{TransactionReply}; |
} |
} |
|
|
=pod |
=pod |
Returns the encrypted version of the command string. |
|
The command input string is of the form: |
=head2 Encrypt |
|
|
|
Returns the encrypted version of the command string. |
|
|
|
The command input string is of the form: |
|
|
encrypt:command |
encrypt:command |
The output string can be directly sent to lond as it's of the form: |
|
|
The output string can be directly sent to lond as it is of the form: |
|
|
enc:length:<encodedrequest> |
enc:length:<encodedrequest> |
' |
|
=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 485 sub Encrypt {
|
Line 946 sub Encrypt {
|
|
|
|
|
} |
} |
=pod |
|
Decrypt |
=pod |
Decrypt a response from the server. The response is in the form: |
|
enc:<length>:<encrypted data> |
=head2 Decrypt |
|
|
|
Decrypt a response from the server. The response is in the form: |
|
|
|
enc:<length>:<encrypted data> |
|
|
=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: |
|
|
Line 502 sub Decrypt {
|
Line 969 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 515 sub Decrypt {
|
Line 982 sub Decrypt {
|
# $length tells us the actual length of the decrypted string: |
# $length tells us the actual length of the decrypted string: |
|
|
$decrypted = substr($decrypted, 0, $length); |
$decrypted = substr($decrypted, 0, $length); |
|
Debug(9, "Decrypted $EncryptedString to $decrypted"); |
|
|
return $decrypted; |
return $decrypted; |
|
|
} |
} |
|
# ToIdle |
|
# Called to transition to idle... done enough it's worth subbing |
|
# off to ensure it's always done right!! |
|
# |
|
sub ToIdle { |
|
my $self = shift; |
|
|
|
$self->Transition("Idle"); |
|
$self->{InformWritiable} = 0; |
|
$self->{InformReadable} = 0; |
|
$self->{Timeoutable} = 0; |
|
} |
|
|
|
# ToVersionRequest |
|
# Called to transition to "RequestVersion" also done a few times |
|
# so worth subbing out. |
|
# |
|
sub ToVersionRequest { |
|
my $self = shift; |
|
|
|
$self->Transition("RequestingVersion"); |
|
$self->{InformReadable} = 0; |
|
$self->{InformWritable} = 1; |
|
$self->{TransactionRequest} = "version\n"; |
|
|
|
} |
|
# |
|
# CreateCipher |
|
# Given a cipher key stores the key in the object context, |
|
# creates the cipher object, (stores that in object context), |
|
# This is done a couple of places, so it's worth factoring it out. |
|
# |
|
# Parameters: |
|
# (self) |
|
# key - The Cipher key. |
|
# |
|
# Returns: |
|
# 0 - Failure to create IDEA cipher. |
|
# 1 - Success. |
|
# |
|
sub CreateCipher { |
|
my ($self, $key) = @_; # According to coding std. |
|
|
|
$self->{CipherKey} = $key; # Save the text key... |
|
my $packedkey = pack ("H32", $key); |
|
my $cipher = new IDEA $packedkey; |
|
if($cipher) { |
|
$self->{Cipher} = $cipher; |
|
Debug("Cipher created dumping socket: "); |
|
$self->Dump(9); |
|
return 1; |
|
} |
|
else { |
|
return 0; |
|
} |
|
} |
|
# ExchangeKeysViaSSL |
|
# Called to do cipher key exchange via SSL. |
|
# The socket is promoted to an SSL socket. If that's successful, |
|
# we read out cipher key through the socket and create an IDEA |
|
# cipher object. |
|
# Parameters: |
|
# (self) |
|
# Returns: |
|
# true - Success. |
|
# false - Failure. |
|
# |
|
# Assumptions: |
|
# 1. The ssl session setup has timeout logic built in so we don't |
|
# have to worry about DOS attacks at that stage. |
|
# 2. If the ssl session gets set up we are talking to a legitimate |
|
# lond so again we don't have to worry about DOS attacks. |
|
# All this allows us just to call |
|
sub ExchangeKeysViaSSL { |
|
my $self = shift; |
|
my $socket = $self->{Socket}; |
|
|
|
# Get our signed certificate, the certificate authority's |
|
# certificate and our private key file. All of these |
|
# are needed to create the ssl connection. |
|
|
|
my ($SSLCACertificate, |
|
$SSLCertificate) = lonssl::CertificateFile(); |
|
my $SSLKey = lonssl::KeyFile(); |
|
|
|
# Promote our connection to ssl and read the key from lond. |
|
|
|
my $SSLSocket = lonssl::PromoteClientSocket($socket, |
|
$SSLCACertificate, |
|
$SSLCertificate, |
|
$SSLKey); |
|
if(defined $SSLSocket) { |
|
my $key = <$SSLSocket>; |
|
lonssl::Close($SSLSocket); |
|
if($key) { |
|
chomp($key); # \n is not part of the key. |
|
return $self->CreateCipher($key); |
|
} |
|
else { |
|
Debug(3, "Failed to read ssl key"); |
|
return 0; |
|
} |
|
} |
|
else { |
|
# Failed!! |
|
Debug(3, "Failed to negotiate SSL connection!"); |
|
return 0; |
|
} |
|
# should not get here |
|
return 0; |
|
|
|
} |
|
|
|
|
|
|
|
# |
|
# CompleteInsecure: |
|
# This function is called to initiate the completion of |
|
# insecure challenge response negotiation. |
|
# To do this, we copy the challenge string to the transaction |
|
# request, flip to writability and state transition to |
|
# ChallengeReceived.. |
|
# All this is only possible if InsecureOk is true. |
|
# Parameters: |
|
# (self) - This object's context hash. |
|
# Return: |
|
# 0 - Ok to transition. |
|
# -1 - Not ok to transition (InsecureOk not ok). |
|
# |
|
sub CompleteInsecure { |
|
my $self = shift; |
|
if($InsecureOk) { |
|
$self->{AuthenticationMode} = "insecure"; |
|
&Debug(8," Transition out of Initialized:insecure"); |
|
$self->{TransactionRequest} = $self->{TransactionReply}; |
|
$self->{InformWritable} = 1; |
|
$self->{InformReadable} = 0; |
|
$self->Transition("ChallengeReceived"); |
|
$self->{TimeoutRemaining} = $self->{TimeoutValue}; |
|
return 0; |
|
|
|
|
|
} |
|
else { |
|
&Debug(3, "Insecure key negotiation disabled!"); |
|
my $socket = $self->{Socket}; |
|
$socket->close; |
|
return -1; |
|
} |
|
} |
|
|
=pod |
=pod |
=head GetHostIterator |
|
|
=head2 GetHostIterator |
|
|
Returns a hash iterator to the host information. Each get from |
Returns a hash iterator to the host information. Each get from |
this iterator returns a reference to an array that contains |
this iterator returns a reference to an array that contains |
information read from the hosts configuration file. Array elements |
information read from the hosts configuration file. Array elements |
are used as follows: |
are used as follows: |
|
|
[0] - LonCapa host name. |
[0] - LonCapa host id. |
[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. |
|
|
|
|
=cut |
=cut |
|
|
sub GetHostIterator { |
sub GetHostIterator { |
|
|
return HashIterator->new(\%hostshash); |
return HashIterator->new(\%hostshash); |
} |
} |
|
|
|
########################################################### |
|
# |
|
# The following is an unashamed kludge that is here to |
|
# allow LondConnection to be used outside of the |
|
# loncapa environment (e.g. by lonManage). |
|
# |
|
# This is a textual inclusion of pieces of the |
|
# Configuration.pm module. |
|
# |
|
|
|
|
|
my $confdir='/etc/httpd/conf/'; |
|
|
|
# ------------------- Subroutine read_conf: read LON-CAPA server configuration. |
|
# This subroutine reads PerlSetVar values out of specified web server |
|
# configuration files. |
|
sub read_conf |
|
{ |
|
my (@conf_files)=@_; |
|
my %perlvar; |
|
foreach my $filename (@conf_files,'loncapa_apache.conf') |
|
{ |
|
if($DebugLevel > 3) { |
|
print STDERR ("Going to read $confdir.$filename\n"); |
|
} |
|
open(CONFIG,'<'.$confdir.$filename) or |
|
die("Can't read $confdir$filename"); |
|
while (my $configline=<CONFIG>) |
|
{ |
|
if ($configline =~ /^[^\#]*PerlSetVar/) |
|
{ |
|
my ($unused,$varname,$varvalue)=split(/\s+/,$configline); |
|
chomp($varvalue); |
|
$perlvar{$varname}=$varvalue; |
|
} |
|
} |
|
close(CONFIG); |
|
} |
|
if($DebugLevel > 3) { |
|
print STDERR "Dumping perlvar:\n"; |
|
foreach my $var (keys %perlvar) { |
|
print STDERR "$var = $perlvar{$var}\n"; |
|
} |
|
} |
|
my $perlvarref=\%perlvar; |
|
return $perlvarref; |
|
} |
|
|
|
#---------------------- Subroutine read_hosts: Read a LON-CAPA hosts.tab |
|
# formatted configuration file. |
|
# |
|
my $RequiredCount = 4; # Required item count in hosts.tab. |
|
my $DefaultMaxCon = 5; # Default value for maximum connections. |
|
my $DefaultIdle = 1000; # Default connection idle time in seconds. |
|
my $DefaultMinCon = 0; # Default value for minimum connections. |
|
|
|
sub read_hosts { |
|
my $Filename = shift; |
|
my %HostsTab; |
|
|
|
open(CONFIG,'<'.$Filename) or die("Can't read $Filename"); |
|
while (my $line = <CONFIG>) { |
|
if ($line !~ /^\s*\#/) { |
|
$line=~s/\s*$//; |
|
my @items = split(/:/, $line); |
|
if(scalar @items >= $RequiredCount) { |
|
if (scalar @items == $RequiredCount) { # Only required items: |
|
$items[$RequiredCount] = $DefaultMaxCon; |
|
} |
|
if(scalar @items == $RequiredCount + 1) { # up through maxcon. |
|
$items[$RequiredCount+1] = $DefaultIdle; |
|
} |
|
if(scalar @items == $RequiredCount + 2) { # up through idle. |
|
$items[$RequiredCount+2] = $DefaultMinCon; |
|
} |
|
{ |
|
my @list = @items; # probably not needed but I'm unsure of |
|
# about the scope of item so... |
|
$HostsTab{$list[3]} = \@list; |
|
} |
|
} |
|
} |
|
} |
|
close(CONFIG); |
|
my $hostref = \%HostsTab; |
|
return ($hostref); |
|
} |
|
# |
|
# Get the version of our peer. Note that this is only well |
|
# defined if the state machine has hit the idle state at least |
|
# once (well actually if it has transitioned out of |
|
# ReadingVersionString The member data LondVersion is returned. |
|
# |
|
sub PeerVersion { |
|
my $self = shift; |
|
my ($version) = ($self->{LondVersion} =~ /Revision: 1\.(\d+)/); |
|
return $version; |
|
} |
|
|
1; |
1; |
|
|
=pod |
=pod |
|
|
=head1 Theory |
=head1 Theory |
The lond object is a state machine. It lives through the following states: |
|
|
|
=item Connected: a TCP connection has been formed, but the passkey has not yet |
The lond object is a state machine. It lives through the following states: |
been negotiated. |
|
=item Initialized: "init" sent. |
=item Connected: |
=item ChallengeReceived: lond sent its challenge to us. |
|
=item ChallengeReplied: We replied to lond's challenge waiting for lond's ok. |
a TCP connection has been formed, but the passkey has not yet been |
=item RequestingKey: We are requesting an encryption key. |
negotiated. |
=item ReceivingKey: We are receiving an encryption key. |
|
=item Idle: Connection was negotiated but no requests are active. |
=item Initialized: |
=item SendingRequest: A request is being sent to the peer. |
|
=item ReceivingReply: Waiting for an entire reply from the peer. |
"init" sent. |
=item Disconnected: For whatever reason, the connection was dropped. |
|
|
=item ChallengeReceived: |
When we need to be writing data, we have a writable |
|
event. When we need to be reading data, a readable event established. |
lond sent its challenge to us. |
Events dispatch through the class functions Readable and Writable, and the |
|
watcher contains a reference to the associated object to allow object context |
=item ChallengeReplied: |
to be reached. |
|
|
We replied to lond's challenge waiting for lond's ok. |
|
|
|
=item RequestingKey: |
|
|
|
We are requesting an encryption key. |
|
|
|
=item ReceivingKey: |
|
|
|
We are receiving an encryption key. |
|
|
|
=item Idle: |
|
|
|
Connection was negotiated but no requests are active. |
|
|
|
=item SendingRequest: |
|
|
|
A request is being sent to the peer. |
|
|
|
=item ReceivingReply: |
|
|
|
Waiting for an entire reply from the peer. |
|
|
|
=item Disconnected: |
|
|
|
For whatever reason, the connection was dropped. |
|
|
|
When we need to be writing data, we have a writable event. When we |
|
need to be reading data, a readable event established. Events |
|
dispatch through the class functions Readable and Writable, and the |
|
watcher contains a reference to the associated object to allow object |
|
context to be reached. |
|
|
=head2 Member data. |
=head2 Member data. |
Host - Host socket is connected to. |
|
Port - The port the remote lond is listening on. |
|
Socket - Socket open on the connection. |
|
State - The current state. |
|
TransactionRequest - The request being transmitted. |
|
TransactionReply - The reply being received from the transaction. |
|
InformReadable - True if we want to be called when socket is readable. |
|
InformWritable - True if we want to be informed if the socket is writable. |
|
Timeoutable - True if the current operation is allowed to timeout. |
|
TimeoutValue - Number of seconds in the timeout. |
|
TimeoutRemaining - Number of seconds left in the timeout. |
|
CipherKey - The key that was negotiated with the peer. |
|
Cipher - The cipher obtained via the key. |
|
|
|
|
=item Host |
|
|
|
Host socket is connected to. |
|
|
|
=item Port |
|
|
|
The port the remote lond is listening on. |
|
|
|
=item Socket |
|
|
|
Socket open on the connection. |
|
|
|
=item State |
|
|
|
The current state. |
|
|
|
=item AuthenticationMode |
|
|
|
How authentication is being done. This can be any of: |
|
|
|
o local - Authenticate via a key exchanged in a file. |
|
o ssl - Authenticate via a key exchaned through a temporary ssl tunnel. |
|
o insecure - Exchange keys in an insecure manner. |
|
|
|
insecure is only allowed if the configuration parameter loncAllowInsecure |
|
is nonzero. |
|
|
|
=item TransactionRequest |
|
|
|
The request being transmitted. |
|
|
|
=item TransactionReply |
|
|
|
The reply being received from the transaction. |
|
|
|
=item InformReadable |
|
|
|
True if we want to be called when socket is readable. |
|
|
|
=item InformWritable |
|
|
|
True if we want to be informed if the socket is writable. |
|
|
|
=item Timeoutable |
|
|
|
True if the current operation is allowed to timeout. |
|
|
|
=item TimeoutValue |
|
|
|
Number of seconds in the timeout. |
|
|
|
=item TimeoutRemaining |
|
|
|
Number of seconds left in the timeout. |
|
|
|
=item CipherKey |
|
|
|
The key that was negotiated with the peer. |
|
|
|
=item Cipher |
|
|
|
The cipher obtained via the key. |
|
|
|
|
=head2 The following are callback like members: |
=head2 The following are callback like members: |
=item Tick: Called in response to a timer tick. Used to managed timeouts etc. |
|
=item Readable: Called when the socket becomes readable. |
=item Tick: |
=item Writable: Called when the socket becomes writable. |
|
=item TimedOut: Called when a timed operation timed out. |
Called in response to a timer tick. Used to managed timeouts etc. |
|
|
|
=item Readable: |
|
|
|
Called when the socket becomes readable. |
|
|
|
=item Writable: |
|
|
|
Called when the socket becomes writable. |
|
|
|
=item TimedOut: |
|
|
|
Called when a timed operation timed out. |
|
|
|
|
=head2 The following are operational member functions. |
=head2 The following are operational member functions. |
=item InitiateTransaction: Called to initiate a new transaction |
|
=item SetStateTransitionCallback: Called to establish a function that is called |
=item InitiateTransaction: |
whenever the object goes through a state transition. This is used by |
|
The client to manage the work flow for the object. |
Called to initiate a new transaction |
=item SetTimeoutCallback -Set a function to be called when a transaction times |
|
out. The function will be called with the object as its sole parameter. |
=item SetStateTransitionCallback: |
=item Encrypt - Encrypts a block of text according to the cipher negotiated |
|
with the peer (assumes the text is a command). |
Called to establish a function that is called whenever the object goes |
=item Decrypt - Decrypts a block of text according to the cipher negotiated |
through a state transition. This is used by The client to manage the |
with the peer (assumes the block was a reply. |
work flow for the object. |
|
|
|
=item SetTimeoutCallback: |
|
|
|
Set a function to be called when a transaction times out. The |
|
function will be called with the object as its sole parameter. |
|
|
|
=item Encrypt: |
|
|
|
Encrypts a block of text according to the cipher negotiated with the |
|
peer (assumes the text is a command). |
|
|
|
=item Decrypt: |
|
|
|
Decrypts a block of text according to the cipher negotiated with the |
|
peer (assumes the block was a reply. |
|
|
|
=item Shutdown: |
|
|
|
Shuts off the socket. |
|
|
=head2 The following are selector member functions: |
=head2 The following are selector member functions: |
|
|
=item GetState: Returns the current state |
=item GetState: |
=item GetSocket: Gets the socekt open on the connection to lond. |
|
=item WantReadable: true if the current state requires a readable event. |
Returns the current state |
=item WantWritable: true if the current state requires a writable event. |
|
=item WantTimeout: true if the current state requires timeout support. |
=item GetSocket: |
=item GetHostIterator: Returns an iterator into the host file hash. |
|
|
Gets the socekt open on the connection to lond. |
|
|
|
=item WantReadable: |
|
|
|
true if the current state requires a readable event. |
|
|
|
=item WantWritable: |
|
|
|
true if the current state requires a writable event. |
|
|
|
=item WantTimeout: |
|
|
|
true if the current state requires timeout support. |
|
|
|
=item GetHostIterator: |
|
|
|
Returns an iterator into the host file hash. |
|
|
=cut |
=cut |