Annotation of loncom/LondConnection.pm, revision 1.12

1.2       albertel    1: #   This module defines and implements a class that represents
                      2: #   a connection to a lond daemon.
                      3: #
1.12    ! foxr        4: # $Id: LondConnection.pm,v 1.11 2003/09/30 10:46:57 foxr Exp $
1.2       albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
1.1       foxr       27: #
                     28: package LondConnection;
                     29: 
1.10      foxr       30: use strict;
1.1       foxr       31: use IO::Socket;
                     32: use IO::Socket::INET;
                     33: use IO::Handle;
                     34: use IO::File;
                     35: use Fcntl;
                     36: use POSIX;
                     37: use Crypt::IDEA;
                     38: use LONCAPA::Configuration;
                     39: use LONCAPA::HashIterator;
                     40: 
1.12    ! foxr       41: 
        !            42: 
        !            43: 
1.6       foxr       44: my $DebugLevel=0;
1.12    ! foxr       45: my %hostshash;
        !            46: my %perlvar;
1.1       foxr       47: 
                     48: #   Read the configuration file for apache to get the perl
                     49: #   variable set.
                     50: 
1.12    ! foxr       51: sub ReadConfig {
        !            52:     my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');
        !            53:     %perlvar    = %{$perlvarref};
        !            54:     my $hoststab   = 
        !            55: 	LONCAPA::Configuration::read_hosts(
        !            56: 					   "$perlvar{'lonTabDir'}/hosts.tab") || 
        !            57: 					   die "Can't read host table!!";
        !            58:     %hostshash  = %{$hoststab};
        !            59:     
        !            60:     close(CONFIG);
        !            61: }
        !            62: 
1.1       foxr       63: 
1.12    ! foxr       64: ReadConfig;			# Make sure it gets read on init.
1.1       foxr       65: 
                     66: sub Debug {
                     67:     my $level   = shift;
                     68:     my $message = shift;
                     69:     if ($level < $DebugLevel) {
                     70: 	print($message."\n");
                     71:     }
                     72: }
1.3       albertel   73: 
                     74: =pod
                     75: 
                     76: =head2 Dump
                     77: 
1.12    ! foxr       78: Dump the internal state of the object: For debugging purposes, to stderr.
1.3       albertel   79: 
1.1       foxr       80: =cut
                     81: 
                     82: sub Dump {
                     83:     my $self   = shift;
1.10      foxr       84:     my $key;
                     85:     my $value;
1.1       foxr       86:     print "Dumping LondConnectionObject:\n";
                     87:     while(($key, $value) = each %$self) {
1.12    ! foxr       88: 	print STDERR "$key -> $value\n";
1.1       foxr       89:     }
                     90:     print "-------------------------------\n";
                     91: }
                     92: 
                     93: =pod
1.3       albertel   94: 
                     95: Local function to do a state transition.  If the state transition
                     96: callback is defined it is called with two parameters: the self and the
                     97: old state.
                     98: 
1.1       foxr       99: =cut
1.3       albertel  100: 
1.1       foxr      101: sub Transition {
                    102:     my $self     = shift;
                    103:     my $newstate = shift;
                    104:     my $oldstate = $self->{State};
                    105:     $self->{State} = $newstate;
                    106:     $self->{TimeoutRemaining} = $self->{TimeoutValue};
                    107:     if($self->{TransitionCallback}) {
                    108: 	($self->{TransitionCallback})->($self, $oldstate); 
                    109:     }
                    110: }
                    111: 
1.3       albertel  112: 
1.1       foxr      113: =pod
1.3       albertel  114: 
                    115: =head2 new
                    116: 
                    117: Construct a new lond connection.
                    118: 
                    119: Parameters (besides the class name) include:
                    120: 
                    121: =item hostname
                    122: 
                    123: host the remote lond is on. This host is a host in the hosts.tab file
                    124: 
                    125: =item port
                    126: 
                    127:  port number the remote lond is listening on.
                    128: 
