Annotation of loncom/LondConnection.pm, revision 1.43

1.2       albertel    1: #   This module defines and implements a class that represents
                      2: #   a connection to a lond daemon.
                      3: #
1.43    ! raeburn     4: # $Id: LondConnection.pm,v 1.42 2006/08/25 21:20:11 albertel Exp $
1.2       albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
1.1       foxr       27: #
1.14      foxr       28: 
1.1       foxr       29: package LondConnection;
                     30: 
1.10      foxr       31: use strict;
1.1       foxr       32: use IO::Socket;
                     33: use IO::Socket::INET;
                     34: use IO::Handle;
                     35: use IO::File;
                     36: use Fcntl;
                     37: use POSIX;
                     38: use Crypt::IDEA;
1.31      foxr       39: use LONCAPA::lonlocal;
                     40: use LONCAPA::lonssl;
1.14      foxr       41: 
1.1       foxr       42: 
1.12      foxr       43: 
                     44: 
1.32      foxr       45: my $DebugLevel=0;
1.12      foxr       46: my %hostshash;
                     47: my %perlvar;
1.31      foxr       48: my $LocalDns = "";		# Need not be defined for managers.
                     49: my $InsecureOk;
1.1       foxr       50: 
1.14      foxr       51: #
1.16      foxr       52: #  Set debugging level
                     53: #
                     54: sub SetDebug {
                     55:     $DebugLevel = shift;
                     56: }
                     57: 
                     58: #
1.14      foxr       59: #   The config read is done in this way to support the read of
                     60: #   the non-default configuration file in the
                     61: #   event we are being used outside of loncapa.
                     62: #
                     63: 
                     64: my $ConfigRead = 0;
                     65: 
1.1       foxr       66: #   Read the configuration file for apache to get the perl
1.31      foxr       67: #   variables set.
1.1       foxr       68: 
1.12      foxr       69: sub ReadConfig {
1.31      foxr       70:     Debug(8, "ReadConfig called");
                     71: 
1.14      foxr       72:     my $perlvarref = read_conf('loncapa.conf');
1.12      foxr       73:     %perlvar    = %{$perlvarref};
1.14      foxr       74:     my $hoststab   = read_hosts(
1.21      foxr       75: 				"$perlvar{lonTabDir}/hosts.tab") || 
1.14      foxr       76: 				die "Can't read host table!!";
1.12      foxr       77:     %hostshash  = %{$hoststab};
1.17      foxr       78:     $ConfigRead = 1;
1.12      foxr       79:     
1.31      foxr       80:     my $myLonCapaName = $perlvar{lonHostID};
                     81:     Debug(8, "My loncapa name is $myLonCapaName");
                     82:     
                     83:     if(defined $hostshash{$myLonCapaName}) {
                     84: 	Debug(8, "My loncapa name is in hosthash");
                     85: 	my @ConfigLine = @{$hostshash{$myLonCapaName}};
                     86: 	$LocalDns = $ConfigLine[3];
                     87: 	Debug(8, "Got local name $LocalDns");
                     88:     }
                     89:     $InsecureOk = $perlvar{loncAllowInsecure};
                     90:     
                     91:     Debug(3, "ReadConfig - LocalDNS = $LocalDns");
1.12      foxr       92: }
                     93: 
1.15      foxr       94: #
                     95: #  Read a foreign configuration.
                     96: #  This sub is intended for the cases where the package
                     97: #  will be read from outside the LonCAPA environment, in that case
                     98: #  the client will need to explicitly provide:
                     99: #   - A file in hosts.tab format.
                    100: #   - Some idea of the 'lonCAPA' name of the local host (for building
                    101: #     the encryption key).
                    102: #
                    103: #  Parameters:
                    104: #      MyHost   - Name of this host as far as LonCAPA is concerned.
                    105: #      Filename - Name of a hosts.tab formatted file that will be used
                    106: #                 to build up the hosts table.
                    107: #
                    108: sub ReadForeignConfig {
1.30      foxr      109: 
                    110:     my ($MyHost, $Filename) = @_;
1.15      foxr      111: 
1.17      foxr      112:     &Debug(4, "ReadForeignConfig $MyHost $Filename\n");
                    113: 
1.15      foxr      114:     $perlvar{lonHostID} = $MyHost; # Rmember my host.
                    115:     my $hosttab = read_hosts($Filename) ||
                    116: 	die "Can't read hosts table!!";
1.17      foxr      117:     %hostshash = %{$hosttab};
                    118:     if($DebugLevel > 3) {
                    119: 	foreach my $host (keys %hostshash) {
1.31      foxr      120: 	    print STDERR "host $host => $hostshash{$host}\n";
1.17      foxr      121: 	}
                    122:     }
                    123:     $ConfigRead = 1;
1.1       foxr      124: 
1.31      foxr      125:     my $myLonCapaName = $perlvar{lonHostID};
                    126:     
                    127:     if(defined $hostshash{$myLonCapaName}) {
                    128: 	my @ConfigLine = @{$hostshash{$myLonCapaName}};
                    129: 	$LocalDns = $ConfigLine[3];
                    130:     }
                    131:     $InsecureOk = $perlvar{loncAllowInsecure};
                    132:     
                    133:     Debug(3, "ReadForeignConfig  - LocalDNS = $LocalDns");
                    134: 
1.15      foxr      135: }
1.1       foxr      136: 
                    137: sub Debug {
1.30      foxr      138: 
                    139:     my ($level, $message) = @_;
                    140: 
1.1       foxr      141:     if ($level < $DebugLevel) {
1.31      foxr      142: 	print STDERR ($message."\n");
1.1       foxr      143:     }
                    144: }
1.3       albertel  145: 
                    146: =pod
                    147: 
                    148: =head2 Dump
                    149: 
1.12      foxr      150: Dump the internal state of the object: For debugging purposes, to stderr.
1.3       albertel  151: 
1.1       foxr      152: =cut
                    153: 
                    154: sub Dump {
                    155:     my $self   = shift;
1.32      foxr      156:     my $level  = shift;
1.35      foxr      157:     my $now    = time;
                    158:     my $local  = localtime($now);
1.32      foxr      159:     
1.37      albertel  160:     if ($level >= $DebugLevel) {
1.32      foxr      161: 	return;
                    162:     }
                    163: 
1.35      foxr      164:     
1.10      foxr      165:     my $key;
                    166:     my $value;
1.35      foxr      167:     print STDERR "[ $local ] Dumping LondConnectionObject:\n";
1.37      albertel  168:     print STDERR join(':',caller(1))."\n";
1.1       foxr      169:     while(($key, $value) = each %$self) {
1.22      foxr      170: 	print STDERR "$key -> $value\n";
1.1       foxr      171:     }
1.23      foxr      172:     print STDERR "-------------------------------\n";
1.1       foxr      173: }
                    174: 
                    175: =pod
1.3       albertel  176: 
                    177: Local function to do a state transition.  If the state transition
                    178: callback is defined it is called with two parameters: the self and the
                    179: old state.
                    180: 
1.1       foxr      181: =cut
1.3       albertel  182: 
1.1       foxr      183: sub Transition {
1.30      foxr      184: 
                    185:     my ($self, $newstate) = @_;
                    186: 
1.1       foxr      187:     my $oldstate = $self->{State};
                    188:     $self->{State} = $newstate;
                    189:     $self->{TimeoutRemaining} = $self->{TimeoutValue};
                    190:     if($self->{TransitionCallback}) {
                    191: 	($self->{TransitionCallback})->($self, $oldstate); 
                    192:     }
                    193: }
                    194: 
