[LON-CAPA-cvs] cvs: loncom / LondConnection.pm

foxr lon-capa-cvs@mail.lon-capa.org
Fri, 18 Apr 2003 02:39:57 -0000


This is a MIME encoded message

--foxr1050633597
Content-Type: text/plain

foxr		Thu Apr 17 22:39:57 2003 EDT

  Added files:                 
    /loncom	LondConnection.pm 
  Log:
  Move class that manages a connection from lonc to lond into the mainline
  development cvs from the experimental sandbox.
  
  
  
--foxr1050633597
Content-Type: text/plain
Content-Disposition: attachment; filename="foxr-20030417223957.txt"


Index: loncom/LondConnection.pm
+++ loncom/LondConnection.pm
#
#   This module defines and implements a class that represents
#   a connection to a lond daemon. 
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

--foxr1050633597--