File:  [LON-CAPA] / loncom / LondConnection.pm
Revision 1.15: download - view: text, annotated - select for diffs
Tue Oct 28 11:15:10 2003 UTC (20 years, 6 months ago) by foxr
Branches: MAIN
CVS tags: HEAD
Added ReadForeignConfig for use outside the LonCAPA environment (e.g. in lonManage).

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

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