1.1       foxr      129: =cut
1.3       albertel  130: 
1.1       foxr      131: sub new {
                    132:     my $class    = shift;	# class name.
                    133:     my $Hostname = shift;	# Name of host to connect to.
                    134:     my $Port     = shift;	# Port to connect 
                    135:     &Debug(4,$class."::new( ".$Hostname.",".$Port.")\n");
                    136: 
                    137:     # The host must map to an entry in the hosts table:
                    138:     #  We connect to the dns host that corresponds to that
                    139:     #  system and use the hostname for the encryption key 
                    140:     #  negotion.  In the objec these become the Host and
                    141:     #  LoncapaHim fields of the object respectively.
                    142:     #
                    143:     if (!exists $hostshash{$Hostname}) {
                    144: 	return undef;		# No such host!!!
                    145:     }
                    146:     my @ConfigLine = @{$hostshash{$Hostname}};
                    147:     my $DnsName    = $ConfigLine[3]; # 4'th item is dns of host.
                    148:     Debug(5, "Connecting to ".$DnsName);
                    149:     # Now create the object...
                    150:     my $self     = { Host               => $DnsName,
                    151: 		     LoncapaHim         => $Hostname,
                    152: 	             Port               => $Port,
                    153: 	             State              => "Initialized",
                    154: 	             TransactionRequest => "",
                    155: 	             TransactionReply   => "",
                    156: 	             InformReadable     => 0,
                    157: 	             InformWritable     => 0,
                    158: 		     TimeoutCallback    => undef,
                    159: 		     TransitionCallback => undef,
                    160: 	             Timeoutable        => 0,
1.9       foxr      161: 	             TimeoutValue       => 30,
                    162: 		     TimeoutRemaining   => 0,
1.1       foxr      163: 		     CipherKey          => "",
                    164: 		     Cipher             => undef};
                    165:     bless($self, $class);
                    166:     unless ($self->{Socket} = IO::Socket::INET->new(PeerHost => $self->{Host},
                    167: 					       PeerPort => $self->{Port},
                    168: 					       Type     => SOCK_STREAM,
1.8       foxr      169: 					       Proto    => "tcp",
                    170: 					       Timeout  => 5)) {
1.1       foxr      171: 	return undef;		# Inidicates the socket could not be made.
                    172:     }
                    173:     #
                    174:     # We're connected.  Set the state, and the events we'll accept:
                    175:     #
                    176:     $self->Transition("Connected");
                    177:     $self->{InformWritable}     = 1;    # When  socket is writable we send init
1.9       foxr      178:     $self->{Timeoutable}        = 1;    # Timeout allowed during startup negotiation. 
1.1       foxr      179:     $self->{TransactionRequest} = "init\n";
                    180:     
                    181:     #
                    182:     # Set socket to nonblocking I/O.
                    183:     #
                    184:     my $socket = $self->{Socket};
1.10      foxr      185:     my $flags    = fcntl($socket->fileno, F_GETFL,0);
1.1       foxr      186:     if($flags == -1) {
                    187: 	$socket->close;
                    188: 	return undef;
                    189:     }
                    190:     if(fcntl($socket, F_SETFL, $flags | O_NONBLOCK) == -1) {
                    191: 	$socket->close;
                    192: 	return undef;
                    193:     }
                    194: 
                    195:     # return the object :
                    196: 
                    197:     return $self;
                    198: }
1.3       albertel  199: 
1.1       foxr      200: =pod
1.3       albertel  201: 
                    202: =head2 Readable
                    203: 
                    204: This member should be called when the Socket becomes readable.  Until
                    205: the read completes, action is state independet. Data are accepted into
                    206: the TransactionReply until a newline character is received.  At that
                    207: time actionis state dependent:
                    208: 
                    209: =item Connected
                    210: 
                    211: in this case we received challenge, the state changes to
                    212: ChallengeReceived, and we initiate a send with the challenge response.
                    213: 
                    214: =item ReceivingReply
                    215: 
                    216: In this case a reply has been received for a transaction, the state
                    217: goes to Idle and we disable write and read notification.
                    218: 
                    219: =item ChallengeReeived
                    220: 
                    221: we just got what should be an ok\n and the connection can now handle
                    222: transactions.
1.1       foxr      223: 
                    224: =cut
