Annotation of loncom/loncnew, revision 1.8

1.1       foxr        1: #!/usr/bin/perl
1.2       albertel    2: # The LearningOnline Network with CAPA
                      3: # lonc maintains the connections to remote computers
                      4: #
1.8     ! foxr        5: # $Id: loncnew,v 1.7 2003/06/03 01:59:39 foxr Exp $
1.2       albertel    6: #
                      7: # Copyright Michigan State University Board of Trustees
                      8: #
                      9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                     10: #
                     11: # LON-CAPA is free software; you can redistribute it and/or modify
                     12: # it under the terms of the GNU General Public License as published by
                     13: # the Free Software Foundation; either version 2 of the License, or
                     14: # (at your option) any later version.
                     15: #
                     16: # LON-CAPA is distributed in the hope that it will be useful,
                     17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     19: # GNU General Public License for more details.
                     20: #
                     21: # You should have received a copy of the GNU General Public License
                     22: # along with LON-CAPA; if not, write to the Free Software
                     23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     24: #
                     25: # /home/httpd/html/adm/gpl.txt
                     26: #
                     27: # http://www.lon-capa.org/
                     28: #
1.1       foxr       29: #
                     30: # new lonc handles n requestors spread out bver m connections to londs.
                     31: # This module is based on the Event class.
                     32: #   Development iterations:
                     33: #    - Setup basic event loop.   (done)
                     34: #    - Add timer dispatch.       (done)
                     35: #    - Add ability to accept lonc UNIX domain sockets.  (done)
                     36: #    - Add ability to create/negotiate lond connections (done).
1.7       foxr       37: #    - Add general logic for dispatching requests and timeouts. (done).
                     38: #    - Add support for the lonc/lond requests.          (done).
1.1       foxr       39: #    - Add logging/status monitoring.
                     40: #    - Add Signal handling - HUP restarts. USR1 status report.
1.7       foxr       41: #    - Add Configuration file I/O                       (done).
1.1       foxr       42: #    - Add management/status request interface.
1.8     ! foxr       43: #    - Add deferred request capability.                  (done)
1.7       foxr       44: #
                     45: 
                     46: # Change log:
1.8     ! foxr       47: #    $Log: loncnew,v $
        !            48: #    Revision 1.7  2003/06/03 01:59:39  foxr
        !            49: #    complete coding to support deferred transactions.
        !            50: #
1.7       foxr       51: #
1.1       foxr       52: 
                     53: use lib "/home/httpd/lib/perl/";
                     54: use lib "/home/foxr/newloncapa/types";
                     55: use Event qw(:DEFAULT );
                     56: use POSIX qw(:signal_h);
                     57: use IO::Socket;
                     58: use IO::Socket::INET;
                     59: use IO::Socket::UNIX;
1.6       foxr       60: use IO::Handle;
1.1       foxr       61: use Socket;
                     62: use Crypt::IDEA;
                     63: use LONCAPA::Queue;
                     64: use LONCAPA::Stack;
                     65: use LONCAPA::LondConnection;
1.7       foxr       66: use LONCAPA::LondTransaction;
1.1       foxr       67: use LONCAPA::Configuration;
                     68: use LONCAPA::HashIterator;
                     69: 
                     70: print "Loncnew starting\n";
                     71: 
                     72: #
                     73: #   Disable all signals we might receive from outside for now.
                     74: #
                     75: $SIG{QUIT}  = IGNORE;
                     76: $SIG{HUP}   = IGNORE;
                     77: $SIG{USR1}  = IGNORE;
                     78: $SIG{INT}   = IGNORE;
                     79: $SIG{CHLD}  = IGNORE;
                     80: $SIG{__DIE__}  = IGNORE;
                     81: 
                     82: 
                     83: # Read the httpd configuration file to get perl variables
                     84: # normally set in apache modules:
                     85: 
                     86: my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');
                     87: my %perlvar    = %{$perlvarref};
                     88: 
                     89: #
                     90: #  parent and shared variables.
                     91: 
                     92: my %ChildHash;			# by pid -> host.
                     93: 
                     94: 
                     95: my $MaxConnectionCount = 5;	# Will get from config later.
                     96: my $ClientConnection = 0;	# Uniquifier for client events.
                     97: 
1.8     ! foxr       98: my $DebugLevel = 2;
1.1       foxr       99: my $IdleTimeout= 3600;		# Wait an hour before pruning connections.
                    100: 
                    101: #
                    102: #  The variables below are only used by the child processes.
                    103: #
                    104: my $RemoteHost;			# Name of host child is talking to.
                    105: my $UnixSocketDir= "/home/httpd/sockets"; 
                    106: my $IdleConnections = Stack->new(); # Set of idle connections
                    107: my %ActiveConnections;		# Connections to the remote lond.
1.7       foxr      108: my %ActiveTransactions;		# LondTransactions in flight.
1.1       foxr      109: my %ActiveClients;		# Serial numbers of active clients by socket.
                    110: my $WorkQueue       = Queue->new(); # Queue of pending transactions.
1.7       foxr      111: #  my $ClientQueue     = Queue->new(); # Queue of clients causing xactinos.
1.1       foxr      112: my $ConnectionCount = 0;
1.4       foxr      113: my $IdleSeconds     = 0;	# Number of seconds idle.
1.1       foxr      114: 
                    115: #
1.6       foxr      116: #   This disconnected socket makes posible a bit more regular
                    117: #   code when processing delayed requests:
                    118: #
                    119: my $NullSocket = IO::Socket->new();
                    120: 
                    121: #
1.3       albertel  122: 
1.1       foxr      123: =pod
1.3       albertel  124: 
                    125: =head2 GetPeerName
                    126: 
                    127: Returns the name of the host that a socket object is connected to.
                    128: 
1.1       foxr      129: =cut
                    130: 
                    131: sub GetPeername {
                    132:     my $connection = shift;
                    133:     my $AdrFamily  = shift;
                    134:     my $peer       = $connection->peername();
                    135:     my $peerport;
                    136:     my $peerip;
                    137:     if($AdrFamily == AF_INET) {
                    138: 	($peerport, $peerip) = sockaddr_in($peer);
                    139: 	my $peername    = gethostbyaddr($iaddr, $AdrFamily);
                    140: 	return $peername;
                    141:     } elsif ($AdrFamily == AF_UNIX) {
                    142: 	my $peerfile;
                    143: 	($peerfile) = sockaddr_un($peer);
                    144: 	return $peerfile;
                    145:     }
                    146: }
                    147: #----------------------------- Timer management ------------------------
                    148: =pod
1.3       albertel  149: 
1.1       foxr      150: =head2 Debug
1.3       albertel  151: 
                    152: Invoked to issue a debug message.
                    153: 