1.3       albertel  195: 
1.14      foxr      196: 
1.1       foxr      197: =pod
1.3       albertel  198: 
                    199: =head2 new
                    200: 
                    201: Construct a new lond connection.
                    202: 
                    203: Parameters (besides the class name) include:
                    204: 
                    205: =item hostname
                    206: 
                    207: host the remote lond is on. This host is a host in the hosts.tab file
                    208: 
                    209: =item port
                    210: 
                    211:  port number the remote lond is listening on.
                    212: 
1.1       foxr      213: =cut
1.3       albertel  214: 
1.1       foxr      215: sub new {
1.39      albertel  216:     my ($class, $DnsName, $Port) = @_;
1.14      foxr      217: 
                    218:     if (!$ConfigRead) {
                    219: 	ReadConfig();
                    220: 	$ConfigRead = 1;
                    221:     }
1.39      albertel  222:     &Debug(4,$class."::new( ".$DnsName.",".$Port.")\n");
1.1       foxr      223: 
                    224:     # The host must map to an entry in the hosts table:
                    225:     #  We connect to the dns host that corresponds to that
                    226:     #  system and use the hostname for the encryption key 
                    227:     #  negotion.  In the objec these become the Host and
                    228:     #  LoncapaHim fields of the object respectively.
                    229:     #
1.39      albertel  230:     if (!exists $hostshash{$DnsName}) {
                    231: 	&Debug(8, "No Such host $DnsName");
1.1       foxr      232: 	return undef;		# No such host!!!
                    233:     }
1.39      albertel  234:     my @ConfigLine = @{$hostshash{$DnsName}};
                    235:     my $Hostname    = $ConfigLine[0]; # 0'th item is the msu id of host.
1.1       foxr      236:     Debug(5, "Connecting to ".$DnsName);
1.36      albertel  237:     # if it is me use loopback for connection
                    238:     if ($DnsName eq $LocalDns) { $DnsName="127.0.0.1"; }
                    239:     Debug(8, "Connecting to $DnsName I am $LocalDns");
1.1       foxr      240:     # Now create the object...
                    241:     my $self     = { Host               => $DnsName,
1.24      foxr      242:                      LoncapaHim         => $Hostname,
                    243:                      Port               => $Port,
                    244:                      State              => "Initialized",
1.31      foxr      245: 		     AuthenticationMode => "",
1.24      foxr      246:                      TransactionRequest => "",
                    247:                      TransactionReply   => "",
1.39      albertel  248:                      NextRequest        => "",
1.24      foxr      249:                      InformReadable     => 0,
                    250:                      InformWritable     => 0,
                    251:                      TimeoutCallback    => undef,
                    252:                      TransitionCallback => undef,
                    253:                      Timeoutable        => 0,
                    254:                      TimeoutValue       => 30,
                    255:                      TimeoutRemaining   => 0,
1.31      foxr      256: 		     LocalKeyFile       => "",
1.24      foxr      257:                      CipherKey          => "",
                    258:                      LondVersion        => "Unknown",
                    259:                      Cipher             => undef};
1.1       foxr      260:     bless($self, $class);
                    261:     unless ($self->{Socket} = IO::Socket::INET->new(PeerHost => $self->{Host},
1.27      foxr      262: 					       PeerPort => $self->{Port},
                    263: 					       Type     => SOCK_STREAM,
                    264: 					       Proto    => "tcp",
                    265: 					       Timeout  => 3)) {
1.36      albertel  266: 	Debug(8, "Error? \n$@ \n$!");
1.1       foxr      267: 	return undef;		# Inidicates the socket could not be made.
                    268:     }
1.31      foxr      269:     my $socket = $self->{Socket}; # For local use only.
1.33      foxr      270:     #  If we are local, we'll first try local auth mode, otherwise, we'll try
                    271:     #  the ssl auth mode:
1.31      foxr      272: 
                    273:     my $key;
                    274:     my $keyfile;
1.36      albertel  275:     if ($DnsName eq '127.0.0.1') {
1.31      foxr      276: 	$self->{AuthenticationMode} = "local";
                    277: 	($key, $keyfile)         = lonlocal::CreateKeyFile();
                    278: 	Debug(8, "Local key: $key, stored in $keyfile");
                    279: 	   
                    280: 	#  If I can't make the key file fall back to insecure if 
                    281: 	#  allowed...else give up right away.
                    282: 
                    283: 	if(!(defined $key) || !(defined $keyfile)) {
                    284: 	    if($InsecureOk) {
                    285: 		$self->{AuthenticationMode} = "insecure";
                    286: 		$self->{TransactionRequest} = "init\n";
                    287: 	    } 
                    288: 	    else {
                    289: 		$socket->close;
                    290: 		return undef;
                    291: 	    }
                    292: 	}
                    293: 	$self->{TransactionRequest} = "init:local:$keyfile\n";
                    294: 	Debug(9, "Init string is init:local:$keyfile");
                    295: 	if(!$self->CreateCipher($key)) { # Nothing's going our way...
                    296: 	    $socket->close;
                    297: 	    return undef;
                    298: 	}
                    299: 
1.42      albertel  300:     } else {
1.33      foxr      301: 	#  Remote peer:  I'd like to do ssl, but if my host key or certificates
                    302: 	#  are not all installed, my only choice is insecure, if that's 
                    303: 	#  allowed:
                    304: 
                    305: 	my ($ca, $cert) = lonssl::CertificateFile;
                    306: 	my $sslkeyfile  = lonssl::KeyFile;
                    307: 
                    308: 	if((defined $ca)  && (defined $cert) && (defined $sslkeyfile)) {
                    309: 
                    310: 	    $self->{AuthenticationMode} = "ssl";
                    311: 	    $self->{TransactionRequest} = "init:ssl\n";
                    312: 	} else {
                    313: 	    if($InsecureOk) {		# Allowed to do insecure:
                    314: 		$self->{AuthenticationMode} = "insecure";
                    315: 		$self->{TransactionRequest} = "init\n";
                    316: 	    }
                    317: 	    else {		# Not allowed to do insecure...
                    318: 		$socket->close;
                    319: 		return undef;
                    320: 	    }
                    321: 	}
1.31      foxr      322:     }
                    323: 
1.1       foxr      324:     #
                    325:     # We're connected.  Set the state, and the events we'll accept:
                    326:     #
                    327:     $self->Transition("Connected");
                    328:     $self->{InformWritable}     = 1;    # When  socket is writable we send init
1.9       foxr      329:     $self->{Timeoutable}        = 1;    # Timeout allowed during startup negotiation. 
1.31      foxr      330: 
1.1       foxr      331:     
                    332:     #
                    333:     # Set socket to nonblocking I/O.
                    334:     #
1.31      foxr      335:     my $flags    = fcntl($socket, F_GETFL,0);
                    336:     if(!$flags) {
1.1       foxr      337: 	$socket->close;
                    338: 	return undef;
                    339:     }
1.31      foxr      340:     if(!fcntl($socket, F_SETFL, $flags | O_NONBLOCK)) {
1.1       foxr      341: 	$socket->close;
                    342: 	return undef;
                    343:     }
                    344: 
                    345:     # return the object :
                    346: 
1.31      foxr      347:     Debug(9, "Initial object state: ");
1.32      foxr      348:     $self->Dump(9);
1.31      foxr      349: 
1.1       foxr      350:     return $self;
                    351: }
