Annotation of loncom/loncnew, revision 1.9

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

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