1.1       foxr      154: =cut
1.3       albertel  155: 
1.1       foxr      156: sub Debug {
                    157:     my $level   = shift;
                    158:     my $message = shift;
                    159:     if ($level <= $DebugLevel) {
                    160: 	print $message." host = ".$RemoteHost."\n";
                    161:     }
                    162: }
                    163: 
                    164: sub SocketDump {
                    165:     my $level = shift;
                    166:     my $socket= shift;
                    167:     if($level <= $DebugLevel) {
                    168: 	$socket->Dump();
                    169:     }
                    170: }
1.3       albertel  171: 
1.1       foxr      172: =pod
1.3       albertel  173: 
1.5       foxr      174: =head2 ShowStatus
                    175: 
                    176:  Place some text as our pid status.
                    177: 
                    178: =cut
                    179: sub ShowStatus {
                    180:     my $status = shift;
                    181:     $0 =  "lonc: ".$status;
                    182: }
                    183: 
                    184: =pod
                    185: 
1.1       foxr      186: =head2 Tick
1.3       albertel  187: 
                    188: Invoked  each timer tick.
                    189: 
1.1       foxr      190: =cut
                    191: 
1.5       foxr      192: 
1.1       foxr      193: sub Tick {
                    194:     my $client;
1.5       foxr      195:     ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount);
1.1       foxr      196:     Debug(6, "Tick");
                    197:     Debug(6, "    Current connection count: ".$ConnectionCount);
                    198:     foreach $client (keys %ActiveClients) {
                    199: 	Debug(7, "    Have client:  with id: ".$ActiveClients{$client});
                    200:     }
1.4       foxr      201:     # Is it time to prune connection count:
                    202: 
                    203: 
                    204:     if($IdleConnections->Count()  && 
                    205:        ($WorkQueue->Count() == 0)) { # Idle connections and nothing to do?
                    206: 	$IdleSeconds++;
                    207: 	if($IdleSeconds > $IdleTimeout) { # Prune a connection...
                    208: 	    $Socket = $IdleConnections->pop();
1.6       foxr      209: 	    KillSocket($Socket);
1.4       foxr      210: 	}
                    211:     } else {
                    212: 	$IdleSeconds = 0;	# Reset idle count if not idle.
                    213:     }
1.5       foxr      214: 
                    215:     # Do we have work in the queue, but no connections to service them?
                    216:     # If so, try to make some new connections to get things going again.
                    217:     #
                    218:     
                    219:     my $Requests = $WorkQueue->Count();
                    220:     if (($ConnectionCount == 0)  && ($Requests > 0)) {
                    221: 	my $Connections = ($Requests <= $MaxConnectionCount) ?
                    222: 	                           $Requests : $MaxConnectionCount;
                    223: 	Debug(1,"Work but no connections, starting ".$Connections." of them");
                    224: 	for ($i =0; $i < $Connections; $i++) {
                    225: 	    MakeLondConnection();
                    226: 	}
                    227:        
                    228:     }
1.1       foxr      229: }
                    230: 
                    231: =pod
1.3       albertel  232: 
1.1       foxr      233: =head2 SetupTimer
                    234: 
1.3       albertel  235: Sets up a 1 per sec recurring timer event.  The event handler is used to:
1.1       foxr      236: 
1.3       albertel  237: =item
                    238: 
                    239: Trigger timeouts on communications along active sockets.
                    240: 
                    241: =item
                    242: 
                    243: Trigger disconnections of idle sockets.
1.1       foxr      244: 
                    245: =cut
                    246: 
                    247: sub SetupTimer {
                    248:     Debug(6, "SetupTimer");
                    249:     Event->timer(interval => 1, debug => 1, cb => \&Tick );
                    250: }
1.3       albertel  251: 
1.1       foxr      252: =pod
1.3       albertel  253: 
1.1       foxr      254: =head2 ServerToIdle
1.3       albertel  255: 
                    256: This function is called when a connection to the server is
                    257: ready for more work.
                    258: 
                    259: If there is work in the Work queue the top element is dequeued
1.1       foxr      260: and the connection will start to work on it.  If the work queue is
                    261: empty, the connection is pushed on the idle connection stack where
                    262: it will either get another work unit, or alternatively, if it sits there
                    263: long enough, it will be shut down and released.
                    264: 
1.3       albertel  265: =cut
1.1       foxr      266: 
                    267: sub ServerToIdle {
                    268:     my $Socket   = shift;	# Get the socket.
1.7       foxr      269:     delete($ActiveTransactions{$Socket}); # Server has no transaction
1.1       foxr      270: 
                    271:     &Debug(6, "Server to idle");
                    272: 
                    273:     #  If there's work to do, start the transaction:
                    274: 
1.7       foxr      275:     $reqdata = $WorkQueue->dequeue(); # This is a LondTransaction
1.1       foxr      276:     unless($reqdata eq undef)  {
1.7       foxr      277: 	Debug(9, "Queue gave request data: ".$reqdata->getRequest());
                    278: 	&StartRequest($Socket,  $reqdata);
1.8     ! foxr      279: 
1.1       foxr      280:     } else {
                    281: 	
                    282:     #  There's no work waiting, so push the server to idle list.
                    283: 	&Debug(8, "No new work requests, server connection going idle");
                    284: 	$IdleConnections->push($Socket);
                    285:     }
                    286: }
1.3       albertel  287: 
1.1       foxr      288: =pod
1.3       albertel  289: 
1.1       foxr      290: =head2 ClientWritable
1.3       albertel  291: 
                    292: Event callback for when a client socket is writable.
                    293: 
                    294: This callback is established when a transaction reponse is
                    295: avaiable from lond.  The response is forwarded to the unix socket
                    296: as it becomes writable in this sub.
                    297: 
1.1       foxr      298: Parameters:
                    299: 
1.3       albertel  300: =item Event
                    301: 
                    302: The event that has been triggered. Event->w->data is
                    303: the data and Event->w->fd is the socket to write.
1.1       foxr      304: 
                    305: =cut