1.3       albertel  352: 
1.1       foxr      353: =pod
1.3       albertel  354: 
                    355: =head2 Readable
                    356: 
                    357: This member should be called when the Socket becomes readable.  Until
                    358: the read completes, action is state independet. Data are accepted into
                    359: the TransactionReply until a newline character is received.  At that
                    360: time actionis state dependent:
                    361: 
                    362: =item Connected
                    363: 
                    364: in this case we received challenge, the state changes to
                    365: ChallengeReceived, and we initiate a send with the challenge response.
                    366: 
                    367: =item ReceivingReply
                    368: 
                    369: In this case a reply has been received for a transaction, the state
                    370: goes to Idle and we disable write and read notification.
                    371: 
                    372: =item ChallengeReeived
                    373: 
                    374: we just got what should be an ok\n and the connection can now handle
                    375: transactions.
1.1       foxr      376: 
                    377: =cut
1.3       albertel  378: 
1.1       foxr      379: sub Readable {
                    380:     my $self    = shift;
                    381:     my $socket  = $self->{Socket};
                    382:     my $data    = '';
1.27      foxr      383:     my $rv;
1.31      foxr      384:     my $ConnectionMode = $self->{AuthenticationMode};
                    385: 
1.27      foxr      386:     if ($socket) {
                    387: 	eval {
                    388: 	    $rv = $socket->recv($data, POSIX::BUFSIZ, 0);
                    389: 	}
                    390:     } else {
                    391: 	$self->Transition("Disconnected");
                    392: 	return -1;
                    393:     }
1.1       foxr      394:     my $errno   = $! + 0;	             # Force numeric context.
                    395: 
1.8       foxr      396:     unless (defined($rv) && length $data) {# Read failed,
1.1       foxr      397: 	if(($errno == POSIX::EWOULDBLOCK)   ||
                    398: 	   ($errno == POSIX::EAGAIN)        ||
1.8       foxr      399: 	   ($errno == POSIX::EINTR)) {
1.1       foxr      400: 	    return 0;
                    401: 	}
                    402: 
                    403: 	# Connection likely lost.
                    404: 	&Debug(4, "Connection lost");
                    405: 	$self->{TransactionRequest} = '';
                    406: 	$socket->close();
                    407: 	$self->Transition("Disconnected");
                    408: 	return -1;
                    409:     }
                    410:     #  Append the data to the buffer.  And figure out if the read is done:
                    411: 
                    412:     &Debug(9,"Received from host: ".$data);
                    413:     $self->{TransactionReply} .= $data;
1.29      albertel  414:     if($self->{TransactionReply} =~ m/\n$/) {
1.1       foxr      415: 	&Debug(8,"Readable End of line detected");
1.31      foxr      416: 	
                    417: 
1.1       foxr      418: 	if ($self->{State}  eq "Initialized") { # We received the challenge:
1.31      foxr      419: 	    #   Our init was replied to. What happens next depends both on
                    420: 	    #  the actual init we sent (AuthenticationMode member data)
                    421: 	    #  and the response:
                    422: 	    #     AuthenticationMode == local:
                    423: 	    #       Response ok:   The key has been exchanged and
                    424: 	    #                      the key file destroyed. We can jump
                    425: 	    #                      into setting the host and requesting the
                    426: 	    #                      Later we'll also bypass key exchange.
                    427: 	    #       Response digits: 
                    428: 	    #                      Old style lond. Delete the keyfile.
                    429: 	    #                      If allowed fall back to insecure mode.
                    430: 	    #                      else close connection and fail.
                    431: 	    #       Response other:
                    432: 	    #                      Failed local auth 
                    433: 	    #                      Close connection and fail.
                    434: 	    #
                    435: 	    #    AuthenticationMode == ssl:
                    436: 	    #        Response ok:ssl
                    437: 	    #        Response digits:
                    438: 	    #        Response other:
                    439: 	    #    Authentication mode == insecure
                    440: 	    #        Response digits
                    441: 	    #        Response other:
                    442: 	    
                    443: 	    my $Response = $self->{TransactionReply};
                    444: 	    if($ConnectionMode eq "local") {
                    445: 		if($Response =~ /^ok:local/) { #  Good local auth.
                    446: 		    $self->ToVersionRequest();
                    447: 		    return 0;
                    448: 		}
                    449: 		elsif ($Response =~/^[0-9]+/) {	# Old style lond.
                    450: 		    return $self->CompleteInsecure();
                    451: 
                    452: 		}
                    453: 		else {		                # Complete flop
                    454: 		    &Debug(3, "init:local : unrecognized reply");
                    455: 		    $self->Transition("Disconnected");
                    456: 		    $socket->close;
                    457: 		    return -1;
                    458: 		}
                    459: 	    }
                    460: 	    elsif ($ConnectionMode eq "ssl") {
                    461: 		if($Response =~ /^ok:ssl/) {     # Good ssl...
                    462: 		    if($self->ExchangeKeysViaSSL()) { # Success skip to vsn stuff
                    463: 			# Need to reset to non blocking:
                    464: 
                    465: 			my $flags = fcntl($socket, F_GETFL, 0);
                    466: 			fcntl($socket, F_SETFL, $flags | O_NONBLOCK);
                    467: 			$self->ToVersionRequest();
                    468: 			return 0;
                    469: 		    }
                    470: 		    else {	         # Failed in ssl exchange.
                    471: 			&Debug(3,"init:ssl failed key negotiation!");
                    472: 			$self->Transition("Disconnected");
                    473: 			$socket->close;
                    474: 			return -1;
                    475: 		    }
                    476: 		} 
                    477: 		elsif ($Response =~ /^[0-9]+/) { # Old style lond.
                    478: 		    return $self->CompleteInsecure();
                    479: 		}
                    480: 		else {		                 # Complete flop
                    481: 		}
                    482: 	    }
                    483: 	    elsif ($ConnectionMode eq "insecure") {
                    484: 		if($self->{TransactionReply} eq "refused\n") {	# Remote doesn't have
                    485: 		    
                    486: 		    $self->Transition("Disconnected"); # in host tables.
                    487: 		    $socket->close();
                    488: 		    return -1;
                    489: 
                    490: 		}
                    491: 		return $self->CompleteInsecure();
                    492: 	    }
                    493: 	    else {
                    494: 		&Debug(1,"Authentication mode incorrect");
                    495: 		die "BUG!!! LondConnection::Readable invalid authmode";
1.1       foxr      496: 	    }
1.27      foxr      497: 
1.31      foxr      498: 
1.28      albertel  499: 	}  elsif ($self->{State} eq "ChallengeReplied") {
                    500: 	    if($self->{TransactionReply} ne "ok\n") {
                    501: 		$self->Transition("Disconnected");
                    502: 		$socket->close();
                    503: 		return -1;
                    504: 	    }
1.31      foxr      505: 	    $self->ToVersionRequest();
1.28      albertel  506: 	    return 0;
1.31      foxr      507: 
1.28      albertel  508: 	} elsif ($self->{State} eq "ReadingVersionString") {
1.38      albertel  509: 	    chomp($self->{TransactionReply});
                    510: 	    $self->{LondVersion}       = $self->{TransactionReply};
1.28      albertel  511: 	    $self->Transition("SetHost");
                    512: 	    $self->{InformReadable}    = 0;
                    513: 	    $self->{InformWritable}    = 1;
                    514: 	    my $peer = $self->{LoncapaHim};
                    515: 	    $self->{TransactionRequest}= "sethost:$peer\n";
                    516: 	    return 0;
1.24      foxr      517: 	} elsif ($self->{State} eq "HostSet") { # should be ok.
1.28      albertel  518: 	    if($self->{TransactionReply} ne "ok\n") {
                    519: 		$self->Transition("Disconnected");
                    520: 		$socket->close();
                    521: 		return -1;
                    522: 	    }
1.31      foxr      523: 	    #  If the auth mode is insecure we must still
                    524: 	    #  exchange session keys. Otherwise,
                    525: 	    #  we can just transition to idle.
                    526: 
                    527: 	    if($ConnectionMode eq "insecure") {
                    528: 		$self->Transition("RequestingKey");
                    529: 		$self->{InformReadable}  = 0;
                    530: 		$self->{InformWritable}  = 1;
                    531: 		$self->{TransactionRequest} = "ekey\n";
                    532: 		return 0;
                    533: 	    }
                    534: 	    else {
                    535: 		$self->ToIdle();
                    536: 		return 0;
                    537: 	    }
1.1       foxr      538: 	} elsif ($self->{State}  eq "ReceivingKey") {
                    539: 	    my $buildkey = $self->{TransactionReply};
                    540: 	    my $key = $self->{LoncapaHim}.$perlvar{'lonHostID'};
                    541: 	    $key=~tr/a-z/A-Z/;
                    542: 	    $key=~tr/G-P/0-9/;
                    543: 	    $key=~tr/Q-Z/0-9/;
1.31      foxr      544: 	    $key =$key.$buildkey.$key.$buildkey.$key.$buildkey;
                    545: 	    $key               = substr($key,0,32);
                    546: 	    if(!$self->CreateCipher($key)) {
1.1       foxr      547: 		$self->Transition("Disconnected");
                    548: 		$socket->close();
                    549: 		return -1;
                    550: 	    } else {
1.31      foxr      551: 		$self->ToIdle();
1.1       foxr      552: 		return 0;
                    553: 	    }
                    554: 	} elsif ($self->{State}  eq "ReceivingReply") {
                    555: 
                    556: 	    # If the data are encrypted, decrypt first.
                    557: 
                    558: 	    my $answer = $self->{TransactionReply};
                    559: 	    if($answer =~ /^enc\:/) {
                    560: 		$answer = $self->Decrypt($answer);
1.34      foxr      561: 		$self->{TransactionReply} = "$answer\n";
1.1       foxr      562: 	    }
1.39      albertel  563: 	    # if we have a NextRequest do it immeadiately
                    564: 	    if ($self->{NextRequest}) {
                    565: 		$self->{TransactionRequest} = $self->{NextRequest};
                    566: 		undef( $self->{NextRequest} );
                    567: 		$self->{TransactionReply}   = "";
                    568: 		$self->{InformWritable}     = 1;
                    569: 		$self->{InformReadable}     = 0;
                    570: 		$self->{Timeoutable}        = 1;
                    571: 		$self->{TimeoutRemaining}   = $self->{TimeoutValue};
                    572: 		$self->Transition("SendingRequest");
                    573: 		return 0;
                    574: 	    } else {
1.1       foxr      575: 	    # finish the transaction
                    576: 
1.39      albertel  577: 		$self->ToIdle();
                    578: 		return 0;
                    579: 	    }
1.1       foxr      580: 	} elsif ($self->{State} eq "Disconnected") { # No connection.
                    581: 	    return -1;
                    582: 	} else {			# Internal error: Invalid state.
                    583: 	    $self->Transition("Disconnected");
                    584: 	    $socket->close();
                    585: 	    return -1;
                    586: 	}
                    587:     }
                    588: 
                    589:     return 0;
1.27      foxr      590:     
1.1       foxr      591: }
                    592: 
                    593: 
                    594: =pod
