File:  [LON-CAPA] / loncom / LondConnection.pm
Revision 1.16: download - view: text, annotated - select for diffs
Tue Nov 4 11:11:08 2003 UTC (20 years, 5 months ago) by foxr
Branches: MAIN
CVS tags: HEAD
Add function to set the module debug level.

    1: #   This module defines and implements a class that represents
    2: #   a connection to a lond daemon.
    3: #
    4: # $Id: LondConnection.pm,v 1.16 2003/11/04 11:11:08 foxr Exp $
    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/
   27: #
   28: 
   29: package LondConnection;
   30: 
   31: use strict;
   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;
   39: 
   40: 
   41: 
   42: 
   43: 
   44: my $DebugLevel=0;
   45: my %hostshash;
   46: my %perlvar;
   47: 
   48: #
   49: #  Set debugging level
   50: #
   51: sub SetDebug {
   52:     $DebugLevel = shift;
   53: }
   54: 
   55: #
   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: 
   63: #   Read the configuration file for apache to get the perl
   64: #   variable set.
   65: 
   66: sub ReadConfig {
   67:     my $perlvarref = read_conf('loncapa.conf');
   68:     %perlvar    = %{$perlvarref};
   69:     my $hoststab   = read_hosts(
   70: 				"$perlvar{'lonTabDir'}/hosts.tab") || 
   71: 				die "Can't read host table!!";
   72:     %hostshash  = %{$hoststab};
   73:     
   74: }
   75: 
   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: 
   99: 
  100: }
  101: 
  102: sub Debug {
  103:     my $level   = shift;
  104:     my $message = shift;
  105:     if ($level < $DebugLevel) {
  106: 	print($message."\n");
  107:     }
  108: }
  109: 
  110: =pod
  111: 
  112: =head2 Dump
  113: 
  114: Dump the internal state of the object: For debugging purposes, to stderr.
  115: 
  116: =cut
  117: 
  118: sub Dump {
  119:     my $self   = shift;
  120:     my $key;
  121:     my $value;
  122:     print "Dumping LondConnectionObject:\n";
  123:     while(($key, $value) = each %$self) {
  124: 	print STDERR "$key -> $value\n";
  125:     }
  126:     print "-------------------------------\n";
  127: }
  128: 
  129: =pod
  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: 
  135: =cut
  136: 
  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: 
  148: 
  149: 
  150: =pod
  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: 
  166: =cut
  167: 
  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 
  172: 
  173:     if (!$ConfigRead) {
  174: 	ReadConfig();
  175: 	$ConfigRead = 1;
  176:     }
  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}) {
  186: 	&Debug(8, "No Such host $Hostname");
  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,
  204: 	             TimeoutValue       => 30,
  205: 		     TimeoutRemaining   => 0,
  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,
  212: 					       Proto    => "tcp",
  213: 					       Timeout  => 3)) {
  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
  221:     $self->{Timeoutable}        = 1;    # Timeout allowed during startup negotiation. 
  222:     $self->{TransactionRequest} = "init\n";
  223:     
  224:     #
  225:     # Set socket to nonblocking I/O.
  226:     #
  227:     my $socket = $self->{Socket};
  228:     my $flags    = fcntl($socket->fileno, F_GETFL,0);
  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: }
  242: 
  243: =pod
  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.
  266: 
  267: =cut
  268: 
  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: 
  276:     unless (defined($rv) && length $data) {# Read failed,
  277: 	if(($errno == POSIX::EWOULDBLOCK)   ||
  278: 	   ($errno == POSIX::EAGAIN)        ||
  279: 	   ($errno == POSIX::EINTR)) {
  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:
  297: 	    if($self->{TransactionReply} eq "refused\n") {	# Remote doesn't have
  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;
  332: 	    if($self->{Cipher} eq undef) {
  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
  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.
  381: 
  382: Returns  0 if successful, or -1 if not.
  383: 
  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:     }
  397:     if (($nwritten >= 0)                        ||
  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
  435: 
  436: =head2 Tick
  437: 
  438:    Tick is called every time unit by the event framework.  It
  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.
  443: 
  444: =cut
  445:     
  446: sub Tick {
  447:     my $self = shift;
  448:     $self->{TimeoutRemaining}--;
  449:     if ($self->{TimeoutRemaining} < 0) {
  450: 	$self->TimedOut();
  451:     }
  452: }
  453: 
  454: =pod
  455: 
  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: 
  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: }
  472: 
  473: =pod
  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: 
  484: =cut
  485: 
  486: sub InitiateTransaction {
  487:     my $self   = shift;
  488:     my $data   = shift;
  489: 
  490:     Debug(1, "initiating transaction: ".$data);
  491:     if($self->{State} ne "Idle") {
  492: 	Debug(0," .. but not idle here\n");
  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
  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: 
  520: =cut
  521: 
  522: sub SetStateTransitionCallback {
  523:     my $self        = shift;
  524:     my $oldCallback = $self->{TransitionCallback};
  525:     $self->{TransitionCallback} = shift;
  526:     return $oldCallback;
  527: }
  528: 
  529: =pod
  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: 
  536: =cut
  537: 
  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
  547: 
  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: 
  562: =head2 GetState
  563: 
  564: selector for the object state.
  565: 
  566: =cut
  567: 
  568: sub GetState {
  569:     my $self = shift;
  570:     return $self->{State};
  571: }
  572: 
  573: =pod
  574: 
  575: =head2 GetSocket
  576: 
  577: selector for the object socket.
  578: 
  579: =cut
  580: 
  581: sub GetSocket {
  582:     my $self  = shift;
  583:     return $self->{Socket};
  584: }
  585: 
  586: 
  587: =pod
  588: 
  589: =head2 WantReadable
  590: 
  591: Return the state of the flag that indicates the object wants to be
  592: called when readable.
  593: 
  594: =cut
  595: 
  596: sub WantReadable {
  597:     my   $self = shift;
  598: 
  599:     return $self->{InformReadable};
  600: }
  601: 
  602: =pod
  603: 
  604: =head2 WantWritable
  605: 
  606: Return the state of the flag that indicates the object wants write
  607: notification.
  608: 
  609: =cut
  610: 
  611: sub WantWritable {
  612:     my $self = shift;
  613:     return $self->{InformWritable};
  614: }
  615: 
  616: =pod
  617: 
  618: =head2 WantTimeout
  619: 
  620: return the state of the flag that indicates the object wants to be
  621: informed of timeouts.
  622: 
  623: =cut
  624: 
  625: sub WantTimeout {
  626:     my $self = shift;
  627:     return $self->{Timeoutable};
  628: }
  629: 
  630: =pod
  631: 
  632: =head2 GetReply
  633: 
  634: Returns the reply from the last transaction.
  635: 
  636: =cut
  637: 
  638: sub GetReply {
  639:     my $self = shift;
  640:     return $self->{TransactionReply};
  641: }
  642: 
  643: =pod
  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: 
  651:   encrypt:command
  652: 
  653: The output string can be directly sent to lond as it is of the form:
  654: 
  655:   enc:length:<encodedrequest>
  656: 
  657: =cut
  658: 
  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: }
  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: 
  700: =cut
  701: 
  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: 
  714:     my $decrypted = "";
  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
  733: 
  734: =head2 GetHostIterator
  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: 
  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.
  745:  [4]   - IP address (result of e.g. nslookup [3]).
  746:  [5]   - Maximum connection count.
  747:  [6]   - Idle timeout for reducing connection count.
  748:  [7]   - Minimum connection count.
  749: 
  750: =cut
  751: 
  752: sub GetHostIterator {
  753: 
  754:     return HashIterator->new(\%hostshash);    
  755: }
  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:     
  808:    open(CONFIG,'<'.$Filename) or die("Can't read $Filename");
  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: 
  835: 
  836: 1;
  837: 
  838: =pod
  839: 
  840: =head1 Theory
  841: 
  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.
  890: 
  891: =head2 Member data.
  892: 
  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.
  944: 
  945: 
  946: =head2 The following are callback like members:
  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: 
  964: 
  965: =head2 The following are operational member functions.
  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.
  991: 
  992: =item Shutdown:
  993: 
  994: Shuts off the socket.
  995: 
  996: =head2 The following are selector member functions:
  997: 
  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: 
 1022: =cut

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