1.3       albertel  306: 
1.1       foxr      307: sub ClientWritable {
                    308:     my $Event    = shift;
                    309:     my $Watcher  = $Event->w;
                    310:     my $Data     = $Watcher->data;
                    311:     my $Socket   = $Watcher->fd;
                    312: 
                    313:     # Try to send the data:
                    314: 
                    315:     &Debug(6, "ClientWritable writing".$Data);
                    316:     &Debug(9, "Socket is: ".$Socket);
                    317: 
1.6       foxr      318:     if($Socket->connected) {
                    319: 	my $result = $Socket->send($Data, 0);
                    320: 	
                    321: 	# $result undefined: the write failed.
                    322: 	# otherwise $result is the number of bytes written.
                    323: 	# Remove that preceding string from the data.
                    324: 	# If the resulting data is empty, destroy the watcher
                    325: 	# and set up a read event handler to accept the next
                    326: 	# request.
                    327: 	
                    328: 	&Debug(9,"Send result is ".$result." Defined: ".defined($result));
                    329: 	if(defined($result)) {
                    330: 	    &Debug(9, "send result was defined");
                    331: 	    if($result == length($Data)) { # Entire string sent.
                    332: 		&Debug(9, "ClientWritable data all written");
                    333: 		$Watcher->cancel();
                    334: 		#
                    335: 		#  Set up to read next request from socket:
                    336: 		
                    337: 		my $descr     = sprintf("Connection to lonc client %d",
                    338: 					$ActiveClients{$Socket});
                    339: 		Event->io(cb    => \&ClientRequest,
                    340: 			  poll  => 'r',
                    341: 			  desc  => $descr,
                    342: 			  data  => "",
                    343: 			  fd    => $Socket);
                    344: 		
                    345: 	    } else {		# Partial string sent.
                    346: 		$Watcher->data(substr($Data, $result));
                    347: 	    }
                    348: 	    
                    349: 	} else {			# Error of some sort...
                    350: 	    
                    351: 	    # Some errnos are possible:
                    352: 	    my $errno = $!;
                    353: 	    if($errno == POSIX::EWOULDBLOCK   ||
                    354: 	       $errno == POSIX::EAGAIN        ||
                    355: 	       $errno == POSIX::EINTR) {
                    356: 		# No action taken?
                    357: 	    } else {		# Unanticipated errno.
                    358: 		&Debug(5,"ClientWritable error or peer shutdown".$RemoteHost);
                    359: 		$Watcher->cancel;	# Stop the watcher.
                    360: 		$Socket->shutdown(2); # Kill connection
                    361: 		$Socket->close();	# Close the socket.
                    362: 	    }
1.1       foxr      363: 	    
                    364: 	}
1.6       foxr      365:     } else {
                    366: 	$Watcher->cancel();	# A delayed request...just cancel.
1.1       foxr      367:     }
                    368: }
                    369: 
                    370: =pod
1.3       albertel  371: 
1.1       foxr      372: =head2 CompleteTransaction
1.3       albertel  373: 
                    374: Called when the reply data has been received for a lond 
1.1       foxr      375: transaction.   The reply data must now be sent to the
                    376: ultimate client on the other end of the Unix socket.  This is
                    377: done by setting up a writable event for the socket with the
                    378: data the reply data.
1.3       albertel  379: 
1.1       foxr      380: Parameters:
1.3       albertel  381: 
                    382: =item Socket
                    383: 
                    384: Socket on which the lond transaction occured.  This is a
                    385: LondConnection. The data received is in the TransactionReply member.
                    386: 
1.7       foxr      387: =item Transaction
1.3       albertel  388: 
1.7       foxr      389: The transaction that is being completed.
1.1       foxr      390: 
                    391: =cut
1.3       albertel  392: 
1.1       foxr      393: sub CompleteTransaction {
                    394:     &Debug(6,"Complete transaction");
                    395:     my $Socket = shift;
1.7       foxr      396:     my $Transaction = shift;
1.1       foxr      397: 
1.7       foxr      398:     if (!$Transaction->isDeferred()) { # Normal transaction
                    399: 	my $data   = $Socket->GetReply(); # Data to send.
                    400: 	StartClientReply($Transaction, $data);
                    401:     } else {			# Delete deferred transaction file.
1.8     ! foxr      402: 	&Debug(4, "Deferred transaction complete: ".$Transaction->getFile().
        !           403: 	       " request: ".$Transaction->getRequest().
        !           404: 	       " answer: ".$Socket->GetReply());
1.7       foxr      405: 	unlink $Transaction->getFile();
                    406:     }
1.6       foxr      407: }
                    408: =pod
                    409: =head1 StartClientReply
                    410: 
                    411:    Initiates a reply to a client where the reply data is a parameter.
                    412: 
1.7       foxr      413: =head2  parameters:
                    414: 
                    415: =item Transaction
                    416: 
                    417:     The transaction for which we are responding to the client.
                    418: 
                    419: =item data
                    420: 
                    421:     The data to send to apached client.
                    422: 
1.6       foxr      423: =cut
                    424: sub StartClientReply {
1.7       foxr      425:     my $Transaction   = shift;
1.6       foxr      426:     my $data     = shift;
1.1       foxr      427: 
1.7       foxr      428:     my $Client   = $Transaction->getClient();
                    429: 
1.1       foxr      430:     &Debug(8," Reply was: ".$data);
                    431:     my $Serial         = $ActiveClients{$Client};
                    432:     my $desc           = sprintf("Connection to lonc client %d",
1.6       foxr      433: 
1.1       foxr      434: 				 $Serial);
                    435:     Event->io(fd       => $Client,
                    436: 	      poll     => "w",
                    437: 	      desc     => $desc,
                    438: 	      cb       => \&ClientWritable,
                    439: 	      data     => $data);
                    440: }
1.4       foxr      441: =pod
                    442: =head2 FailTransaction
                    443: 
                    444:   Finishes a transaction with failure because the associated lond socket
1.7       foxr      445:   disconnected.  There are two possibilities:
                    446:   - The transaction is deferred: in which case we just quietly
                    447:     delete the transaction since there is no client connection.
                    448:   - The transaction is 'live' in which case we initiate the sending
                    449:     of "con_lost" to the client.
                    450: 
                    451: Deleting the transaction means killing it from the 
                    452: %ActiveTransactions hash.
1.4       foxr      453: 
                    454: Parameters:
                    455: 
                    456: =item client  
                    457:  
1.7       foxr      458:    The LondTransaction we are failing.
                    459:  
1.4       foxr      460: =cut
                    461: 
                    462: sub FailTransaction {
1.7       foxr      463:     my $transaction = shift;
                    464:     my $Lond        = $transaction->getServer();
                    465:     if (!$client->isDeferred()) { # If the transaction is deferred we'll get to it.
                    466: 	my $client  = $transcation->getClient();
                    467: 	StartClientReply($client, "con_lost");
                    468:     }
                    469: # not needed, done elsewhere if active.
                    470: #    delete $ActiveTransactions{$Lond};
1.4       foxr      471: 
                    472: }
                    473: 
                    474: =pod
1.6       foxr      475: =head1  EmptyQueue
1.7       foxr      476: 
1.6       foxr      477:   Fails all items in the work queue with con_lost.
1.7       foxr      478:   Note that each item in the work queue is a transaction.
                    479: 
1.6       foxr      480: =cut
                    481: sub EmptyQueue {
                    482:     while($WorkQueue->Count()) {
1.7       foxr      483: 	my $request = $Workqueue->dequeue(); # This is a transaction
                    484: 	FailTransaction($request);
1.6       foxr      485:     }
                    486: }
                    487: 
                    488: =pod
1.4       foxr      489: 
                    490: =head2 KillSocket
                    491:  
                    492: Destroys a socket.  This function can be called either when a socket
                    493: has died of 'natural' causes or because a socket needs to be pruned due to
                    494: idleness.  If the socket has died naturally, if there are no longer any 
                    495: live connections a new connection is created (in case there are transactions
                    496: in the queue).  If the socket has been pruned, it is never re-created.
                    497: 
                    498: Parameters:
1.1       foxr      499: 
1.4       foxr      500: =item Socket
                    501:  
                    502:   The socket to kill off.
                    503: 
                    504: =item Restart
                    505: 
                    506: nonzero if we are allowed to create a new connection.
                    507: 
                    508: 
                    509: =cut
                    510: sub KillSocket {
                    511:     my $Socket = shift;
                    512: 
1.7       foxr      513:     #  If the socket came from the active connection set,
                    514:     #  delete its transaction... note that FailTransaction should
                    515:     #  already have been called!!!
                    516:     #  otherwise it came from the idle set.
                    517:     #  
1.4       foxr      518:     
                    519:     if(exists($ActiveTransactions{$Socket})) {
                    520: 	delete ($ActiveTransactions{$Socket});
                    521:     }
                    522:     if(exists($ActiveConnections{$Socket})) {
                    523: 	delete($ActiveConnections{$Socket});
                    524:     }
                    525:     $ConnectionCount--;
1.6       foxr      526: 
                    527:     #  If the connection count has gone to zero and there is work in the
                    528:     #  work queue, the work all gets failed with con_lost.
                    529:     #
                    530:     if($ConnectionCount == 0) {
                    531: 	EmptyQueue;
1.4       foxr      532:     }
                    533: }
1.1       foxr      534: 
                    535: =pod
1.3       albertel  536: 
1.1       foxr      537: =head2 LondReadable
1.3       albertel  538: 
1.1       foxr      539: This function is called whenever a lond connection
                    540: is readable.  The action is state dependent:
                    541: 
1.3       albertel  542: =head3 State=Initialized
                    543: 
                    544: We''re waiting for the challenge, this is a no-op until the
1.1       foxr      545: state changes.
1.3       albertel  546: 
1.1       foxr      547: =head3 State=Challenged 
1.3       albertel  548: 
                    549: The challenge has arrived we need to transition to Writable.
1.1       foxr      550: The connection must echo the challenge back.
1.3       albertel  551: 
1.1       foxr      552: =head3 State=ChallengeReplied
1.3       albertel  553: 
                    554: The challenge has been replied to.  The we are receiveing the 
1.1       foxr      555: 'ok' from the partner.
1.3       albertel  556: 
1.1       foxr      557: =head3 State=RequestingKey
1.3       albertel  558: 
                    559: The ok has been received and we need to send the request for
1.1       foxr      560: an encryption key.  Transition to writable for that.
1.3       albertel  561: 
1.1       foxr      562: =head3 State=ReceivingKey
1.3       albertel  563: 
                    564: The the key has been requested, now we are reading the new key.
                    565: 
1.1       foxr      566: =head3 State=Idle 
1.3       albertel  567: 
                    568: The encryption key has been negotiated or we have finished 
1.1       foxr      569: reading data from the a transaction.   If the callback data has
                    570: a client as well as the socket iformation, then we are 
                    571: doing a transaction and the data received is relayed to the client
                    572: before the socket is put on the idle list.
1.3       albertel  573: 
1.1       foxr      574: =head3 State=SendingRequest
1.3       albertel  575: 
                    576: I do not think this state can be received here, but if it is,
1.1       foxr      577: the appropriate thing to do is to transition to writable, and send
                    578: the request.
1.3       albertel  579: 
1.1       foxr      580: =head3 State=ReceivingReply
1.3       albertel  581: 
                    582: We finished sending the request to the server and now transition
1.1       foxr      583: to readable to receive the reply. 
                    584: 
                    585: The parameter to this function are:
1.3       albertel  586: 
1.1       foxr      587: The event. Implicit in this is the watcher and its data.  The data 
                    588: contains at least the lond connection object and, if a 
                    589: transaction is in progress, the socket attached to the local client.
                    590: 
1.3       albertel  591: =cut
1.1       foxr      592: 
                    593: sub LondReadable {
1.8     ! foxr      594: 
1.1       foxr      595:     my $Event      = shift;
                    596:     my $Watcher    = $Event->w;
                    597:     my $Socket     = $Watcher->data;
                    598:     my $client     = undef;
                    599: 
1.8     ! foxr      600:     &Debug(6,"LondReadable called state = ".$State);
        !           601: 
1.1       foxr      602: 
                    603:     my $State = $Socket->GetState(); # All action depends on the state.
                    604: 
                    605:     SocketDump(6, $Socket);
                    606: 
                    607:     if($Socket->Readable() != 0) {
1.4       foxr      608: 	 # bad return from socket read. Currently this means that
                    609: 	# The socket has become disconnected. We fail the transaction.
                    610: 
                    611: 	if(exists($ActiveTransactions{$Socket})) {
                    612: 	    Debug(3,"Lond connection lost failing transaction");
                    613: 	    FailTransaction($ActiveTransactions{$Socket});
                    614: 	}
                    615: 	$Watcher->cancel();
1.6       foxr      616: 	KillSocket($Socket);
1.4       foxr      617: 	return;
1.1       foxr      618:     }
                    619:     SocketDump(6,$Socket);
                    620: 
                    621:     $State = $Socket->GetState(); # Update in case of transition.
                    622:     &Debug(6, "After read, state is ".$State);
                    623: 
                    624:    if($State eq "Initialized") {
                    625: 
                    626: 
                    627:     } elsif ($State eq "ChallengeReceived") {
                    628: 	#  The challenge must be echoed back;  The state machine
                    629: 	# in the connection takes care of setting that up.  Just
                    630: 	# need to transition to writable:
                    631: 
1.8     ! foxr      632: 	$Watcher->cb(\&LondWritable);
1.1       foxr      633: 	$Watcher->poll("w");
                    634: 
                    635:     } elsif ($State eq "ChallengeReplied") {
                    636: 
                    637: 
                    638:     } elsif ($State eq "RequestingKey") {
                    639: 	#  The ok was received.  Now we need to request the key
                    640: 	#  That requires us to be writable:
                    641: 
1.8     ! foxr      642: 	$Watcher->cb(\&LondWritable);
1.1       foxr      643: 	$Watcher->poll("w");
                    644: 
                    645:     } elsif ($State eq "ReceivingKey") {
                    646: 
                    647:     } elsif ($State eq "Idle") {
                    648: 	# If necessary, complete a transaction and then go into the
                    649: 	# idle queue.
1.8     ! foxr      650: 	$Watcher->cancel();
1.1       foxr      651: 	if(exists($ActiveTransactions{$Socket})) {
                    652: 	    Debug(8,"Completing transaction!!");
                    653: 	    CompleteTransaction($Socket, 
                    654: 				$ActiveTransactions{$Socket});
                    655: 	}
                    656: 	ServerToIdle($Socket);	# Next work unit or idle.
1.6       foxr      657: 	
1.1       foxr      658:     } elsif ($State eq "SendingRequest") {
                    659: 	#  We need to be writable for this and probably don't belong
                    660: 	#  here inthe first place.
                    661: 
                    662: 	Deubg(6, "SendingRequest state encountered in readable");
                    663: 	$Watcher->poll("w");
                    664: 	$Watcher->cb(\&LondWritable);
                    665: 
                    666:     } elsif ($State eq "ReceivingReply") {
                    667: 
                    668: 
                    669:     } else {
                    670: 	 # Invalid state.
                    671: 	Debug(4, "Invalid state in LondReadable");
                    672:     }
                    673: }