1.3       albertel  595: 
                    596: This member should be called when the Socket becomes writable.
                    597: 
                    598: The action is state independent. An attempt is made to drain the
                    599: contents of the TransactionRequest member.  Once this is drained, we
                    600: mark the object as waiting for readability.
1.1       foxr      601: 
                    602: Returns  0 if successful, or -1 if not.
1.3       albertel  603: 
1.1       foxr      604: =cut
                    605: sub Writable {
                    606:     my $self     = shift;		# Get reference to the object.
                    607:     my $socket   = $self->{Socket};
1.26      albertel  608:     my $nwritten;
                    609:     if ($socket) {
                    610: 	eval {
                    611: 	    $nwritten = $socket->send($self->{TransactionRequest}, 0);
                    612: 	}
1.27      foxr      613:     } else {
                    614: 	# For whatever reason, there's no longer a socket left.
                    615: 
                    616: 
                    617: 	$self->Transition("Disconnected");
                    618: 	return -1;
1.26      albertel  619:     }
1.1       foxr      620:     my $errno    = $! + 0;
                    621:     unless (defined $nwritten) {
                    622: 	if($errno != POSIX::EINTR) {
                    623: 	    $self->Transition("Disconnected");
                    624: 	    return -1;
                    625: 	}
                    626:       
                    627:     }
1.10      foxr      628:     if (($nwritten >= 0)                        ||
1.1       foxr      629:         ($errno == POSIX::EWOULDBLOCK)    ||
                    630: 	($errno == POSIX::EAGAIN)         ||
                    631: 	($errno == POSIX::EINTR)          ||
                    632: 	($errno ==  0)) {
                    633: 	substr($self->{TransactionRequest}, 0, $nwritten) = ""; # rmv written part
1.27      foxr      634:       if(length $self->{TransactionRequest} == 0) {
                    635:          $self->{InformWritable} = 0;
                    636:          $self->{InformReadable} = 1;
                    637:          $self->{TransactionReply} = '';
                    638:          #
                    639:          # Figure out the next state:
                    640:          #
                    641:          if($self->{State} eq "Connected") {
                    642:             $self->Transition("Initialized");
                    643:          } elsif($self->{State} eq "ChallengeReceived") {
                    644:             $self->Transition("ChallengeReplied");
                    645:          } elsif($self->{State} eq "RequestingVersion") {
                    646:             $self->Transition("ReadingVersionString");
                    647:          } elsif ($self->{State} eq "SetHost") {
                    648:             $self->Transition("HostSet");
                    649:          } elsif($self->{State} eq "RequestingKey") {
                    650:             $self->Transition("ReceivingKey");
1.24      foxr      651: #            $self->{InformWritable} = 0;
                    652: #            $self->{InformReadable} = 1;
                    653: #            $self->{TransactionReply} = '';
1.27      foxr      654:          } elsif ($self->{State} eq "SendingRequest") {
                    655:             $self->Transition("ReceivingReply");
                    656:             $self->{TimeoutRemaining} = $self->{TimeoutValue};
                    657:          } elsif ($self->{State} eq "Disconnected") {
                    658:             return -1;
                    659:          }
                    660:          return 0;
                    661:       }
                    662:    } else {			# The write failed (e.g. partner disconnected).
                    663:       $self->Transition("Disconnected");
                    664:       $socket->close();
                    665:       return -1;
                    666:    }
                    667: 	
1.1       foxr      668: }
                    669: =pod
1.3       albertel  670: 
                    671: =head2 Tick
                    672: 
1.1       foxr      673:    Tick is called every time unit by the event framework.  It
1.3       albertel  674: 
                    675: =item 1 decrements the remaining timeout.
                    676: 
                    677: =item 2 If the timeout is zero, calls TimedOut indicating that the current operation timed out.
1.1       foxr      678: 
                    679: =cut
                    680:     
                    681: sub Tick {
                    682:     my $self = shift;
                    683:     $self->{TimeoutRemaining}--;
                    684:     if ($self->{TimeoutRemaining} < 0) {
                    685: 	$self->TimedOut();
                    686:     }
                    687: }
1.3       albertel  688: 
1.1       foxr      689: =pod
                    690: 
