File:  [LON-CAPA] / loncom / LondConnection.pm
Revision 1.62: download - view: text, annotated - select for diffs
Fri Dec 14 02:05:38 2018 UTC (5 years, 3 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_12_X, HEAD
- Include verification of common name when creating SSL tunnel unless
  connecting to/from pre-2.12 node.
- $IO::Socket::SSL::DEBUG is set to current $DEBUG value so debugging
  from IO/Socket/SSL.pm is written to lond_errors or lonc_errors.

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

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