1.3       albertel  674: 
1.1       foxr      675: =pod
1.3       albertel  676: 
1.1       foxr      677: =head2 LondWritable
1.3       albertel  678: 
1.1       foxr      679: This function is called whenever a lond connection
                    680: becomes writable while there is a writeable monitoring
                    681: event.  The action taken is very state dependent:
1.3       albertel  682: 
1.1       foxr      683: =head3 State = Connected 
1.3       albertel  684: 
                    685: The connection is in the process of sending the 'init' hailing to the
                    686: lond on the remote end.  The connection object''s Writable member is
                    687: called.  On error, ConnectionError is called to destroy the connection
                    688: and remove it from the ActiveConnections hash
                    689: 
1.1       foxr      690: =head3 Initialized
1.3       albertel  691: 
                    692: 'init' has been sent, writability monitoring is removed and
                    693: readability monitoring is started with LondReadable as the callback.
                    694: 
1.1       foxr      695: =head3 ChallengeReceived
1.3       albertel  696: 
                    697: The connection has received the who are you challenge from the remote
                    698: system, and is in the process of sending the challenge
                    699: response. Writable is called.
                    700: 
1.1       foxr      701: =head3 ChallengeReplied
1.3       albertel  702: 
                    703: The connection has replied to the initial challenge The we switch to
                    704: monitoring readability looking for the server to reply with 'ok'.
                    705: 
1.1       foxr      706: =head3 RequestingKey
1.3       albertel  707: 
                    708: The connection is in the process of requesting its encryption key.
                    709: Writable is called.
                    710: 
1.1       foxr      711: =head3 ReceivingKey
1.3       albertel  712: 
                    713: The connection has sent the request for a key.  Switch to readability
                    714: monitoring to accept the key
                    715: 
1.1       foxr      716: =head3 SendingRequest
1.3       albertel  717: 
                    718: The connection is in the process of sending a request to the server.
                    719: This request is part of a client transaction.  All the states until
                    720: now represent the client setup protocol. Writable is called.
                    721: 
1.1       foxr      722: =head3 ReceivingReply
                    723: 
1.3       albertel  724: The connection has sent a request.  Now it must receive a reply.
                    725: Readability monitoring is requested.
                    726: 
                    727: This function is an event handler and therefore receives as
1.1       foxr      728: a parameter the event that has fired.  The data for the watcher
                    729: of this event is a reference to a list of one or two elements,
                    730: depending on state. The first (and possibly only) element is the
                    731: socket.  The second (present only if a request is in progress)
                    732: is the socket on which to return a reply to the caller.
                    733: 
                    734: =cut
1.3       albertel  735: 
1.1       foxr      736: sub LondWritable {
                    737:     my $Event   = shift;
                    738:     my $Watcher = $Event->w;
1.8     ! foxr      739:     my $Socket  = $Watcher->data;
        !           740:     my $State   = $Socket->GetState();
1.1       foxr      741: 
1.8     ! foxr      742:     Debug(6,"LondWritable State = ".$State."\n");
1.1       foxr      743: 
1.8     ! foxr      744:  
1.1       foxr      745:     #  Figure out what to do depending on the state of the socket:
                    746:     
                    747: 
                    748: 
                    749: 
                    750:     SocketDump(6,$Socket);
                    751: 
                    752:     if      ($State eq "Connected")         {
                    753: 
                    754: 	if ($Socket->Writable() != 0) {
                    755: 	    #  The write resulted in an error.
1.4       foxr      756: 	    # We'll treat this as if the socket got disconnected:
1.5       foxr      757: 
1.4       foxr      758: 	    $Watcher->cancel();
1.6       foxr      759: 	    KillSocket($Socket);
1.4       foxr      760: 	    return;
1.1       foxr      761: 	}
1.4       foxr      762: 	#  "init" is being sent...
                    763: 
1.1       foxr      764: 	
                    765:     } elsif ($State eq "Initialized")       {
                    766: 
                    767: 	# Now that init was sent, we switch 
                    768: 	# to watching for readability:
                    769: 
1.8     ! foxr      770: 	$Watcher->cb(\&LondReadable);
1.1       foxr      771: 	$Watcher->poll("r");
                    772: 
                    773:     } elsif ($State eq "ChallengeReceived") {
                    774: 	# We received the challenge, now we 
                    775: 	# are echoing it back. This is a no-op,
                    776: 	# we're waiting for the state to change
                    777: 	
                    778: 	if($Socket->Writable() != 0) {
1.5       foxr      779: 
                    780: 	    $Watcher->cancel();
1.6       foxr      781: 	    KillSocket($Socket);
1.5       foxr      782: 	    return;
1.1       foxr      783: 	}
                    784: 	
                    785:     } elsif ($State eq "ChallengeReplied")  {
                    786: 	# The echo was sent back, so we switch
                    787: 	# to watching readability.
                    788: 
1.8     ! foxr      789: 	$Watcher->cb(\&LondReadable);
1.1       foxr      790: 	$Watcher->poll("r");
                    791: 
                    792:     } elsif ($State eq "RequestingKey")     {
                    793: 	# At this time we're requesting the key.
                    794: 	# again, this is essentially a no-op.
                    795: 	# we'll write the next chunk until the
                    796: 	# state changes.
                    797: 
                    798: 	if($Socket->Writable() != 0) {
                    799: 	    # Write resulted in an error.
1.5       foxr      800: 
                    801: 	    $Watcher->cancel();
1.6       foxr      802: 	    KillSocket($Socket);
1.5       foxr      803: 	    return;
                    804: 
1.1       foxr      805: 	}
                    806:     } elsif ($State eq "ReceivingKey")      {
                    807: 	# Now we need to wait for the key
                    808: 	# to come back from the peer:
                    809: 
1.8     ! foxr      810: 	$Watcher->cb(\&LondReadable);
1.1       foxr      811: 	$Watcher->poll("r");
                    812: 
                    813:     } elsif ($State eq "SendingRequest")    {
                    814: 	# At this time we are sending a request to the
                    815: 	# peer... write the next chunk:
                    816: 
                    817: 	if($Socket->Writable() != 0) {
                    818: 
1.5       foxr      819: 	    if(exists($ActiveTransactions{$Socket})) {
                    820: 		Debug(3, "Lond connection lost, failing transactions");
                    821: 		FailTransaction($ActiveTransactions{$Socket});
                    822: 	    }
                    823: 	    $Watcher->cancel();
1.6       foxr      824: 	    KillSocket($Socket);
1.5       foxr      825: 	    return;
                    826: 	    
1.1       foxr      827: 	}
                    828: 
                    829:     } elsif ($State eq "ReceivingReply")    {
                    830: 	# The send has completed.  Wait for the
                    831: 	# data to come in for a reply.
                    832: 	Debug(8,"Writable sent request/receiving reply");
1.8     ! foxr      833: 	$Watcher->cb(\&LondReadable);
1.1       foxr      834: 	$Watcher->poll("r");
                    835: 
                    836:     } else {
                    837: 	#  Control only passes here on an error: 
                    838: 	#  the socket state does not match any
                    839: 	#  of the known states... so an error
                    840: 	#  must be logged.
                    841: 
                    842: 	&Debug(4, "Invalid socket state ".$State."\n");
                    843:     }
                    844:     
                    845: }