1.3       albertel  225: 
1.1       foxr      226: sub Readable {
                    227:     my $self    = shift;
                    228:     my $socket  = $self->{Socket};
                    229:     my $data    = '';
                    230:     my $rv      = $socket->recv($data, POSIX::BUFSIZ,  0);
                    231:     my $errno   = $! + 0;	             # Force numeric context.
                    232: 
1.8       foxr      233:     unless (defined($rv) && length $data) {# Read failed,
1.1       foxr      234: 	if(($errno == POSIX::EWOULDBLOCK)   ||
                    235: 	   ($errno == POSIX::EAGAIN)        ||
1.8       foxr      236: 	   ($errno == POSIX::EINTR)) {
1.1       foxr      237: 	    return 0;
                    238: 	}
                    239: 
                    240: 	# Connection likely lost.
                    241: 	&Debug(4, "Connection lost");
                    242: 	$self->{TransactionRequest} = '';
                    243: 	$socket->close();
                    244: 	$self->Transition("Disconnected");
                    245: 	return -1;
                    246:     }
                    247:     #  Append the data to the buffer.  And figure out if the read is done:
                    248: 
                    249:     &Debug(9,"Received from host: ".$data);
                    250:     $self->{TransactionReply} .= $data;
                    251:     if($self->{TransactionReply} =~ /(.*\n)/) {
                    252: 	&Debug(8,"Readable End of line detected");
                    253: 	if ($self->{State}  eq "Initialized") { # We received the challenge:
1.10      foxr      254: 	    if($self->{TransactionReply} eq "refused\n") {	# Remote doesn't have
1.1       foxr      255: 		
                    256: 		$self->Transition("Disconnected"); # in host tables.
                    257: 		$socket->close();
                    258: 		return -1;
                    259: 	    }
                    260: 
                    261: 	    &Debug(8," Transition out of Initialized");
                    262: 	    $self->{TransactionRequest} = $self->{TransactionReply};
                    263: 	    $self->{InformWritable}     = 1;
                    264: 	    $self->{InformReadable}     = 0;
                    265: 	    $self->Transition("ChallengeReceived");
                    266: 	    $self->{TimeoutRemaining}   = $self->{TimeoutValue};
                    267: 	    return 0;
                    268: 	} elsif ($self->{State} eq "ChallengeReplied") { # should be ok.
                    269: 	    if($self->{TransactionReply} != "ok\n") {
                    270: 		$self->Transition("Disconnected");
                    271: 		$socket->close();
                    272: 		return -1;
                    273: 	    }
                    274: 	    $self->Transition("RequestingKey");
                    275: 	    $self->{InformReadable}  = 0;
                    276: 	    $self->{InformWritable}  = 1;
                    277: 	    $self->{TransactionRequest} = "ekey\n";
                    278: 	    return 0;
                    279: 	} elsif ($self->{State}  eq "ReceivingKey") {
                    280: 	    my $buildkey = $self->{TransactionReply};
                    281: 	    my $key = $self->{LoncapaHim}.$perlvar{'lonHostID'};
                    282: 	    $key=~tr/a-z/A-Z/;
                    283: 	    $key=~tr/G-P/0-9/;
                    284: 	    $key=~tr/Q-Z/0-9/;
                    285: 	    $key=$key.$buildkey.$key.$buildkey.$key.$buildkey;
                    286: 	    $key=substr($key,0,32);
                    287: 	    my $cipherkey=pack("H32",$key);
                    288: 	    $self->{Cipher} = new IDEA $cipherkey;
                    289: 	    if($self->{Cipher} == undef) {
                    290: 		$self->Transition("Disconnected");
                    291: 		$socket->close();
                    292: 		return -1;
                    293: 	    } else {
                    294: 		$self->Transition("Idle");
                    295: 		$self->{InformWritable}  =  0;
                    296: 		$self->{InformReadable}  =  0;
                    297: 		$self->{Timeoutable}     = 0;
                    298: 		return 0;
                    299: 	    }
                    300: 	} elsif ($self->{State}  eq "ReceivingReply") {
                    301: 
                    302: 	    # If the data are encrypted, decrypt first.
                    303: 
                    304: 	    my $answer = $self->{TransactionReply};
                    305: 	    if($answer =~ /^enc\:/) {
                    306: 		$answer = $self->Decrypt($answer);
                    307: 		$self->{TransactionReply} = $answer;
                    308: 	    }
                    309: 
                    310: 	    # finish the transaction
                    311: 
                    312: 	    $self->{InformWritable}     = 0;
                    313: 	    $self->{InformReadable}     = 0;
                    314: 	    $self->{Timeoutable}        = 0;
                    315: 	    $self->Transition("Idle");
                    316: 	    return 0;
                    317: 	} elsif ($self->{State} eq "Disconnected") { # No connection.
                    318: 	    return -1;
                    319: 	} else {			# Internal error: Invalid state.
                    320: 	    $self->Transition("Disconnected");
                    321: 	    $socket->close();
                    322: 	    return -1;
                    323: 	}
                    324:     }
                    325: 
                    326:     return 0;
                    327:     
                    328: }
                    329: 
                    330: 
                    331: =pod
