File:  [LON-CAPA] / loncom / LondConnection.pm
Revision 1.21: download - view: text, annotated - select for diffs
Mon Dec 22 11:03:17 2003 UTC (20 years, 4 months ago) by foxr
Branches: MAIN
CVS tags: HEAD
Debugging support for local configuration

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

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