1.6       foxr      846: =pod
                    847:     
                    848: =cut
                    849: sub QueueDelayed {
1.8     ! foxr      850:     Debug(3,"QueueDelayed called");
        !           851: 
1.6       foxr      852:     my $path = "$perlvar{'lonSockDir'}/delayed";
1.8     ! foxr      853: 
        !           854:     Debug(4, "Delayed path: ".$path);
1.6       foxr      855:     opendir(DIRHANDLE, $path);
1.8     ! foxr      856:     
1.6       foxr      857:     @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;
1.8     ! foxr      858:     Debug(4, "Got ".$alldelayed." delayed files");
1.6       foxr      859:     closedir(DIRHANDLE);
                    860:     my $dfname;
1.8     ! foxr      861:     my $reqfile;
        !           862:     foreach $dfname (sort  @alldelayed) {
        !           863: 	$reqfile = "$path/$dfname";
        !           864: 	Debug(4, "queueing ".$reqfile);
1.6       foxr      865: 	my $Handle = IO::File->new($reqfile);
                    866: 	my $cmd    = <$Handle>;
1.8     ! foxr      867: 	chomp $cmd;		# There may or may not be a newline...
        !           868: 	$cmd = $cmd."\ny";	# now for sure there's exactly one newline.
1.7       foxr      869: 	my $Transaction = LondTransaction->new($cmd);
                    870: 	$Transaction->SetDeferred($reqfile);
                    871: 	QueueTransaction($Transaction);
1.6       foxr      872:     }
                    873:     
                    874: }
1.1       foxr      875: 
                    876: =pod
1.3       albertel  877: 
1.1       foxr      878: =head2 MakeLondConnection
1.3       albertel  879: 
                    880: Create a new lond connection object, and start it towards its initial
                    881: idleness.  Once idle, it becomes elligible to receive transactions
                    882: from the work queue.  If the work queue is not empty when the
                    883: connection is completed and becomes idle, it will dequeue an entry and
                    884: start off on it.
                    885: 
1.1       foxr      886: =cut
1.3       albertel  887: 
1.1       foxr      888: sub MakeLondConnection {     
                    889:     Debug(4,"MakeLondConnection to ".GetServerHost()." on port "
                    890: 	  .GetServerPort());
                    891: 
                    892:     my $Connection = LondConnection->new(&GetServerHost(),
                    893: 					 &GetServerPort());
                    894: 
                    895:     if($Connection == undef) {	# Needs to be more robust later.
1.5       foxr      896: 	Debug(0,"Failed to make a connection with lond.");
                    897:     }  else {
                    898: 	# The connection needs to have writability 
                    899: 	# monitored in order to send the init sequence
                    900: 	# that starts the whole authentication/key
                    901: 	# exchange underway.
                    902: 	#
                    903: 	my $Socket = $Connection->GetSocket();
                    904: 	if($Socket == undef) {
                    905: 	    die "did not get a socket from the connection";
                    906: 	} else {
                    907: 	    &Debug(9,"MakeLondConnection got socket: ".$Socket);
                    908: 	}
1.1       foxr      909: 	
1.5       foxr      910: 	
                    911: 	$event = Event->io(fd       => $Socket,
                    912: 			   poll     => 'w',
                    913: 			   cb       => \&LondWritable,
1.8     ! foxr      914: 			   data     => $Connection,
1.5       foxr      915: 			   desc => 'Connection to lond server');
                    916: 	$ActiveConnections{$Connection} = $event;
                    917: 	
                    918: 	$ConnectionCount++;
1.8     ! foxr      919: 	Debug(4, "Connection count = ".$ConnectionCount);
1.6       foxr      920: 	if($ConnectionCount == 1) { # First Connection:
                    921: 	    QueueDelayed;
                    922: 	}
1.1       foxr      923:     }
                    924:     
                    925: }
1.3       albertel  926: 
1.1       foxr      927: =pod
1.3       albertel  928: 
1.1       foxr      929: =head2 StartRequest
1.3       albertel  930: 
                    931: Starts a lond request going on a specified lond connection.
                    932: parameters are:
                    933: 
                    934: =item $Lond
                    935: 
                    936: Connection to the lond that will send the transaction and receive the
                    937: reply.
                    938: 
                    939: =item $Client
                    940: 
                    941: Connection to the client that is making this request We got the
                    942: request from this socket, and when the request has been relayed to
                    943: lond and we get a reply back from lond it will get sent to this
                    944: socket.
                    945: 
                    946: =item $Request
                    947: 
                    948: The text of the request to send.
                    949: 
1.1       foxr      950: =cut
                    951: 
                    952: sub StartRequest {
                    953:     my $Lond     = shift;
1.7       foxr      954:     my $Request  = shift;	# This is a LondTransaction.
1.1       foxr      955:     
1.7       foxr      956:     Debug(6, "StartRequest: ".$Request->getRequest());
1.1       foxr      957: 
                    958:     my $Socket = $Lond->GetSocket();
                    959:     
1.7       foxr      960:     $Request->Activate($Lond);
                    961:     $ActiveTransactions{$Lond} = $Request;
1.1       foxr      962: 
1.7       foxr      963:     $Lond->InitiateTransaction($Request->getRequest());
1.8     ! foxr      964:     $event = Event->io(fd      => $Socket,
1.1       foxr      965: 		       poll    => "w",
                    966: 		       cb      => \&LondWritable,
                    967: 		       data    => $Lond,
                    968: 		       desc    => "lond transaction connection");
                    969:     $ActiveConnections{$Lond} = $event;
                    970:     Debug(8," Start Request made watcher data with ".$event->data."\n");
                    971: }
                    972: 
                    973: =pod
1.3       albertel  974: 
1.1       foxr      975: =head2 QueueTransaction
1.3       albertel  976: 
                    977: If there is an idle lond connection, it is put to work doing this
                    978: transaction.  Otherwise, the transaction is placed in the work queue.
                    979: If placed in the work queue and the maximum number of connections has
                    980: not yet been created, a new connection will be started.  Our goal is
                    981: to eventually have a sufficient number of connections that the work
                    982: queue will typically be empty.  parameters are:
                    983: 
                    984: =item Socket
                    985: 
                    986: open on the lonc client.
                    987: 
                    988: =item Request
                    989: 
                    990: data to send to the lond.