1.3       albertel  332: 
                    333: This member should be called when the Socket becomes writable.
                    334: 
                    335: The action is state independent. An attempt is made to drain the
                    336: contents of the TransactionRequest member.  Once this is drained, we
                    337: mark the object as waiting for readability.
1.1       foxr      338: 
                    339: Returns  0 if successful, or -1 if not.
1.3       albertel  340: 
1.1       foxr      341: =cut
                    342: sub Writable {
                    343:     my $self     = shift;		# Get reference to the object.
                    344:     my $socket   = $self->{Socket};
                    345:     my $nwritten = $socket->send($self->{TransactionRequest}, 0);
                    346:     my $errno    = $! + 0;
                    347:     unless (defined $nwritten) {
                    348: 	if($errno != POSIX::EINTR) {
                    349: 	    $self->Transition("Disconnected");
                    350: 	    return -1;
                    351: 	}
                    352:       
                    353:     }
1.10      foxr      354:     if (($nwritten >= 0)                        ||
1.1       foxr      355:         ($errno == POSIX::EWOULDBLOCK)    ||
                    356: 	($errno == POSIX::EAGAIN)         ||
                    357: 	($errno == POSIX::EINTR)          ||
                    358: 	($errno ==  0)) {
                    359: 	substr($self->{TransactionRequest}, 0, $nwritten) = ""; # rmv written part
                    360: 	if(length $self->{TransactionRequest} == 0) {
                    361: 	    $self->{InformWritable} = 0;
                    362: 	    $self->{InformReadable} = 1;
                    363: 	    $self->{TransactionReply} = '';
                    364: 	    #
                    365: 	    # Figure out the next state:
                    366: 	    #
                    367: 	    if($self->{State} eq "Connected") {
                    368: 		$self->Transition("Initialized");
                    369: 	    } elsif($self->{State} eq "ChallengeReceived") {
                    370: 		$self->Transition("ChallengeReplied");
                    371: 	    } elsif($self->{State} eq "RequestingKey") {
                    372: 		$self->Transition("ReceivingKey");
                    373: 		$self->{InformWritable} = 0;
                    374: 		$self->{InformReadable} = 1;
                    375: 		$self->{TransactionReply} = '';
                    376: 	    } elsif ($self->{State} eq "SendingRequest") {
                    377: 		$self->Transition("ReceivingReply");
                    378: 		$self->{TimeoutRemaining} = $self->{TimeoutValue};
                    379: 	    } elsif ($self->{State} eq "Disconnected") {
                    380: 		return -1;
                    381: 	    }
                    382: 	    return 0;
                    383: 	}
                    384:     } else {			# The write failed (e.g. partner disconnected).
                    385: 	$self->Transition("Disconnected");
                    386: 	$socket->close();
                    387: 	return -1;
                    388:     }
                    389: 	
                    390: }
                    391: =pod
1.3       albertel  392: 
                    393: =head2 Tick
                    394: 
1.1       foxr      395:    Tick is called every time unit by the event framework.  It
1.3       albertel  396: 
                    397: =item 1 decrements the remaining timeout.
                    398: 
                    399: =item 2 If the timeout is zero, calls TimedOut indicating that the current operation timed out.
