Annotation of loncom/LondConnection.pm, revision 1.16

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

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