Annotation of loncom/loncnew, revision 1.7

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

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