1.1       foxr      400: 
                    401: =cut
                    402:     
                    403: sub Tick {
                    404:     my $self = shift;
                    405:     $self->{TimeoutRemaining}--;
                    406:     if ($self->{TimeoutRemaining} < 0) {
                    407: 	$self->TimedOut();
                    408:     }
                    409: }
1.3       albertel  410: 
1.1       foxr      411: =pod
                    412: 
1.3       albertel  413: =head2 TimedOut
                    414: 
                    415: called on a timeout.  If the timeout callback is defined, it is called
                    416: with $self as its parameters.
                    417: 
                    418: =cut
                    419: 
1.1       foxr      420: sub TimedOut  {
                    421: 
                    422:     my $self = shift;
                    423:     if($self->{TimeoutCallback}) {
                    424: 	my $callback = $self->{TimeoutCallback};
                    425: 	my @args = ( $self);
                    426: 	&$callback(@args);
                    427:     }
                    428: }
1.3       albertel  429: 
1.1       foxr      430: =pod
1.3       albertel  431: 
                    432: =head2 InitiateTransaction
                    433: 
                    434: Called to initiate a transaction.  A transaction can only be initiated
                    435: when the object is idle... otherwise an error is returned.  A
                    436: transaction consists of a request to the server that will have a
                    437: reply.  This member sets the request data in the TransactionRequest
                    438: member, makes the state SendingRequest and sets the data to allow a
                    439: timout, and to request writability notification.
                    440: 
1.1       foxr      441: =cut
1.3       albertel  442: 
1.1       foxr      443: sub InitiateTransaction {
                    444:     my $self   = shift;
                    445:     my $data   = shift;
                    446: 
1.4       foxr      447:     Debug(1, "initiating transaction: ".$data);
1.1       foxr      448:     if($self->{State} ne "Idle") {
1.4       foxr      449: 	Debug(0," .. but not idle here\n");
1.1       foxr      450: 	return -1;		# Error indicator.
                    451:     }
                    452:     # if the transaction is to be encrypted encrypt the data:
                    453: 
                    454:     if($data =~ /^encrypt\:/) {
                    455: 	$data = $self->Encrypt($data);
                    456:     }
                    457: 
                    458:     # Setup the trasaction
                    459: 
                    460:     $self->{TransactionRequest} = $data;
                    461:     $self->{TransactionReply}   = "";
                    462:     $self->{InformWritable}     = 1;
                    463:     $self->{InformReadable}     = 0;
                    464:     $self->{Timeoutable}        = 1;
                    465:     $self->{TimeoutRemaining}   = $self->{TimeoutValue};
                    466:     $self->Transition("SendingRequest");
                    467: }
                    468: 
                    469: 
                    470: =pod
1.3       albertel  471: 
                    472: =head2 SetStateTransitionCallback
                    473: 
                    474: Sets a callback for state transitions.  Returns a reference to any
                    475: prior established callback, or undef if there was none:
                    476: 
1.1       foxr      477: =cut
1.3       albertel  478: 
1.1       foxr      479: sub SetStateTransitionCallback {
                    480:     my $self        = shift;
                    481:     my $oldCallback = $self->{TransitionCallback};
                    482:     $self->{TransitionCallback} = shift;
                    483:     return $oldCallback;
                    484: }
1.3       albertel  485: 
1.1       foxr      486: =pod
1.3       albertel  487: 
                    488: =head2 SetTimeoutCallback
                    489: 
                    490: Sets the timeout callback.  Returns a reference to any prior
                    491: established callback or undef if there was none.
                    492: 
1.1       foxr      493: =cut
1.3       albertel  494: 
1.1       foxr      495: sub SetTimeoutCallback {
                    496:     my $self                 = shift;
                    497:     my $callback             = shift;
                    498:     my $oldCallback          = $self->{TimeoutCallback};
                    499:     $self->{TimeoutCallback} = $callback;
                    500:     return $oldCallback;
                    501: }
                    502: 
                    503: =pod
1.3       albertel  504: 
1.5       foxr      505: =head2 Shutdown:
                    506: 
                    507: Shuts down the socket.
                    508: 
                    509: =cut
                    510: 
                    511: sub Shutdown {
                    512:     my $self = shift;
                    513:     my $socket = $self->GetSocket();
                    514:     $socket->shutdown(2);
                    515: }
                    516: 
                    517: =pod
                    518: 