1.3       albertel  691: =head2 TimedOut
                    692: 
                    693: called on a timeout.  If the timeout callback is defined, it is called
                    694: with $self as its parameters.
                    695: 
                    696: =cut
                    697: 
1.1       foxr      698: sub TimedOut  {
                    699: 
                    700:     my $self = shift;
                    701:     if($self->{TimeoutCallback}) {
                    702: 	my $callback = $self->{TimeoutCallback};
                    703: 	my @args = ( $self);
                    704: 	&$callback(@args);
                    705:     }
                    706: }
1.3       albertel  707: 
1.1       foxr      708: =pod
1.3       albertel  709: 
                    710: =head2 InitiateTransaction
                    711: 
                    712: Called to initiate a transaction.  A transaction can only be initiated
                    713: when the object is idle... otherwise an error is returned.  A
                    714: transaction consists of a request to the server that will have a
                    715: reply.  This member sets the request data in the TransactionRequest
                    716: member, makes the state SendingRequest and sets the data to allow a
                    717: timout, and to request writability notification.
                    718: 
1.1       foxr      719: =cut
1.3       albertel  720: 
1.1       foxr      721: sub InitiateTransaction {
1.30      foxr      722: 
                    723:     my ($self, $data) = @_;
1.1       foxr      724: 
1.4       foxr      725:     Debug(1, "initiating transaction: ".$data);
1.1       foxr      726:     if($self->{State} ne "Idle") {
1.4       foxr      727: 	Debug(0," .. but not idle here\n");
1.1       foxr      728: 	return -1;		# Error indicator.
                    729:     }
                    730:     # if the transaction is to be encrypted encrypt the data:
1.39      albertel  731:     (my $sethost, my $server,$data)=split(/:/,$data,3);
1.1       foxr      732: 
                    733:     if($data =~ /^encrypt\:/) {
                    734: 	$data = $self->Encrypt($data);
                    735:     }
                    736: 
                    737:     # Setup the trasaction
1.39      albertel  738:     # currently no version of lond supports inlining the sethost
1.40      albertel  739:     if ($self->PeerVersion() <= 321) {
1.39      albertel  740: 	if ($server ne $self->{LoncapaHim}) {
                    741: 	    $self->{NextRequest}        = $data;
                    742: 	    $self->{TransactionRequest} = "$sethost:$server\n";
                    743: 	    $self->{LoncapaHim}         = $server;
                    744: 	} else {
                    745: 	    $self->{TransactionRequest}        = $data;
                    746: 	}
                    747:     } else {
1.40      albertel  748: 	$self->{LoncapaHim}         = $server;
1.39      albertel  749: 	$self->{TransactionRequest} = "$sethost:$server:$data";
                    750:     }
1.1       foxr      751:     $self->{TransactionReply}   = "";
                    752:     $self->{InformWritable}     = 1;
                    753:     $self->{InformReadable}     = 0;
                    754:     $self->{Timeoutable}        = 1;
                    755:     $self->{TimeoutRemaining}   = $self->{TimeoutValue};
                    756:     $self->Transition("SendingRequest");
                    757: }
                    758: 
                    759: 
                    760: =pod
1.3       albertel  761: 
                    762: =head2 SetStateTransitionCallback
                    763: 
                    764: Sets a callback for state transitions.  Returns a reference to any
                    765: prior established callback, or undef if there was none:
                    766: 
1.1       foxr      767: =cut
1.3       albertel  768: 
1.1       foxr      769: sub SetStateTransitionCallback {
                    770:     my $self        = shift;
                    771:     my $oldCallback = $self->{TransitionCallback};
                    772:     $self->{TransitionCallback} = shift;
                    773:     return $oldCallback;
                    774: }
1.3       albertel  775: 
1.1       foxr      776: =pod
1.3       albertel  777: 
                    778: =head2 SetTimeoutCallback
                    779: 
                    780: Sets the timeout callback.  Returns a reference to any prior
                    781: established callback or undef if there was none.
                    782: 
1.1       foxr      783: =cut
1.3       albertel  784: 
1.1       foxr      785: sub SetTimeoutCallback {
1.30      foxr      786: 
                    787:     my ($self, $callback) = @_;
                    788: 
1.1       foxr      789:     my $oldCallback          = $self->{TimeoutCallback};
                    790:     $self->{TimeoutCallback} = $callback;
                    791:     return $oldCallback;
                    792: }
                    793: 
                    794: =pod
1.3       albertel  795: 
1.5       foxr      796: =head2 Shutdown:
                    797: 
                    798: Shuts down the socket.
                    799: 
                    800: =cut
                    801: 
                    802: sub Shutdown {
                    803:     my $self = shift;
                    804:     my $socket = $self->GetSocket();
1.20      albertel  805:     Debug(5,"socket is -$socket-");
                    806:     if ($socket) {
                    807: 	# Ask lond to exit too.  Non blocking so
                    808: 	# there is no cost for failure.
                    809: 	eval {
                    810: 	    $socket->send("exit\n", 0);
                    811: 	    $socket->shutdown(2);
                    812: 	}
                    813:     }
1.5       foxr      814: }
                    815: 
                    816: =pod
                    817: 
1.3       albertel  818: =head2 GetState
                    819: 
                    820: selector for the object state.
                    821: 
1.1       foxr      822: =cut
1.3       albertel  823: 
1.1       foxr      824: sub GetState {
                    825:     my $self = shift;
                    826:     return $self->{State};
                    827: }
1.3       albertel  828: 
1.1       foxr      829: =pod
1.3       albertel  830: 
                    831: =head2 GetSocket
                    832: 
                    833: selector for the object socket.
                    834: 
1.1       foxr      835: =cut
1.3       albertel  836: 
1.1       foxr      837: sub GetSocket {
                    838:     my $self  = shift;
                    839:     return $self->{Socket};
                    840: }
1.3       albertel  841: 
1.5       foxr      842: 
1.1       foxr      843: =pod
1.3       albertel  844: 
                    845: =head2 WantReadable
                    846: 
                    847: Return the state of the flag that indicates the object wants to be
                    848: called when readable.
                    849: 
1.1       foxr      850: =cut
1.3       albertel  851: 
1.1       foxr      852: sub WantReadable {
                    853:     my   $self = shift;
                    854: 
                    855:     return $self->{InformReadable};
                    856: }
1.3       albertel  857: 
1.1       foxr      858: =pod
1.3       albertel  859: 
                    860: =head2 WantWritable
                    861: 
                    862: Return the state of the flag that indicates the object wants write
                    863: notification.
                    864: 
1.1       foxr      865: =cut
1.3       albertel  866: 
1.1       foxr      867: sub WantWritable {
                    868:     my $self = shift;
                    869:     return $self->{InformWritable};
                    870: }
1.3       albertel  871: 
1.1       foxr      872: =pod
1.3       albertel  873: 
                    874: =head2 WantTimeout
                    875: 
                    876: return the state of the flag that indicates the object wants to be
                    877: informed of timeouts.
                    878: 
1.1       foxr      879: =cut
1.3       albertel  880: 
1.1       foxr      881: sub WantTimeout {
                    882:     my $self = shift;
                    883:     return $self->{Timeoutable};
                    884: }
                    885: 
                    886: =pod
1.3       albertel  887: 
                    888: =head2 GetReply
                    889: 
                    890: Returns the reply from the last transaction.
                    891: 
1.1       foxr      892: =cut
1.3       albertel  893: 
1.1       foxr      894: sub GetReply {
                    895:     my $self = shift;
                    896:     return $self->{TransactionReply};
                    897: }
                    898: 
                    899: =pod
