Annotation of loncom/LondConnection.pm, revision 1.3

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

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