1.3       albertel  519: =head2 GetState
                    520: 
                    521: selector for the object state.
                    522: 
1.1       foxr      523: =cut
1.3       albertel  524: 
1.1       foxr      525: sub GetState {
                    526:     my $self = shift;
                    527:     return $self->{State};
                    528: }
1.3       albertel  529: 
1.1       foxr      530: =pod
1.3       albertel  531: 
                    532: =head2 GetSocket
                    533: 
                    534: selector for the object socket.
                    535: 
1.1       foxr      536: =cut
1.3       albertel  537: 
1.1       foxr      538: sub GetSocket {
                    539:     my $self  = shift;
                    540:     return $self->{Socket};
                    541: }
1.3       albertel  542: 
1.5       foxr      543: 
1.1       foxr      544: =pod
1.3       albertel  545: 
                    546: =head2 WantReadable
                    547: 
                    548: Return the state of the flag that indicates the object wants to be
                    549: called when readable.
                    550: 
1.1       foxr      551: =cut
1.3       albertel  552: 
1.1       foxr      553: sub WantReadable {
                    554:     my   $self = shift;
                    555: 
                    556:     return $self->{InformReadable};
                    557: }
1.3       albertel  558: 
1.1       foxr      559: =pod
1.3       albertel  560: 
                    561: =head2 WantWritable
                    562: 
                    563: Return the state of the flag that indicates the object wants write
                    564: notification.
                    565: 
1.1       foxr      566: =cut
1.3       albertel  567: 
1.1       foxr      568: sub WantWritable {
                    569:     my $self = shift;
                    570:     return $self->{InformWritable};
                    571: }
1.3       albertel  572: 
1.1       foxr      573: =pod
1.3       albertel  574: 
                    575: =head2 WantTimeout
                    576: 
                    577: return the state of the flag that indicates the object wants to be
                    578: informed of timeouts.
                    579: 
1.1       foxr      580: =cut
1.3       albertel  581: 
1.1       foxr      582: sub WantTimeout {
                    583:     my $self = shift;
                    584:     return $self->{Timeoutable};
                    585: }
                    586: 
                    587: =pod
1.3       albertel  588: 
                    589: =head2 GetReply
                    590: 
                    591: Returns the reply from the last transaction.
                    592: 
1.1       foxr      593: =cut
1.3       albertel  594: 
1.1       foxr      595: sub GetReply {
                    596:     my $self = shift;
                    597:     return $self->{TransactionReply};
                    598: }
                    599: 
                    600: =pod
1.3       albertel  601: 
                    602: =head2 Encrypt
                    603: 
                    604: Returns the encrypted version of the command string.
                    605: 
                    606: The command input string is of the form:
                    607: 
1.1       foxr      608:   encrypt:command
1.3       albertel  609: 
                    610: The output string can be directly sent to lond as it is of the form:
                    611: 
1.1       foxr      612:   enc:length:<encodedrequest>
1.3       albertel  613: 
1.1       foxr      614: =cut
1.3       albertel  615: 
1.1       foxr      616: sub Encrypt {
                    617:     my $self    = shift;		# Reference to the object.
                    618:     my $request = shift;	        # Text to send.
                    619: 
                    620:    
                    621:     # Split the encrypt: off the request and figure out it's length.
                    622:     # the cipher works in blocks of 8 bytes.
                    623: 
                    624:     my $cmd = $request;
                    625:     $cmd    =~ s/^encrypt\://;	# strip off encrypt:
                    626:     chomp($cmd);		# strip off trailing \n
                    627:     my     $length=length($cmd);	# Get the string length.
                    628:     $cmd .= "         ";	# Pad with blanks so we can fill out a block.
                    629: 
                    630:     # encrypt the request in 8 byte chunks to create the encrypted
                    631:     # output request.
                    632: 
                    633:     my $Encoded = '';
                    634:     for(my $index = 0; $index <= $length; $index += 8) {
                    635: 	$Encoded .= 
                    636: 	    unpack("H16", 
                    637: 		   $self->{Cipher}->encrypt(substr($cmd, 
                    638: 						   $index, 8)));
                    639:     }
                    640: 
                    641:     # Build up the answer as enc:length:$encrequest.
                    642: 
                    643:     $request = "enc:$length:$Encoded\n";
                    644:     return $request;
                    645:     
                    646:     
                    647: }
