Annotation of loncom/loncnew, revision 1.13

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

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