# This module defines and implements a class that represents
# a connection to a lond daemon.
#
# $Id: LondConnection.pm,v 1.2 2003/04/18 05:52:43 albertel Exp $
#
# 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;
use IO::Socket;
use IO::Socket::INET;
use IO::Handle;
use IO::File;
use Fcntl;
use POSIX;
use Crypt::IDEA;
use LONCAPA::Configuration;
use LONCAPA::HashIterator;
my $DebugLevel=4;
# Read the configuration file for apache to get the perl
# variable set.
my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');
my %perlvar = %{$perlvarref};
my $hoststab =
LONCAPA::Configuration::read_hosts(
"$perlvar{'lonTabDir'}/hosts.tab") ||
die "Can't read host table!!";
my %hostshash = %{$hoststab};
close(CONFIG);
sub Debug {
my $level = shift;
my $message = shift;
if ($level < $DebugLevel) {
print($message."\n");
}
}
=pod
Dump the internal state of the object: For debugging purposes.
=cut
sub Dump {
my $self = shift;
print "Dumping LondConnectionObject:\n";
while(($key, $value) = each %$self) {
print "$key -> $value\n";
}
print "-------------------------------\n";
}
=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.
=cut
sub Transition {
my $self = shift;
my $newstate = shift;
my $oldstate = $self->{State};
$self->{State} = $newstate;
$self->{TimeoutRemaining} = $self->{TimeoutValue};
if($self->{TransitionCallback}) {
($self->{TransitionCallback})->($self, $oldstate);
}
}
=pod
Construct a new lond connection.
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
sub new {
my $class = shift; # class name.
my $Hostname = shift; # Name of host to connect to.
my $Port = shift; # Port to connect
&Debug(4,$class."::new( ".$Hostname.",".$Port.")\n");
# The host must map to an entry in the hosts table:
# We connect to the dns host that corresponds to that
# system and use the hostname for the encryption key
# negotion. In the objec these become the Host and
# LoncapaHim fields of the object respectively.
#
if (!exists $hostshash{$Hostname}) {
return undef; # No such host!!!
}
my @ConfigLine = @{$hostshash{$Hostname}};
my $DnsName = $ConfigLine[3]; # 4'th item is dns of host.
Debug(5, "Connecting to ".$DnsName);
# Now create the object...
my $self = { Host => $DnsName,
LoncapaHim => $Hostname,
Port => $Port,
State => "Initialized",
TransactionRequest => "",
TransactionReply => "",
InformReadable => 0,
InformWritable => 0,
TimeoutCallback => undef,
TransitionCallback => undef,
Timeoutable => 0,
TimeoutValue => 60,
TimeoutRemaining => 0,
CipherKey => "",
Cipher => undef};
bless($self, $class);
unless ($self->{Socket} = IO::Socket::INET->new(PeerHost => $self->{Host},
PeerPort => $self->{Port},
Type => SOCK_STREAM,
Proto => "tcp")) {
return undef; # Inidicates the socket could not be made.
}
#
# We're connected. Set the state, and the events we'll accept:
#
$self->Transition("Connected");
$self->{InformWritable} = 1; # When socket is writable we send init
$self->{TransactionRequest} = "init\n";
#
# Set socket to nonblocking I/O.
#
my $socket = $self->{Socket};
$flags = fcntl($socket->fileno, F_GETFL,0);
if($flags == -1) {
$socket->close;
return undef;
}
if(fcntl($socket, F_SETFL, $flags | O_NONBLOCK) == -1) {
$socket->close;
return undef;
}
# return the object :
return $self;
}
=pod
This member should be called when the Socket becomes readable.
Until the read completes, action is state independet. Data are accepted
into the TransactionReply until a newline character is received. At that
time actionis state dependent:
=item Connected: 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
sub Readable {
my $self = shift;
my $socket = $self->{Socket};
my $data = '';
my $rv = $socket->recv($data, POSIX::BUFSIZ, 0);
my $errno = $! + 0; # Force numeric context.
unless (defined($rv) && length($data)) { # Read failed,
if(($errno == POSIX::EWOULDBLOCK) ||
($errno == POSIX::EAGAIN) ||
($errno == POSIX::EINTR) ||
($errno == 0)) {
return 0;
}
# Connection likely lost.
&Debug(4, "Connection lost");
$self->{TransactionRequest} = '';
$socket->close();
$self->Transition("Disconnected");
return -1;
}
# Append the data to the buffer. And figure out if the read is done:
&Debug(9,"Received from host: ".$data);
$self->{TransactionReply} .= $data;
if($self->{TransactionReply} =~ /(.*\n)/) {
&Debug(8,"Readable End of line detected");
if ($self->{State} eq "Initialized") { # We received the challenge:
if($self->{TransactionReply} eq "refused") { # Remote doesn't have
$self->Transition("Disconnected"); # in host tables.
$socket->close();
return -1;
}
&Debug(8," Transition out of Initialized");
$self->{TransactionRequest} = $self->{TransactionReply};
$self->{InformWritable} = 1;
$self->{InformReadable} = 0;
$self->Transition("ChallengeReceived");
$self->{TimeoutRemaining} = $self->{TimeoutValue};
return 0;
} elsif ($self->{State} eq "ChallengeReplied") { # should be ok.
if($self->{TransactionReply} != "ok\n") {
$self->Transition("Disconnected");
$socket->close();
return -1;
}
$self->Transition("RequestingKey");
$self->{InformReadable} = 0;
$self->{InformWritable} = 1;
$self->{TransactionRequest} = "ekey\n";
return 0;
} elsif ($self->{State} eq "ReceivingKey") {
my $buildkey = $self->{TransactionReply};
my $key = $self->{LoncapaHim}.$perlvar{'lonHostID'};
$key=~tr/a-z/A-Z/;
$key=~tr/G-P/0-9/;
$key=~tr/Q-Z/0-9/;
$key=$key.$buildkey.$key.$buildkey.$key.$buildkey;
$key=substr($key,0,32);
my $cipherkey=pack("H32",$key);
$self->{Cipher} = new IDEA $cipherkey;
if($self->{Cipher} == undef) {
$self->Transition("Disconnected");
$socket->close();
return -1;
} else {
$self->Transition("Idle");
$self->{InformWritable} = 0;
$self->{InformReadable} = 0;
$self->{Timeoutable} = 0;
return 0;
}
} elsif ($self->{State} eq "ReceivingReply") {
# If the data are encrypted, decrypt first.
my $answer = $self->{TransactionReply};
if($answer =~ /^enc\:/) {
$answer = $self->Decrypt($answer);
$self->{TransactionReply} = $answer;
}
# finish the transaction
$self->{InformWritable} = 0;
$self->{InformReadable} = 0;
$self->{Timeoutable} = 0;
$self->Transition("Idle");
return 0;
} elsif ($self->{State} eq "Disconnected") { # No connection.
return -1;
} else { # Internal error: Invalid state.
$self->Transition("Disconnected");
$socket->close();
return -1;
}
}
return 0;
}
=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
the TransactionRequest member. Once this is drained, we mark the object
as waiting for readability.
Returns 0 if successful, or -1 if not.
=cut
sub Writable {
my $self = shift; # Get reference to the object.
my $socket = $self->{Socket};
my $nwritten = $socket->send($self->{TransactionRequest}, 0);
my $errno = $! + 0;
unless (defined $nwritten) {
if($errno != POSIX::EINTR) {
$self->Transition("Disconnected");
return -1;
}
}
if (($rv >= 0) ||
($errno == POSIX::EWOULDBLOCK) ||
($errno == POSIX::EAGAIN) ||
($errno == POSIX::EINTR) ||
($errno == 0)) {
substr($self->{TransactionRequest}, 0, $nwritten) = ""; # rmv written part
if(length $self->{TransactionRequest} == 0) {
$self->{InformWritable} = 0;
$self->{InformReadable} = 1;
$self->{TransactionReply} = '';
#
# Figure out the next state:
#
if($self->{State} eq "Connected") {
$self->Transition("Initialized");
} elsif($self->{State} eq "ChallengeReceived") {
$self->Transition("ChallengeReplied");
} elsif($self->{State} eq "RequestingKey") {
$self->Transition("ReceivingKey");
$self->{InformWritable} = 0;
$self->{InformReadable} = 1;
$self->{TransactionReply} = '';
} elsif ($self->{State} eq "SendingRequest") {
$self->Transition("ReceivingReply");
$self->{TimeoutRemaining} = $self->{TimeoutValue};
} elsif ($self->{State} eq "Disconnected") {
return -1;
}
return 0;
}
} else { # The write failed (e.g. partner disconnected).
$self->Transition("Disconnected");
$socket->close();
return -1;
}
}
=pod
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
current operation timed out.
=cut
sub Tick {
my $self = shift;
$self->{TimeoutRemaining}--;
if ($self->{TimeoutRemaining} < 0) {
$self->TimedOut();
}
}
=pod
TimedOut - called on a timeout. If the timeout callback is defined,
it is called with $self as its parameters.
=cut
sub TimedOut {
my $self = shift;
if($self->{TimeoutCallback}) {
my $callback = $self->{TimeoutCallback};
my @args = ( $self);
&$callback(@args);
}
}
=pod
Called to initiate a transaction. A transaction can only be initiated
when the object is idle... otherwise an error is returned.
A 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
sub InitiateTransaction {
my $self = shift;
my $data = shift;
if($self->{State} ne "Idle") {
return -1; # Error indicator.
}
# if the transaction is to be encrypted encrypt the data:
if($data =~ /^encrypt\:/) {
$data = $self->Encrypt($data);
}
# Setup the trasaction
$self->{TransactionRequest} = $data;
$self->{TransactionReply} = "";
$self->{InformWritable} = 1;
$self->{InformReadable} = 0;
$self->{Timeoutable} = 1;
$self->{TimeoutRemaining} = $self->{TimeoutValue};
$self->Transition("SendingRequest");
}
=pod
Sets a callback for state transitions. Returns a reference to any
prior established callback, or undef if there was none:
=cut
sub SetStateTransitionCallback {
my $self = shift;
my $oldCallback = $self->{TransitionCallback};
$self->{TransitionCallback} = shift;
return $oldCallback;
}
=pod
Sets the timeout callback. Returns a reference to any prior established
callback or undef if there was none.
=cut
sub SetTimeoutCallback {
my $self = shift;
my $callback = shift;
my $oldCallback = $self->{TimeoutCallback};
$self->{TimeoutCallback} = $callback;
return $oldCallback;
}
=pod
GetState - selector for the object state.
=cut
sub GetState {
my $self = shift;
return $self->{State};
}
=pod
GetSocket - selector for the object socket.
=cut
sub GetSocket {
my $self = shift;
return $self->{Socket};
}
=pod
Return the state of the flag that indicates the object wants to be
called when readable.
=cut
sub WantReadable {
my $self = shift;
return $self->{InformReadable};
}
=pod
Return the state of the flag that indicates the object wants write
notification.
=cut
sub WantWritable {
my $self = shift;
return $self->{InformWritable};
}
=pod
return the state of the flag that indicates the object wants to be informed
of timeouts.
=cut
sub WantTimeout {
my $self = shift;
return $self->{Timeoutable};
}
=pod
Returns the reply from the last transaction.
=cut
sub GetReply {
my $self = shift;
return $self->{TransactionReply};
}
=pod
Returns the encrypted version of the command string.
The command input string is of the form:
encrypt:command
The output string can be directly sent to lond as it's of the form:
enc:length:<encodedrequest>
'
=cut
sub Encrypt {
my $self = shift; # Reference to the object.
my $request = shift; # Text to send.
# Split the encrypt: off the request and figure out it's length.
# the cipher works in blocks of 8 bytes.
my $cmd = $request;
$cmd =~ s/^encrypt\://; # strip off encrypt:
chomp($cmd); # strip off trailing \n
my $length=length($cmd); # Get the string length.
$cmd .= " "; # Pad with blanks so we can fill out a block.
# encrypt the request in 8 byte chunks to create the encrypted
# output request.
my $Encoded = '';
for(my $index = 0; $index <= $length; $index += 8) {
$Encoded .=
unpack("H16",
$self->{Cipher}->encrypt(substr($cmd,
$index, 8)));
}
# Build up the answer as enc:length:$encrequest.
$request = "enc:$length:$Encoded\n";
return $request;
}
=pod
Decrypt
Decrypt a response from the server. The response is in the form:
enc:<length>:<encrypted data>
=cut
sub Decrypt {
my $self = shift; # Recover reference to object
my $encrypted = shift; # This is the encrypted data.
# Bust up the response into length, and encryptedstring:
my ($enc, $length, $EncryptedString) = split(/:/,$encrypted);
chomp($EncryptedString);
# Decode the data in 8 byte blocks. The string is encoded
# as hex digits so there are two characters per byte:
$decrpyted = "";
for(my $index = 0; $index < length($EncryptedString);
$index += 16) {
$decrypted .= $self->{Cipher}->decrypt(
pack("H16",
substr($EncryptedString,
$index,
16)));
}
# the answer may have trailing pads to fill out a block.
# $length tells us the actual length of the decrypted string:
$decrypted = substr($decrypted, 0, $length);
return $decrypted;
}
=pod
=head GetHostIterator
Returns a hash iterator to the host information. Each get from
this iterator returns a reference to an array that contains
information read from the hosts configuration file. Array elements
are used as follows:
[0] - LonCapa host name.
[1] - LonCapa domain name.
[2] - Loncapa role (e.g. library or access).
[3] - DNS name server hostname.
[4] - IP address (result of e.g. nslooup [3]).
[5] - Maximum connection count.
[6] - Idle timeout for reducing connection count.
[7] - Minimum connection count.
=cut
sub GetHostIterator {
return HashIterator->new(\%hostshash);
}
1;
=pod
=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
been negotiated.
=item Initialized: "init" sent.
=item ChallengeReceived: lond sent its challenge to us.
=item ChallengeReplied: 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.
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.
=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 Writable: Called when the socket becomes writable.
=item TimedOut: Called when a timed operation timed out.
=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
whenever the object goes through a state transition. This is used by
The client to manage the 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.
=head2 The following are selector member functions:
=item GetState: Returns the current state
=item GetSocket: 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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to LondConnection.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom