Annotation of loncom/LondConnection.pm, revision 1.31

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

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