File:  [LON-CAPA] / loncom / LondConnection.pm
Revision 1.14: download - view: text, annotated - select for diffs
Tue Oct 28 10:47:44 2003 UTC (20 years, 6 months ago) by foxr
Branches: MAIN
CVS tags: HEAD
Start building support for LondConnection.pm to be used by LonManage.
- Separate the configuration read from initialization:
  o Read if not read on first new using ReadConfig
  o Read if explicityl requeste by client doing LondConnection::ReadConfig
- Incorporate LONCAPA::Configuration textually so that LondConnection
  can be used outside of 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.14 2003/10/28 10:47:44 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:     close(CONFIG);
   68: }
   69: 
   70: 
   71: 
   72: sub Debug {
   73:     my $level   = shift;
   74:     my $message = shift;
   75:     if ($level < $DebugLevel) {
   76: 	print($message."\n");
   77:     }
   78: }
   79: 
   80: =pod
   81: 
   82: =head2 Dump
   83: 
   84: Dump the internal state of the object: For debugging purposes, to stderr.
   85: 
   86: =cut
   87: 
   88: sub Dump {
   89:     my $self   = shift;
   90:     my $key;
   91:     my $value;
   92:     print "Dumping LondConnectionObject:\n";
   93:     while(($key, $value) = each %$self) {
   94: 	print STDERR "$key -> $value\n";
   95:     }
   96:     print "-------------------------------\n";
   97: }
   98: 
   99: =pod
  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: 
  105: =cut
  106: 
  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: 
  118: 
  119: 
  120: =pod
  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: 
  136: =cut
  137: 
  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 
  142: 
  143:     if (!$ConfigRead) {
  144: 	ReadConfig();
  145: 	$ConfigRead = 1;
  146:     }
  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,
  173: 	             TimeoutValue       => 30,
  174: 		     TimeoutRemaining   => 0,
  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,
  181: 					       Proto    => "tcp",
  182: 					       Timeout  => 3)) {
  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
  190:     $self->{Timeoutable}        = 1;    # Timeout allowed during startup negotiation. 
  191:     $self->{TransactionRequest} = "init\n";
  192:     
  193:     #
  194:     # Set socket to nonblocking I/O.
  195:     #
  196:     my $socket = $self->{Socket};
  197:     my $flags    = fcntl($socket->fileno, F_GETFL,0);
  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: }
  211: 
  212: =pod
  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.
  235: 
  236: =cut
  237: 
  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: 
  245:     unless (defined($rv) && length $data) {# Read failed,
  246: 	if(($errno == POSIX::EWOULDBLOCK)   ||
  247: 	   ($errno == POSIX::EAGAIN)        ||
  248: 	   ($errno == POSIX::EINTR)) {
  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:
  266: 	    if($self->{TransactionReply} eq "refused\n") {	# Remote doesn't have
  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;
  301: 	    if($self->{Cipher} eq undef) {
  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
  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.
  350: 
  351: Returns  0 if successful, or -1 if not.
  352: 
  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:     }
  366:     if (($nwritten >= 0)                        ||
  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
  404: 
  405: =head2 Tick
  406: 
  407:    Tick is called every time unit by the event framework.  It
  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.
  412: 
  413: =cut
  414:     
  415: sub Tick {
  416:     my $self = shift;
  417:     $self->{TimeoutRemaining}--;
  418:     if ($self->{TimeoutRemaining} < 0) {
  419: 	$self->TimedOut();
  420:     }
  421: }
  422: 
  423: =pod
  424: 
  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: 
  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: }
  441: 
  442: =pod
  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: 
  453: =cut
  454: 
  455: sub InitiateTransaction {
  456:     my $self   = shift;
  457:     my $data   = shift;
  458: 
  459:     Debug(1, "initiating transaction: ".$data);
  460:     if($self->{State} ne "Idle") {
  461: 	Debug(0," .. but not idle here\n");
  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
  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: 
  489: =cut
  490: 
  491: sub SetStateTransitionCallback {
  492:     my $self        = shift;
  493:     my $oldCallback = $self->{TransitionCallback};
  494:     $self->{TransitionCallback} = shift;
  495:     return $oldCallback;
  496: }
  497: 
  498: =pod
  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: 
  505: =cut
  506: 
  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
  516: 
  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: 
  531: =head2 GetState
  532: 
  533: selector for the object state.
  534: 
  535: =cut
  536: 
  537: sub GetState {
  538:     my $self = shift;
  539:     return $self->{State};
  540: }
  541: 
  542: =pod
  543: 
  544: =head2 GetSocket
  545: 
  546: selector for the object socket.
  547: 
  548: =cut
  549: 
  550: sub GetSocket {
  551:     my $self  = shift;
  552:     return $self->{Socket};
  553: }
  554: 
  555: 
  556: =pod
  557: 
  558: =head2 WantReadable
  559: 
  560: Return the state of the flag that indicates the object wants to be
  561: called when readable.
  562: 
  563: =cut
  564: 
  565: sub WantReadable {
  566:     my   $self = shift;
  567: 
  568:     return $self->{InformReadable};
  569: }
  570: 
  571: =pod
  572: 
  573: =head2 WantWritable
  574: 
  575: Return the state of the flag that indicates the object wants write
  576: notification.
  577: 
  578: =cut
  579: 
  580: sub WantWritable {
  581:     my $self = shift;
  582:     return $self->{InformWritable};
  583: }
  584: 
  585: =pod
  586: 
  587: =head2 WantTimeout
  588: 
  589: return the state of the flag that indicates the object wants to be
  590: informed of timeouts.
  591: 
  592: =cut
  593: 
  594: sub WantTimeout {
  595:     my $self = shift;
  596:     return $self->{Timeoutable};
  597: }
  598: 
  599: =pod
  600: 
  601: =head2 GetReply
  602: 
  603: Returns the reply from the last transaction.
  604: 
  605: =cut
  606: 
  607: sub GetReply {
  608:     my $self = shift;
  609:     return $self->{TransactionReply};
  610: }
  611: 
  612: =pod
  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: 
  620:   encrypt:command
  621: 
  622: The output string can be directly sent to lond as it is of the form:
  623: 
  624:   enc:length:<encodedrequest>
  625: 
  626: =cut
  627: 
  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: }
  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: 
  669: =cut
  670: 
  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: 
  683:     my $decrypted = "";
  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
  702: 
  703: =head2 GetHostIterator
  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: 
  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.
  714:  [4]   - IP address (result of e.g. nslookup [3]).
  715:  [5]   - Maximum connection count.
  716:  [6]   - Idle timeout for reducing connection count.
  717:  [7]   - Minimum connection count.
  718: 
  719: =cut
  720: 
  721: sub GetHostIterator {
  722: 
  723:     return HashIterator->new(\%hostshash);    
  724: }
  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: 
  804: 
  805: 1;
  806: 
  807: =pod
  808: 
  809: =head1 Theory
  810: 
  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.
  859: 
  860: =head2 Member data.
  861: 
  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.
  913: 
  914: 
  915: =head2 The following are callback like members:
  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: 
  933: 
  934: =head2 The following are operational member functions.
  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.
  960: 
  961: =item Shutdown:
  962: 
  963: Shuts off the socket.
  964: 
  965: =head2 The following are selector member functions:
  966: 
  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: 
  991: =cut

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