1.1       foxr      991: 
                    992: =cut
1.3       albertel  993: 
1.1       foxr      994: sub QueueTransaction {
                    995: 
1.7       foxr      996:     my $requestData   = shift;	# This is a LondTransaction.
                    997:     my $cmd           = $requestData->getRequest();
                    998: 
                    999:     Debug(6,"QueueTransaction: ".$cmd);
1.1       foxr     1000: 
                   1001:     my $LondSocket    = $IdleConnections->pop();
                   1002:     if(!defined $LondSocket) {	# Need to queue request.
                   1003: 	Debug(8,"Must queue...");
                   1004: 	$WorkQueue->enqueue($requestData);
                   1005: 	if($ConnectionCount < $MaxConnectionCount) {
                   1006: 	    Debug(4,"Starting additional lond connection");
                   1007: 	    MakeLondConnection();
                   1008: 	}
                   1009:     } else {			# Can start the request:
                   1010: 	Debug(8,"Can start...");
1.7       foxr     1011: 	StartRequest($LondSocket,  $requestData);
1.1       foxr     1012:     }
                   1013: }
                   1014: 
                   1015: #-------------------------- Lonc UNIX socket handling ---------------------
1.3       albertel 1016: 
1.1       foxr     1017: =pod
1.3       albertel 1018: 
1.1       foxr     1019: =head2 ClientRequest
1.3       albertel 1020: 
                   1021: Callback that is called when data can be read from the UNIX domain
                   1022: socket connecting us with an apache server process.
1.1       foxr     1023: 
                   1024: =cut
                   1025: 
                   1026: sub ClientRequest {
                   1027:     Debug(6, "ClientRequest");
                   1028:     my $event   = shift;
                   1029:     my $watcher = $event->w;
                   1030:     my $socket  = $watcher->fd;
                   1031:     my $data    = $watcher->data;
                   1032:     my $thisread;
                   1033: 
                   1034:     Debug(9, "  Watcher named: ".$watcher->desc);
                   1035: 
                   1036:     my $rv = $socket->recv($thisread, POSIX::BUFSIZ, 0);
                   1037:     Debug(8, "rcv:  data length = ".length($thisread)
                   1038: 	  ." read =".$thisread);
                   1039:     unless (defined $rv && length($thisread)) {
                   1040: 	 # Likely eof on socket.
                   1041: 	Debug(5,"Client Socket closed on lonc for ".$RemoteHost);
                   1042: 	close($socket);
                   1043: 	$watcher->cancel();
                   1044: 	delete($ActiveClients{$socket});
                   1045:     }
                   1046:     Debug(8,"Data: ".$data." this read: ".$thisread);
                   1047:     $data = $data.$thisread;	# Append new data.
                   1048:     $watcher->data($data);
                   1049:     if($data =~ /(.*\n)/) {	# Request entirely read.
                   1050: 	Debug(8, "Complete transaction received: ".$data);
1.8     ! foxr     1051: 	my $Transaction = LondTransaction->new($data);
1.7       foxr     1052: 	$Transaction->SetClient($socket);
                   1053: 	QueueTransaction($Transaction);
1.1       foxr     1054: 	$watcher->cancel();	# Done looking for input data.
                   1055:     }
                   1056: 
                   1057: }
                   1058: 
                   1059: 
                   1060: =pod
1.3       albertel 1061: 
1.1       foxr     1062: =head2  NewClient
1.3       albertel 1063: 
                   1064: Callback that is called when a connection is received on the unix
                   1065: socket for a new client of lonc.  The callback is parameterized by the
                   1066: event.. which is a-priori assumed to be an io event, and therefore has
                   1067: an fd member that is the Listener socket.  We Accept the connection
                   1068: and register a new event on the readability of that socket:
                   1069: 
1.1       foxr     1070: =cut
1.3       albertel 1071: 
1.1       foxr     1072: sub NewClient {
                   1073:     Debug(6, "NewClient");
                   1074:     my $event      = shift;		# Get the event parameters.
                   1075:     my $watcher    = $event->w; 
                   1076:     my $socket     = $watcher->fd;	# Get the event' socket.
                   1077:     my $connection = $socket->accept();	# Accept the client connection.
                   1078:     Debug(8,"Connection request accepted from "
                   1079: 	  .GetPeername($connection, AF_UNIX));
                   1080: 
                   1081: 
                   1082:     my $description = sprintf("Connection to lonc client %d",
                   1083: 			      $ClientConnection);
                   1084:     Debug(9, "Creating event named: ".$description);
                   1085:     Event->io(cb      => \&ClientRequest,
                   1086: 	      poll    => 'r',
                   1087: 	      desc    => $description,
                   1088: 	      data    => "",
                   1089: 	      fd      => $connection);
                   1090:     $ActiveClients{$connection} = $ClientConnection;
                   1091:     $ClientConnection++;
                   1092: }
1.3       albertel 1093: 
                   1094: =pod
                   1095: 
                   1096: =head2 GetLoncSocketPath
                   1097: 
                   1098: Returns the name of the UNIX socket on which to listen for client
                   1099: connections.
1.1       foxr     1100: 
                   1101: =cut
1.3       albertel 1102: 
1.1       foxr     1103: sub GetLoncSocketPath {
                   1104:     return $UnixSocketDir."/".GetServerHost();
                   1105: }
                   1106: 
1.3       albertel 1107: =pod
                   1108: 
                   1109: =head2 GetServerHost
                   1110: 
                   1111: Returns the host whose lond we talk with.
                   1112: 
1.1       foxr     1113: =cut
1.3       albertel 1114: 
1.7       foxr     1115: sub GetServerHost {
1.1       foxr     1116:     return $RemoteHost;		# Setup by the fork.
                   1117: }
1.3       albertel 1118: 
                   1119: =pod
                   1120: 
                   1121: =head2 GetServerPort
                   1122: 
                   1123: Returns the lond port number.
                   1124: 
1.1       foxr     1125: =cut
1.3       albertel 1126: 
1.7       foxr     1127: sub GetServerPort {
1.1       foxr     1128:     return $perlvar{londPort};
                   1129: }
1.3       albertel 1130: 
                   1131: =pod
                   1132: 
                   1133: =head2 SetupLoncListener
                   1134: 
                   1135: Setup a lonc listener event.  The event is called when the socket
                   1136: becomes readable.. that corresponds to the receipt of a new
                   1137: connection.  The event handler established will accept the connection
                   1138: (creating a communcations channel), that int turn will establish
                   1139: another event handler to subess requests.
1.1       foxr     1140: 
                   1141: =cut