1.3       albertel  900: 
                    901: =head2 Encrypt
                    902: 
                    903: Returns the encrypted version of the command string.
                    904: 
                    905: The command input string is of the form:
                    906: 
1.1       foxr      907:   encrypt:command
1.3       albertel  908: 
                    909: The output string can be directly sent to lond as it is of the form:
                    910: 
1.1       foxr      911:   enc:length:<encodedrequest>
1.3       albertel  912: 
1.1       foxr      913: =cut
1.3       albertel  914: 
1.1       foxr      915: sub Encrypt {
1.30      foxr      916:     
                    917:     my ($self, $request) = @_;
1.1       foxr      918: 
                    919:    
                    920:     # Split the encrypt: off the request and figure out it's length.
                    921:     # the cipher works in blocks of 8 bytes.
                    922: 
                    923:     my $cmd = $request;
                    924:     $cmd    =~ s/^encrypt\://;	# strip off encrypt:
                    925:     chomp($cmd);		# strip off trailing \n
                    926:     my     $length=length($cmd);	# Get the string length.
                    927:     $cmd .= "         ";	# Pad with blanks so we can fill out a block.
                    928: 
                    929:     # encrypt the request in 8 byte chunks to create the encrypted
                    930:     # output request.
                    931: 
                    932:     my $Encoded = '';
                    933:     for(my $index = 0; $index <= $length; $index += 8) {
                    934: 	$Encoded .= 
                    935: 	    unpack("H16", 
                    936: 		   $self->{Cipher}->encrypt(substr($cmd, 
                    937: 						   $index, 8)));
                    938:     }
                    939: 
                    940:     # Build up the answer as enc:length:$encrequest.
                    941: 
                    942:     $request = "enc:$length:$Encoded\n";
                    943:     return $request;
                    944:     
                    945:     
                    946: }
1.3       albertel  947: 
                    948: =pod
                    949: 
                    950: =head2 Decrypt
                    951: 
                    952: Decrypt a response from the server.  The response is in the form:
                    953: 
                    954:  enc:<length>:<encrypted data>
                    955: 
1.1       foxr      956: =cut
1.3       albertel  957: 
1.1       foxr      958: sub Decrypt {
1.30      foxr      959: 
                    960:     my ($self, $encrypted) = @_;
1.1       foxr      961: 
                    962:     #  Bust up the response into length, and encryptedstring:
                    963: 
                    964:     my ($enc, $length, $EncryptedString) = split(/:/,$encrypted);
                    965:     chomp($EncryptedString);
                    966: 
                    967:     # Decode the data in 8 byte blocks.  The string is encoded
                    968:     # as hex digits so there are two characters per byte:
                    969: 
1.10      foxr      970:     my $decrypted = "";
1.1       foxr      971:     for(my $index = 0; $index < length($EncryptedString);
                    972: 	$index += 16) {
                    973: 	$decrypted .= $self->{Cipher}->decrypt(
                    974: 				    pack("H16",
                    975: 					 substr($EncryptedString,
                    976: 						$index, 
                    977: 						16)));
                    978:     }
                    979:     #  the answer may have trailing pads to fill out a block.
                    980:     #  $length tells us the actual length of the decrypted string:
                    981: 
                    982:     $decrypted = substr($decrypted, 0, $length);
1.34      foxr      983:     Debug(9, "Decrypted $EncryptedString to $decrypted");
1.1       foxr      984: 
                    985:     return $decrypted;
                    986: 
                    987: }
1.31      foxr      988: # ToIdle
                    989: #     Called to transition to idle... done enough it's worth subbing
                    990: #     off to ensure it's always done right!!
                    991: #
                    992: sub ToIdle {
                    993:     my $self   = shift;
                    994: 
                    995:     $self->Transition("Idle");
                    996:     $self->{InformWritiable} = 0;
                    997:     $self->{InformReadable}  = 0;
                    998:     $self->{Timeoutable}     = 0;
                    999: }
                   1000: 
                   1001: #  ToVersionRequest
                   1002: #    Called to transition to "RequestVersion"  also done a few times
                   1003: #    so worth subbing out.
                   1004: #
                   1005: sub ToVersionRequest {
                   1006:     my $self   = shift;
                   1007:     
                   1008:     $self->Transition("RequestingVersion");
                   1009:     $self->{InformReadable}   = 0;
                   1010:     $self->{InformWritable}   = 1;
                   1011:     $self->{TransactionRequest} = "version\n";
                   1012:     
                   1013: }
                   1014: #
                   1015: #  CreateCipher
                   1016: #    Given a cipher key stores the key in the object context,
                   1017: #    creates the cipher object, (stores that in object context),
                   1018: #    This is done a couple of places, so it's worth factoring it out.
                   1019: #
                   1020: # Parameters:
                   1021: #    (self)
                   1022: #    key - The Cipher key.
                   1023: #
                   1024: # Returns:
                   1025: #    0   - Failure to create IDEA cipher.
                   1026: #    1   - Success.
                   1027: #
                   1028: sub CreateCipher {
                   1029:     my ($self, $key)   = @_;	# According to coding std.
                   1030: 
                   1031:     $self->{CipherKey} = $key; # Save the text key...
                   1032:     my $packedkey = pack ("H32", $key);
                   1033:     my $cipher            = new IDEA $packedkey;
                   1034:     if($cipher) {
                   1035: 	$self->{Cipher} = $cipher;
                   1036: 	Debug("Cipher created  dumping socket: ");
1.32      foxr     1037: 	$self->Dump(9);
1.31      foxr     1038: 	return 1;
                   1039:     }
                   1040:     else {
                   1041: 	return 0;
                   1042:     }
                   1043: }
                   1044: # ExchangeKeysViaSSL
                   1045: #     Called to do cipher key exchange via SSL.
                   1046: #     The socket is promoted to an SSL socket. If that's successful,
                   1047: #     we read out cipher key through the socket and create an IDEA
                   1048: #     cipher object.
                   1049: # Parameters:
                   1050: #    (self)
                   1051: # Returns:
                   1052: #      true    - Success.
                   1053: #      false   - Failure.
                   1054: #
                   1055: # Assumptions:
                   1056: #  1.   The ssl session setup has timeout logic built in so we don't
                   1057: #     have to worry about DOS attacks at that stage.
                   1058: #  2.   If the ssl session gets set up we are talking to a legitimate
                   1059: #     lond so again we don't have to worry about DOS attacks.
                   1060: #  All this allows us just to call 
                   1061: sub ExchangeKeysViaSSL {
                   1062:     my $self   = shift;
                   1063:     my $socket = $self->{Socket};
                   1064: 
                   1065:     #  Get our signed certificate, the certificate authority's 
                   1066:     #  certificate and our private key file.  All of these
                   1067:     #  are needed to create the ssl connection.
                   1068: 
                   1069:     my ($SSLCACertificate,
                   1070: 	$SSLCertificate) = lonssl::CertificateFile();
                   1071:     my $SSLKey             = lonssl::KeyFile();
                   1072: 
                   1073:     #  Promote our connection to ssl and read the key from lond.
                   1074: 
                   1075:     my $SSLSocket = lonssl::PromoteClientSocket($socket,
                   1076: 						$SSLCACertificate,
                   1077: 						$SSLCertificate,
                   1078: 						$SSLKey);
                   1079:     if(defined $SSLSocket) {
                   1080: 	my $key  = <$SSLSocket>;
                   1081: 	lonssl::Close($SSLSocket);
                   1082: 	if($key) {
                   1083: 	    chomp($key);	# \n is not part of the key.
                   1084: 	    return $self->CreateCipher($key);
                   1085: 	} 
                   1086: 	else {
                   1087: 	    Debug(3, "Failed to read ssl key");
                   1088: 	    return 0;
                   1089: 	}
                   1090:     }
                   1091:     else {
                   1092: 	# Failed!!
                   1093: 	Debug(3, "Failed to negotiate SSL connection!");
                   1094: 	return 0;
                   1095:     }
                   1096:     # should not get here
                   1097:     return 0;
                   1098: 
                   1099: }
                   1100: 
                   1101: 
                   1102: 
                   1103: #
                   1104: #  CompleteInsecure:
                   1105: #      This function is called to initiate the completion of
                   1106: #      insecure challenge response negotiation.
                   1107: #      To do this, we copy the challenge string to the transaction
                   1108: #      request, flip to writability and state transition to 
                   1109: #      ChallengeReceived..
                   1110: #      All this is only possible if InsecureOk is true.
                   1111: # Parameters:
                   1112: #      (self)    - This object's context hash.
                   1113: #  Return:
                   1114: #      0   - Ok to transition.
                   1115: #     -1   - Not ok to transition (InsecureOk not ok).
                   1116: #
                   1117: sub CompleteInsecure {
                   1118:     my $self = shift;
                   1119:     if($InsecureOk) {
                   1120: 	$self->{AuthenticationMode} = "insecure";
                   1121: 	&Debug(8," Transition out of Initialized:insecure");
                   1122: 	$self->{TransactionRequest} = $self->{TransactionReply};
                   1123: 	$self->{InformWritable}     = 1;
                   1124: 	$self->{InformReadable}     = 0;
                   1125: 	$self->Transition("ChallengeReceived");
                   1126: 	$self->{TimeoutRemaining}   = $self->{TimeoutValue};
                   1127: 	return 0;
                   1128: 	
                   1129: 	
                   1130:     }
                   1131:     else {
                   1132: 	&Debug(3, "Insecure key negotiation disabled!");
                   1133: 	my $socket = $self->{Socket};
                   1134: 	$socket->close;
                   1135: 	return -1;
                   1136:     }
                   1137: }