1.3       albertel  648: 
                    649: =pod
                    650: 
                    651: =head2 Decrypt
                    652: 
                    653: Decrypt a response from the server.  The response is in the form:
                    654: 
                    655:  enc:<length>:<encrypted data>
                    656: 
1.1       foxr      657: =cut
1.3       albertel  658: 
1.1       foxr      659: sub Decrypt {
                    660:     my $self      = shift;	# Recover reference to object
                    661:     my $encrypted = shift;	# This is the encrypted data.
                    662: 
                    663:     #  Bust up the response into length, and encryptedstring:
                    664: 
                    665:     my ($enc, $length, $EncryptedString) = split(/:/,$encrypted);
                    666:     chomp($EncryptedString);
                    667: 
                    668:     # Decode the data in 8 byte blocks.  The string is encoded
                    669:     # as hex digits so there are two characters per byte:
                    670: 
1.10      foxr      671:     my $decrypted = "";
1.1       foxr      672:     for(my $index = 0; $index < length($EncryptedString);
                    673: 	$index += 16) {
                    674: 	$decrypted .= $self->{Cipher}->decrypt(
                    675: 				    pack("H16",
                    676: 					 substr($EncryptedString,
                    677: 						$index, 
                    678: 						16)));
                    679:     }
                    680:     #  the answer may have trailing pads to fill out a block.
                    681:     #  $length tells us the actual length of the decrypted string:
                    682: 
                    683:     $decrypted = substr($decrypted, 0, $length);
                    684: 
                    685:     return $decrypted;
                    686: 
                    687: }
                    688: 
                    689: =pod
1.3       albertel  690: 
                    691: =head2 GetHostIterator
1.1       foxr      692: 
                    693: Returns a hash iterator to the host information.  Each get from 
                    694: this iterator returns a reference to an array that contains 
                    695: information read from the hosts configuration file.  Array elements
                    696: are used as follows:
                    697: 
1.3       albertel  698:  [0]   - LonCapa host name.
                    699:  [1]   - LonCapa domain name.
                    700:  [2]   - Loncapa role (e.g. library or access).
                    701:  [3]   - DNS name server hostname.
1.11      foxr      702:  [4]   - IP address (result of e.g. nslookup [3]).
1.3       albertel  703:  [5]   - Maximum connection count.
                    704:  [6]   - Idle timeout for reducing connection count.
                    705:  [7]   - Minimum connection count.
1.1       foxr      706: 
1.3       albertel  707: =cut
1.1       foxr      708: 
                    709: sub GetHostIterator {
                    710: 
                    711:     return HashIterator->new(\%hostshash);    
                    712: }
                    713: 
                    714: 1;
                    715: 
                    716: =pod
1.3       albertel  717: 
1.1       foxr      718: =head1 Theory
                    719: 
1.3       albertel  720: The lond object is a state machine.  It lives through the following states:
                    721: 
                    722: =item Connected:
                    723: 
                    724: a TCP connection has been formed, but the passkey has not yet been
                    725: negotiated.
                    726: 
                    727: =item Initialized:
                    728: 
                    729: "init" sent.
                    730: 
                    731: =item ChallengeReceived:
                    732: 
                    733: lond sent its challenge to us.
                    734: 
                    735: =item ChallengeReplied:
                    736: 
                    737: We replied to lond's challenge waiting for lond's ok.
                    738: 
                    739: =item RequestingKey:
                    740: 
                    741: We are requesting an encryption key.
                    742: 
                    743: =item ReceivingKey:
                    744: 
                    745: We are receiving an encryption key.
                    746: 
                    747: =item Idle:
                    748: 
                    749: Connection was negotiated but no requests are active.
                    750: 
                    751: =item SendingRequest:
                    752: 
                    753: A request is being sent to the peer.
                    754: 
                    755: =item ReceivingReply:
                    756: 
                    757: Waiting for an entire reply from the peer.
                    758: 
                    759: =item Disconnected:
                    760: 
                    761: For whatever reason, the connection was dropped.
                    762: 
                    763: When we need to be writing data, we have a writable event. When we
                    764: need to be reading data, a readable event established.  Events
                    765: dispatch through the class functions Readable and Writable, and the
                    766: watcher contains a reference to the associated object to allow object
                    767: context to be reached.