1.3       albertel 1142: 
1.1       foxr     1143: sub SetupLoncListener {
                   1144: 
                   1145:     my $socket;
                   1146:     my $SocketName = GetLoncSocketPath();
                   1147:     unlink($SocketName);
1.7       foxr     1148:     unless ($socket =IO::Socket::UNIX->new(Local  => $SocketName,
1.1       foxr     1149: 					    Listen => 10, 
                   1150: 					    Type   => SOCK_STREAM)) {
                   1151: 	die "Failed to create a lonc listner socket";
                   1152:     }
                   1153:     Event->io(cb     => \&NewClient,
                   1154: 	      poll   => 'r',
                   1155: 	      desc   => 'Lonc listener Unix Socket',
                   1156: 	      fd     => $socket);
                   1157: }
                   1158: 
                   1159: =pod
1.3       albertel 1160: 
1.1       foxr     1161: =head2 ChildProcess
                   1162: 
                   1163: This sub implements a child process for a single lonc daemon.
                   1164: 
                   1165: =cut
                   1166: 
                   1167: sub ChildProcess {
                   1168: 
                   1169:     print "Loncnew\n";
                   1170: 
                   1171:     # For now turn off signals.
                   1172:     
                   1173:     $SIG{QUIT}  = IGNORE;
                   1174:     $SIG{HUP}   = IGNORE;
                   1175:     $SIG{USR1}  = IGNORE;
                   1176:     $SIG{INT}   = IGNORE;
                   1177:     $SIG{CHLD}  = IGNORE;
                   1178:     $SIG{__DIE__}  = IGNORE;
                   1179: 
                   1180:     SetupTimer();
                   1181:     
                   1182:     SetupLoncListener();
                   1183:     
                   1184:     $Event::Debuglevel = $DebugLevel;
                   1185:     
                   1186:     Debug(9, "Making initial lond connection for ".$RemoteHost);
                   1187: 
                   1188: # Setup the initial server connection:
                   1189:     
                   1190:     &MakeLondConnection();
1.5       foxr     1191: 
                   1192:     if($ConnectionCount == 0) {
                   1193: 	Debug(1,"Could not make initial connection..\n");
                   1194: 	Debug(1,"Will retry when there's work to do\n");
                   1195:     }
1.1       foxr     1196:     Debug(9,"Entering event loop");
                   1197:     my $ret = Event::loop();		#  Start the main event loop.
                   1198:     
                   1199:     
                   1200:     die "Main event loop exited!!!";
                   1201: }
                   1202: 
                   1203: #  Create a new child for host passed in:
                   1204: 
                   1205: sub CreateChild {
                   1206:     my $host = shift;
                   1207:     $RemoteHost = $host;
                   1208:     Debug(3, "Forking off child for ".$RemoteHost);
                   1209:     sleep(5);
                   1210:     $pid          = fork;
                   1211:     if($pid) {			# Parent
                   1212: 	$ChildHash{$pid} = $RemoteHost;
                   1213:     } else {			# child.
1.5       foxr     1214: 	ShowStatus("Connected to ".$RemoteHost);
1.1       foxr     1215: 	ChildProcess;
                   1216:     }
                   1217: 
                   1218: }
                   1219: #
                   1220: #  Parent process logic pass 1:
                   1221: #   For each entry in the hosts table, we will
                   1222: #  fork off an instance of ChildProcess to service the transactions
                   1223: #  to that host.  Each pid will be entered in a global hash
                   1224: #  with the value of the key, the host.
                   1225: #  The parent will then enter a loop to wait for process exits.
                   1226: #  Each exit gets logged and the child gets restarted.
                   1227: #
                   1228: 
1.5       foxr     1229: #
                   1230: #   Fork and start in new session so hang-up isn't going to 
                   1231: #   happen without intent.
                   1232: #
                   1233: 
                   1234: 
1.6       foxr     1235: 
                   1236: 
1.8     ! foxr     1237: 
1.6       foxr     1238: 
                   1239: ShowStatus("Forming new session");
                   1240: my $childpid = fork;
                   1241: if ($childpid != 0) {
                   1242:     sleep 4;			# Give child a chacne to break to
                   1243:     exit 0;			# a new sesion.
                   1244: }
1.8     ! foxr     1245: #
        !          1246: #   Write my pid into the pid file so I can be located
        !          1247: #
        !          1248: 
        !          1249: ShowStatus("Parent writing pid file:");
        !          1250: $execdir = $perlvar{'lonDaemons'};
        !          1251: open (PIDSAVE, ">$execdir/logs/lonc.pid");
        !          1252: print PIDSAVE "$$\n";
        !          1253: close(PIDSAVE);
1.6       foxr     1254: 
                   1255: if (POSIX::setsid() < 0) {
                   1256:     print "Could not create new session\n";
                   1257:     exit -1;
                   1258: }
1.5       foxr     1259: 
                   1260: ShowStatus("Forking node servers");
                   1261: 
1.1       foxr     1262: my $HostIterator = LondConnection::GetHostIterator;
                   1263: while (! $HostIterator->end()) {
                   1264: 
                   1265:     $hostentryref = $HostIterator->get();
                   1266:     CreateChild($hostentryref->[0]);
                   1267:     $HostIterator->next();
                   1268: }
                   1269: 
                   1270: # Maintain the population:
1.5       foxr     1271: 
                   1272: ShowStatus("Parent keeping the flock");
1.1       foxr     1273: 
                   1274: while(1) {
                   1275:     $deadchild = wait();
                   1276:     if(exists $ChildHash{$deadchild}) {	# need to restart.
                   1277: 	$deadhost = $ChildHash{$deadchild};
                   1278: 	delete($ChildHash{$deadchild});
                   1279: 	Debug(4,"Lost child pid= ".$deadchild.
                   1280: 	      "Connected to host ".$deadhost);
                   1281: 	CreateChild($deadhost);
                   1282:     }
                   1283: }
                   1284: 
                   1285: =head1 Theory
1.3       albertel 1286: 
                   1287: The event class is used to build this as a single process with an
                   1288: event driven model.  The following events are handled:
1.1       foxr     1289: 
                   1290: =item UNIX Socket connection Received
                   1291: 
                   1292: =item Request data arrives on UNIX data transfer socket.
                   1293: 
                   1294: =item lond connection becomes writable.
                   1295: 
                   1296: =item timer fires at 1 second intervals.
                   1297: 
                   1298: All sockets are run in non-blocking mode.  Timeouts managed by the timer
                   1299: handler prevents hung connections.
                   1300: 
                   1301: Key data structures:
                   1302: 
1.3       albertel 1303: =item RequestQueue
                   1304: 
                   1305: A queue of requests received from UNIX sockets that are
                   1306: waiting for a chance to be forwarded on a lond connection socket.
                   1307: 
                   1308: =item ActiveConnections
                   1309: 
                   1310: A hash of lond connections that have transactions in process that are
                   1311: available to be timed out.
                   1312: 
                   1313: =item ActiveTransactions
                   1314: 
                   1315: A hash indexed by lond connections that contain the client reply
                   1316: socket for each connection that has an active transaction on it.
                   1317: 
                   1318: =item IdleConnections
                   1319: 
                   1320: A hash of lond connections that have no work to do.  These connections
                   1321: can be closed if they are idle for a long enough time.
1.1       foxr     1322: 
                   1323: =cut

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