1.1       foxr     1138: 
                   1139: =pod
1.3       albertel 1140: 
                   1141: =head2 GetHostIterator
1.1       foxr     1142: 
                   1143: Returns a hash iterator to the host information.  Each get from 
                   1144: this iterator returns a reference to an array that contains 
                   1145: information read from the hosts configuration file.  Array elements
                   1146: are used as follows:
                   1147: 
1.41      albertel 1148:  [0]   - LonCapa host id.
1.3       albertel 1149:  [1]   - LonCapa domain name.
                   1150:  [2]   - Loncapa role (e.g. library or access).
                   1151:  [3]   - DNS name server hostname.
1.11      foxr     1152:  [4]   - IP address (result of e.g. nslookup [3]).
1.3       albertel 1153:  [5]   - Maximum connection count.
                   1154:  [6]   - Idle timeout for reducing connection count.
                   1155:  [7]   - Minimum connection count.
1.1       foxr     1156: 
1.3       albertel 1157: =cut
1.1       foxr     1158: 
                   1159: sub GetHostIterator {
                   1160: 
                   1161:     return HashIterator->new(\%hostshash);    
                   1162: }
1.14      foxr     1163: 
                   1164: ###########################################################
                   1165: #
                   1166: #  The following is an unashamed kludge that is here to
                   1167: # allow LondConnection to be used outside of the
                   1168: # loncapa environment (e.g. by lonManage).
                   1169: # 
                   1170: #   This is a textual inclusion of pieces of the
                   1171: #   Configuration.pm module.
                   1172: #
                   1173: 
                   1174: 