1.1       foxr      768: 
                    769: =head2 Member data.
                    770: 
1.3       albertel  771: =item Host
                    772: 
                    773: Host socket is connected to.
                    774: 
                    775: =item Port
                    776: 
                    777: The port the remote lond is listening on.
                    778: 
                    779: =item Socket
                    780: 
                    781: Socket open on the connection.
                    782: 
                    783: =item State
                    784: 
                    785: The current state.
                    786: 
                    787: =item TransactionRequest
                    788: 
                    789: The request being transmitted.
                    790: 
                    791: =item TransactionReply
                    792: 
                    793: The reply being received from the transaction.
                    794: 
                    795: =item InformReadable
                    796: 
                    797: True if we want to be called when socket is readable.
                    798: 
                    799: =item InformWritable
                    800: 
                    801: True if we want to be informed if the socket is writable.
                    802: 
                    803: =item Timeoutable
                    804: 
                    805: True if the current operation is allowed to timeout.
                    806: 
                    807: =item TimeoutValue
                    808: 
                    809: Number of seconds in the timeout.
                    810: 
                    811: =item TimeoutRemaining
                    812: 
                    813: Number of seconds left in the timeout.
                    814: 
                    815: =item CipherKey
                    816: 
                    817: The key that was negotiated with the peer.
                    818: 
                    819: =item Cipher
                    820: 
                    821: The cipher obtained via the key.
1.1       foxr      822: 
                    823: 
                    824: =head2 The following are callback like members:
1.3       albertel  825: 
                    826: =item Tick:
                    827: 
                    828: Called in response to a timer tick. Used to managed timeouts etc.
                    829: 
                    830: =item Readable:
                    831: 
                    832: Called when the socket becomes readable.
                    833: 
                    834: =item Writable:
                    835: 
                    836: Called when the socket becomes writable.
                    837: 
                    838: =item TimedOut:
                    839: 
                    840: Called when a timed operation timed out.
                    841: 
1.1       foxr      842: 
                    843: =head2 The following are operational member functions.
1.3       albertel  844: 
                    845: =item InitiateTransaction:
                    846: 
                    847: Called to initiate a new transaction
                    848: 
                    849: =item SetStateTransitionCallback:
                    850: 
                    851: Called to establish a function that is called whenever the object goes
                    852: through a state transition.  This is used by The client to manage the
                    853: work flow for the object.
                    854: 
                    855: =item SetTimeoutCallback:
                    856: 
                    857: Set a function to be called when a transaction times out.  The
                    858: function will be called with the object as its sole parameter.
                    859: 
                    860: =item Encrypt:
                    861: 
                    862: Encrypts a block of text according to the cipher negotiated with the
                    863: peer (assumes the text is a command).
                    864: 
                    865: =item Decrypt:
                    866: 
                    867: Decrypts a block of text according to the cipher negotiated with the
                    868: peer (assumes the block was a reply.
1.5       foxr      869: 
                    870: =item Shutdown:
                    871: 
                    872: Shuts off the socket.
1.1       foxr      873: 
                    874: =head2 The following are selector member functions:
                    875: 
1.3       albertel  876: =item GetState:
                    877: 
                    878: Returns the current state
                    879: 
                    880: =item GetSocket:
                    881: 
                    882: Gets the socekt open on the connection to lond.
                    883: 
                    884: =item WantReadable:
                    885: 
                    886: true if the current state requires a readable event.
                    887: 
                    888: =item WantWritable:
                    889: 
                    890: true if the current state requires a writable event.
                    891: 
                    892: =item WantTimeout:
                    893: 
                    894: true if the current state requires timeout support.
                    895: 
                    896: =item GetHostIterator:
                    897: 
                    898: Returns an iterator into the host file hash.
                    899: 
1.1       foxr      900: =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>