Annotation of loncom/LondConnection.pm, revision 1.14

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

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