1.43    ! raeburn  1175: my @confdirs=('/etc/httpd/conf/','/etc/apache2/');
1.14      foxr     1176: 
                   1177: # ------------------- Subroutine read_conf: read LON-CAPA server configuration.
                   1178: # This subroutine reads PerlSetVar values out of specified web server
                   1179: # configuration files.
                   1180: sub read_conf
                   1181:   {
                   1182:     my (@conf_files)=@_;
1.43    ! raeburn  1183:     my (%perlvar,%configdirs);
        !          1184:     foreach my $filename (@conf_files,'loncapa_apache.conf') {
        !          1185:         my $configdir = '';
        !          1186:         $configdirs{$filename} = [@confdirs];
        !          1187:         while ($configdir eq '' && @{$configdirs{$filename}} > 0) {
        !          1188:             my $testdir = shift(@{$configdirs{$filename}});
        !          1189:             if (-e $testdir.$filename) {
        !          1190:                 $configdir = $testdir;
        !          1191:             }
        !          1192:         }
        !          1193:         if ($configdir eq '') {
        !          1194:             die("Couldn't find a directory containing $filename");
        !          1195:         }
        !          1196: 	if($DebugLevel > 3) {
        !          1197: 	    print STDERR ("Going to read $configdir.$filename\n");
        !          1198: 	}
        !          1199: 	open(CONFIG,'<'.$configdir.$filename) or
        !          1200: 	    die("Can't read $configdir$filename");
        !          1201: 	while (my $configline=<CONFIG>) {
        !          1202: 	    if ($configline =~ /^[^\#]*PerlSetVar/) {
        !          1203: 	        my ($unused,$varname,$varvalue)=split(/\s+/,$configline);
1.14      foxr     1204: 		chomp($varvalue);
                   1205: 		$perlvar{$varname}=$varvalue;
1.43    ! raeburn  1206: 	    }
        !          1207: 	}
1.14      foxr     1208: 	close(CONFIG);
1.43    ! raeburn  1209:     }
1.21      foxr     1210:     if($DebugLevel > 3) {
1.31      foxr     1211: 	print STDERR "Dumping perlvar:\n";
1.21      foxr     1212: 	foreach my $var (keys %perlvar) {
1.31      foxr     1213: 	    print STDERR "$var = $perlvar{$var}\n";
1.21      foxr     1214: 	}
                   1215:     }
1.14      foxr     1216:     my $perlvarref=\%perlvar;
1.21      foxr     1217:     return $perlvarref;
                   1218: }
1.14      foxr     1219: 
                   1220: #---------------------- Subroutine read_hosts: Read a LON-CAPA hosts.tab
                   1221: # formatted configuration file.
                   1222: #
1.36      albertel 1223: my $RequiredCount = 4;		# Required item count in hosts.tab.
1.14      foxr     1224: my $DefaultMaxCon = 5;		# Default value for maximum connections.
                   1225: my $DefaultIdle   = 1000;       # Default connection idle time in seconds.
                   1226: my $DefaultMinCon = 0;          # Default value for minimum connections.
                   1227: 
                   1228: sub read_hosts {
                   1229:     my $Filename = shift;
                   1230:     my %HostsTab;
                   1231:     
1.36      albertel 1232:     open(CONFIG,'<'.$Filename) or die("Can't read $Filename");
1.14      foxr     1233:     while (my $line = <CONFIG>) {
1.36      albertel 1234: 	if ($line !~ /^\s*\#/) {
                   1235: 	    $line=~s/\s*$//;
1.14      foxr     1236: 	    my @items = split(/:/, $line);
                   1237: 	    if(scalar @items >= $RequiredCount) {
                   1238: 		if (scalar @items == $RequiredCount) { # Only required items:
                   1239: 		    $items[$RequiredCount] = $DefaultMaxCon;
                   1240: 		}
                   1241: 		if(scalar @items == $RequiredCount + 1) { # up through maxcon.
                   1242: 		    $items[$RequiredCount+1] = $DefaultIdle;
                   1243: 		}
                   1244: 		if(scalar @items == $RequiredCount + 2) { # up through idle.
                   1245: 		    $items[$RequiredCount+2] = $DefaultMinCon;
                   1246: 		}
                   1247: 		{
                   1248: 		    my @list = @items; # probably not needed but I'm unsure of 
                   1249: 		    # about the scope of item so...
1.39      albertel 1250: 		    $HostsTab{$list[3]} = \@list; 
1.14      foxr     1251: 		}
                   1252: 	    }
                   1253: 	}
                   1254:     }
                   1255:     close(CONFIG);
                   1256:     my $hostref = \%HostsTab;
                   1257:     return ($hostref);
                   1258: }
1.24      foxr     1259: #
                   1260: #   Get the version of our peer.  Note that this is only well
                   1261: #   defined if the state machine has hit the idle state at least
                   1262: #   once (well actually if it has transitioned out of 
                   1263: #   ReadingVersionString   The member data LondVersion is returned.
                   1264: #
                   1265: sub PeerVersion {
                   1266:    my $self = shift;
1.40      albertel 1267:    my ($version) = ($self->{LondVersion} =~ /Revision: 1\.(\d+)/);
                   1268:    return $version;
1.24      foxr     1269: }
1.1       foxr     1270: 
                   1271: 1;
                   1272: 
                   1273: =pod
1.3       albertel 1274: 
1.1       foxr     1275: =head1 Theory
                   1276: 
1.3       albertel 1277: The lond object is a state machine.  It lives through the following states:
                   1278: 
                   1279: =item Connected:
                   1280: 
                   1281: a TCP connection has been formed, but the passkey has not yet been
                   1282: negotiated.
                   1283: 
                   1284: =item Initialized:
                   1285: 
                   1286: "init" sent.
                   1287: 
                   1288: =item ChallengeReceived:
                   1289: 
                   1290: lond sent its challenge to us.
                   1291: 
                   1292: =item ChallengeReplied:
                   1293: 
                   1294: We replied to lond's challenge waiting for lond's ok.
                   1295: 
                   1296: =item RequestingKey:
                   1297: 
                   1298: We are requesting an encryption key.
                   1299: 
                   1300: =item ReceivingKey:
                   1301: 
                   1302: We are receiving an encryption key.
                   1303: 
                   1304: =item Idle:
                   1305: 
                   1306: Connection was negotiated but no requests are active.
                   1307: 
                   1308: =item SendingRequest:
                   1309: 
                   1310: A request is being sent to the peer.
                   1311: 
                   1312: =item ReceivingReply:
                   1313: 
                   1314: Waiting for an entire reply from the peer.
                   1315: 
                   1316: =item Disconnected:
                   1317: 
                   1318: For whatever reason, the connection was dropped.
                   1319: 
                   1320: When we need to be writing data, we have a writable event. When we
                   1321: need to be reading data, a readable event established.  Events
                   1322: dispatch through the class functions Readable and Writable, and the
                   1323: watcher contains a reference to the associated object to allow object
                   1324: context to be reached.
1.1       foxr     1325: 
                   1326: =head2 Member data.
                   1327: 
1.3       albertel 1328: =item Host
                   1329: 
                   1330: Host socket is connected to.
                   1331: 
                   1332: =item Port
                   1333: 
                   1334: The port the remote lond is listening on.
                   1335: 
                   1336: =item Socket
                   1337: 
                   1338: Socket open on the connection.
                   1339: 
                   1340: =item State
                   1341: 
                   1342: The current state.
                   1343: 
1.31      foxr     1344: =item AuthenticationMode
                   1345: 
                   1346: How authentication is being done. This can be any of:
                   1347: 
                   1348:     o local - Authenticate via a key exchanged in a file.
                   1349:     o ssl   - Authenticate via a key exchaned through a temporary ssl tunnel.
                   1350:     o insecure - Exchange keys in an insecure manner.
                   1351: 
                   1352: insecure is only allowed if the configuration parameter loncAllowInsecure 
                   1353: is nonzero.
                   1354: 
1.3       albertel 1355: =item TransactionRequest
                   1356: 
                   1357: The request being transmitted.
                   1358: 
                   1359: =item TransactionReply
                   1360: 
                   1361: The reply being received from the transaction.
                   1362: 
                   1363: =item InformReadable
                   1364: 
                   1365: True if we want to be called when socket is readable.
                   1366: 
                   1367: =item InformWritable
                   1368: 
                   1369: True if we want to be informed if the socket is writable.
                   1370: 
                   1371: =item Timeoutable
                   1372: 
                   1373: True if the current operation is allowed to timeout.
                   1374: 
                   1375: =item TimeoutValue
                   1376: 
                   1377: Number of seconds in the timeout.
                   1378: 
                   1379: =item TimeoutRemaining
                   1380: 
                   1381: Number of seconds left in the timeout.
                   1382: 
                   1383: =item CipherKey
                   1384: 
                   1385: The key that was negotiated with the peer.
                   1386: 
                   1387: =item Cipher
                   1388: 
                   1389: The cipher obtained via the key.
1.1       foxr     1390: 
                   1391: 
                   1392: =head2 The following are callback like members:
1.3       albertel 1393: 
                   1394: =item Tick:
                   1395: 
                   1396: Called in response to a timer tick. Used to managed timeouts etc.
                   1397: 
                   1398: =item Readable:
                   1399: 
                   1400: Called when the socket becomes readable.
                   1401: 
                   1402: =item Writable:
                   1403: 
                   1404: Called when the socket becomes writable.
                   1405: 
                   1406: =item TimedOut:
                   1407: 
                   1408: Called when a timed operation timed out.
                   1409: 
1.1       foxr     1410: 
                   1411: =head2 The following are operational member functions.
1.3       albertel 1412: 
                   1413: =item InitiateTransaction:
                   1414: 
                   1415: Called to initiate a new transaction
                   1416: 
                   1417: =item SetStateTransitionCallback:
                   1418: 
                   1419: Called to establish a function that is called whenever the object goes
                   1420: through a state transition.  This is used by The client to manage the
                   1421: work flow for the object.
                   1422: 
                   1423: =item SetTimeoutCallback:
                   1424: 
                   1425: Set a function to be called when a transaction times out.  The
                   1426: function will be called with the object as its sole parameter.
                   1427: 
                   1428: =item Encrypt:
                   1429: 
                   1430: Encrypts a block of text according to the cipher negotiated with the
                   1431: peer (assumes the text is a command).
                   1432: 
                   1433: =item Decrypt:
                   1434: 
                   1435: Decrypts a block of text according to the cipher negotiated with the
                   1436: peer (assumes the block was a reply.
1.5       foxr     1437: 
                   1438: =item Shutdown:
                   1439: 
                   1440: Shuts off the socket.
1.1       foxr     1441: 
                   1442: =head2 The following are selector member functions:
                   1443: 
1.3       albertel 1444: =item GetState:
                   1445: 
                   1446: Returns the current state
                   1447: 
                   1448: =item GetSocket:
                   1449: 
                   1450: Gets the socekt open on the connection to lond.
                   1451: 
                   1452: =item WantReadable:
                   1453: 
                   1454: true if the current state requires a readable event.
                   1455: 
                   1456: =item WantWritable:
                   1457: 
                   1458: true if the current state requires a writable event.
                   1459: 
                   1460: =item WantTimeout:
                   1461: 
                   1462: true if the current state requires timeout support.
                   1463: 
                   1464: =item GetHostIterator:
                   1465: 
                   1466: Returns an iterator into the host file hash.
                   1467: 
1.1       foxr     1468: =cut

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