Annotation of loncom/loncnew, revision 1.41

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.41    ! albertel    5: # $Id: loncnew,v 1.40 2004/02/09 10:58:03 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).
1.17      foxr       10: ## LON-CAPA is free software; you can redistribute it and/or modify
1.2       albertel   11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.1       foxr       28: #
1.15      foxr       29: # new lonc handles n request out bver m connections to londs.
1.1       foxr       30: # This module is based on the Event class.
                     31: #   Development iterations:
                     32: #    - Setup basic event loop.   (done)
                     33: #    - Add timer dispatch.       (done)
                     34: #    - Add ability to accept lonc UNIX domain sockets.  (done)
                     35: #    - Add ability to create/negotiate lond connections (done).
1.7       foxr       36: #    - Add general logic for dispatching requests and timeouts. (done).
                     37: #    - Add support for the lonc/lond requests.          (done).
1.38      foxr       38: #    - Add logging/status monitoring.                    (done)
                     39: #    - Add Signal handling - HUP restarts. USR1 status report. (done)
1.7       foxr       40: #    - Add Configuration file I/O                       (done).
1.38      foxr       41: #    - Add management/status request interface.         (done)
1.8       foxr       42: #    - Add deferred request capability.                  (done)
1.38      foxr       43: #    - Detect transmission timeouts.                     (done)
1.7       foxr       44: #
                     45: 
1.23      foxr       46: use strict;
1.1       foxr       47: use lib "/home/httpd/lib/perl/";
                     48: use Event qw(:DEFAULT );
                     49: use POSIX qw(:signal_h);
1.12      foxr       50: use POSIX;
1.1       foxr       51: use IO::Socket;
                     52: use IO::Socket::INET;
                     53: use IO::Socket::UNIX;
1.9       foxr       54: use IO::File;
1.6       foxr       55: use IO::Handle;
1.1       foxr       56: use Socket;
                     57: use Crypt::IDEA;
                     58: use LONCAPA::Queue;
                     59: use LONCAPA::Stack;
                     60: use LONCAPA::LondConnection;
1.7       foxr       61: use LONCAPA::LondTransaction;
1.1       foxr       62: use LONCAPA::Configuration;
                     63: use LONCAPA::HashIterator;
                     64: 
                     65: 
                     66: # Read the httpd configuration file to get perl variables
                     67: # normally set in apache modules:
                     68: 
                     69: my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');
                     70: my %perlvar    = %{$perlvarref};
                     71: 
                     72: #
                     73: #  parent and shared variables.
                     74: 
                     75: my %ChildHash;			# by pid -> host.
1.26      foxr       76: my %HostToPid;			# By host -> pid.
                     77: my %HostHash;			# by loncapaname -> IP.
1.1       foxr       78: 
                     79: 
1.9       foxr       80: my $MaxConnectionCount = 10;	# Will get from config later.
1.1       foxr       81: my $ClientConnection = 0;	# Uniquifier for client events.
                     82: 
1.9       foxr       83: my $DebugLevel = 0;
1.29      foxr       84: my $NextDebugLevel= 2;		# So Sigint can toggle this.
1.1       foxr       85: my $IdleTimeout= 3600;		# Wait an hour before pruning connections.
                     86: 
1.39      foxr       87: my $LogTransactions = 0;	# When True, all transactions/replies get logged.
                     88: 
1.1       foxr       89: #
                     90: #  The variables below are only used by the child processes.
                     91: #
                     92: my $RemoteHost;			# Name of host child is talking to.
1.20      albertel   93: my $UnixSocketDir= $perlvar{'lonSockDir'};
1.1       foxr       94: my $IdleConnections = Stack->new(); # Set of idle connections
                     95: my %ActiveConnections;		# Connections to the remote lond.
1.7       foxr       96: my %ActiveTransactions;		# LondTransactions in flight.
1.1       foxr       97: my %ActiveClients;		# Serial numbers of active clients by socket.
                     98: my $WorkQueue       = Queue->new(); # Queue of pending transactions.
                     99: my $ConnectionCount = 0;
1.4       foxr      100: my $IdleSeconds     = 0;	# Number of seconds idle.
1.9       foxr      101: my $Status          = "";	# Current status string.
1.14      foxr      102: my $RecentLogEntry  = "";
1.30      foxr      103: my $ConnectionRetries=2;	# Number of connection retries allowed.
                    104: my $ConnectionRetriesLeft=2;	# Number of connection retries remaining.
1.40      foxr      105: my $LondVersion     = "unknown"; # Version of lond we talk with.
1.1       foxr      106: 
                    107: #
1.9       foxr      108: #   The hash below gives the HTML format for log messages
                    109: #   given a severity.
                    110: #    
                    111: my %LogFormats;
                    112: 
                    113: $LogFormats{"CRITICAL"} = "<font color=red>CRITICAL: %s</font>";
                    114: $LogFormats{"SUCCESS"}  = "<font color=green>SUCCESS: %s</font>";
                    115: $LogFormats{"INFO"}     = "<font color=yellow>INFO: %s</font>";
                    116: $LogFormats{"WARNING"}  = "<font color=blue>WARNING: %s</font>";
                    117: $LogFormats{"DEFAULT"}  = " %s ";
                    118: 
1.10      foxr      119: 
                    120: 
                    121: =pod
                    122: 
                    123: =head2 LogPerm
                    124: 
                    125: Makes an entry into the permanent log file.
                    126: 
                    127: =cut
                    128: sub LogPerm {
                    129:     my $message=shift;
                    130:     my $execdir=$perlvar{'lonDaemons'};
                    131:     my $now=time;
                    132:     my $local=localtime($now);
                    133:     my $fh=IO::File->new(">>$execdir/logs/lonnet.perm.log");
                    134:     print $fh "$now:$message:$local\n";
                    135: }
1.9       foxr      136: 
                    137: =pod
                    138: 
                    139: =head2 Log
                    140: 
                    141: Logs a message to the log file.
                    142: Parameters:
                    143: 
                    144: =item severity
                    145: 
                    146: One of CRITICAL, WARNING, INFO, SUCCESS used to select the
                    147: format string used to format the message.  if the severity is
                    148: not a defined severity the Default format string is used.
                    149: 
                    150: =item message
                    151: 
                    152: The base message.  In addtion to the format string, the message
                    153: will be appended to a string containing the name of our remote
                    154: host and the time will be formatted into the message.
                    155: 
                    156: =cut
                    157: 
                    158: sub Log {
                    159:     my $severity = shift;
                    160:     my $message  = shift;
                    161:    
                    162:     if(!$LogFormats{$severity}) {
                    163: 	$severity = "DEFAULT";
                    164:     }
                    165: 
                    166:     my $format = $LogFormats{$severity};
                    167:     
                    168:     #  Put the window dressing in in front of the message format:
                    169: 
                    170:     my $now   = time;
                    171:     my $local = localtime($now);
                    172:     my $finalformat = "$local ($$) [$RemoteHost] [$Status] ";
                    173:     my $finalformat = $finalformat.$format."\n";
                    174: 
                    175:     # open the file and put the result.
                    176: 
                    177:     my $execdir = $perlvar{'lonDaemons'};
                    178:     my $fh      = IO::File->new(">>$execdir/logs/lonc.log");
                    179:     my $msg = sprintf($finalformat, $message);
1.14      foxr      180:     $RecentLogEntry = $msg;
1.9       foxr      181:     print $fh $msg;
                    182:     
1.10      foxr      183:     
1.9       foxr      184: }
1.6       foxr      185: 
1.3       albertel  186: 
1.1       foxr      187: =pod
1.3       albertel  188: 
                    189: =head2 GetPeerName
                    190: 
                    191: Returns the name of the host that a socket object is connected to.
                    192: 
1.1       foxr      193: =cut
                    194: 
                    195: sub GetPeername {
                    196:     my $connection = shift;
                    197:     my $AdrFamily  = shift;
                    198:     my $peer       = $connection->peername();
                    199:     my $peerport;
                    200:     my $peerip;
                    201:     if($AdrFamily == AF_INET) {
                    202: 	($peerport, $peerip) = sockaddr_in($peer);
1.23      foxr      203: 	my $peername    = gethostbyaddr($peerip, $AdrFamily);
1.1       foxr      204: 	return $peername;
                    205:     } elsif ($AdrFamily == AF_UNIX) {
                    206: 	my $peerfile;
                    207: 	($peerfile) = sockaddr_un($peer);
                    208: 	return $peerfile;
                    209:     }
                    210: }
                    211: =pod
1.3       albertel  212: 
1.1       foxr      213: =head2 Debug
1.3       albertel  214: 
                    215: Invoked to issue a debug message.
                    216: 
1.1       foxr      217: =cut
1.3       albertel  218: 
1.1       foxr      219: sub Debug {
                    220:     my $level   = shift;
                    221:     my $message = shift;
                    222:     if ($level <= $DebugLevel) {
1.23      foxr      223: 	Log("INFO", "-Debug- $message host = $RemoteHost");
1.1       foxr      224:     }
                    225: }
                    226: 
                    227: sub SocketDump {
                    228:     my $level = shift;
                    229:     my $socket= shift;
                    230:     if($level <= $DebugLevel) {
                    231: 	$socket->Dump();
                    232:     }
                    233: }
1.3       albertel  234: 
1.1       foxr      235: =pod
1.3       albertel  236: 
1.5       foxr      237: =head2 ShowStatus
                    238: 
                    239:  Place some text as our pid status.
1.10      foxr      240:  and as what we return in a SIGUSR1
1.5       foxr      241: 
                    242: =cut
                    243: sub ShowStatus {
1.10      foxr      244:     my $state = shift;
                    245:     my $now = time;
                    246:     my $local = localtime($now);
                    247:     $Status   = $local.": ".$state;
                    248:     $0='lonc: '.$state.' '.$local;
1.5       foxr      249: }
                    250: 
                    251: =pod
                    252: 
1.15      foxr      253: =head 2 SocketTimeout
                    254: 
                    255:     Called when an action on the socket times out.  The socket is 
                    256:    destroyed and any active transaction is failed.
                    257: 
                    258: 
                    259: =cut
                    260: sub SocketTimeout {
                    261:     my $Socket = shift;
1.38      foxr      262:     Log("WARNING", "A socket timeout was detected");
                    263:     Debug(0, " SocketTimeout called: ");
                    264:     $Socket->Dump();
1.22      foxr      265:     KillSocket($Socket);	# A transaction timeout also counts as
                    266:                                 # a connection failure:
                    267:     $ConnectionRetriesLeft--;
1.15      foxr      268: }
1.35      foxr      269: #----------------------------- Timer management ------------------------
1.15      foxr      270: 
                    271: =pod
                    272: 
1.1       foxr      273: =head2 Tick
1.3       albertel  274: 
                    275: Invoked  each timer tick.
                    276: 
1.1       foxr      277: =cut
                    278: 
1.5       foxr      279: 
1.1       foxr      280: sub Tick {
                    281:     my $client;
1.22      foxr      282:     if($ConnectionRetriesLeft > 0) {
                    283: 	ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount
                    284: 		   ." Retries remaining: ".$ConnectionRetriesLeft);
                    285:     } else {
                    286: 	ShowStatus(GetServerHost()." >> DEAD <<");
                    287:     }
1.4       foxr      288:     # Is it time to prune connection count:
                    289: 
                    290: 
                    291:     if($IdleConnections->Count()  && 
                    292:        ($WorkQueue->Count() == 0)) { # Idle connections and nothing to do?
                    293: 	$IdleSeconds++;
                    294: 	if($IdleSeconds > $IdleTimeout) { # Prune a connection...
1.23      foxr      295: 	    my $Socket = $IdleConnections->pop();
1.6       foxr      296: 	    KillSocket($Socket);
1.4       foxr      297: 	}
                    298:     } else {
                    299: 	$IdleSeconds = 0;	# Reset idle count if not idle.
                    300:     }
1.15      foxr      301:     #
                    302:     #  For each inflight transaction, tick down its timeout counter.
                    303:     #
1.35      foxr      304: 
1.34      albertel  305:     foreach my $item (keys %ActiveConnections) {
                    306: 	my $State = $ActiveConnections{$item}->data->GetState();
1.35      foxr      307: 	if ($State ne 'Idle') {
1.34      albertel  308: 	    Debug(5,"Ticking Socket $State $item");
                    309: 	    $ActiveConnections{$item}->data->Tick();
                    310: 	}
1.15      foxr      311:     }
1.5       foxr      312:     # Do we have work in the queue, but no connections to service them?
                    313:     # If so, try to make some new connections to get things going again.
                    314:     #
                    315:     
                    316:     my $Requests = $WorkQueue->Count();
1.10      foxr      317:     if (($ConnectionCount == 0)  && ($Requests > 0)) { 
                    318: 	if ($ConnectionRetriesLeft > 0) {
                    319: 	    my $Connections = ($Requests <= $MaxConnectionCount) ?
                    320: 		$Requests : $MaxConnectionCount;
1.29      foxr      321: 	    Debug(5,"Work but no connections, start ".$Connections." of them");
1.22      foxr      322: 	    my $successCount = 0;
1.23      foxr      323: 	    for (my $i =0; $i < $Connections; $i++) {
1.22      foxr      324: 		$successCount += MakeLondConnection();
                    325: 	    }
                    326: 	    if($successCount == 0) { # All connections failed:
1.29      foxr      327: 		Debug(5,"Work in queue failed to make any connectiouns\n");
1.22      foxr      328: 		EmptyQueue();	# Fail pending transactions with con_lost.
1.10      foxr      329: 	    }
                    330: 	} else {
1.22      foxr      331: 	    ShowStatus(GetServerHost()." >>> DEAD!!! <<<");
1.29      foxr      332: 	    Debug(5,"Work in queue, but gave up on connections..flushing\n");
1.10      foxr      333: 	    EmptyQueue();	# Connections can't be established.
1.5       foxr      334: 	}
                    335:        
                    336:     }
1.1       foxr      337: }
                    338: 
                    339: =pod
1.3       albertel  340: 
1.1       foxr      341: =head2 SetupTimer
                    342: 
1.3       albertel  343: Sets up a 1 per sec recurring timer event.  The event handler is used to:
1.1       foxr      344: 
1.3       albertel  345: =item
                    346: 
                    347: Trigger timeouts on communications along active sockets.
                    348: 
                    349: =item
                    350: 
                    351: Trigger disconnections of idle sockets.
1.1       foxr      352: 
                    353: =cut
                    354: 
                    355: sub SetupTimer {
                    356:     Debug(6, "SetupTimer");
1.33      foxr      357:     Event->timer(interval => 1, cb => \&Tick );
1.1       foxr      358: }
1.3       albertel  359: 
1.1       foxr      360: =pod
1.3       albertel  361: 
1.1       foxr      362: =head2 ServerToIdle
1.3       albertel  363: 
                    364: This function is called when a connection to the server is
                    365: ready for more work.
                    366: 
                    367: If there is work in the Work queue the top element is dequeued
1.1       foxr      368: and the connection will start to work on it.  If the work queue is
                    369: empty, the connection is pushed on the idle connection stack where
                    370: it will either get another work unit, or alternatively, if it sits there
                    371: long enough, it will be shut down and released.
                    372: 
1.3       albertel  373: =cut
1.1       foxr      374: 
                    375: sub ServerToIdle {
                    376:     my $Socket   = shift;	# Get the socket.
1.7       foxr      377:     delete($ActiveTransactions{$Socket}); # Server has no transaction
1.1       foxr      378: 
1.29      foxr      379:     &Debug(5, "Server to idle");
1.1       foxr      380: 
                    381:     #  If there's work to do, start the transaction:
                    382: 
1.23      foxr      383:     my $reqdata = $WorkQueue->dequeue(); # This is a LondTransaction
1.29      foxr      384:     if ($reqdata ne undef)  {
                    385: 	Debug(5, "Queue gave request data: ".$reqdata->getRequest());
1.7       foxr      386: 	&StartRequest($Socket,  $reqdata);
1.8       foxr      387: 
1.1       foxr      388:     } else {
                    389: 	
                    390:     #  There's no work waiting, so push the server to idle list.
1.29      foxr      391: 	&Debug(5, "No new work requests, server connection going idle");
1.1       foxr      392: 	$IdleConnections->push($Socket);
                    393:     }
                    394: }
1.3       albertel  395: 
1.1       foxr      396: =pod
1.3       albertel  397: 
1.1       foxr      398: =head2 ClientWritable
1.3       albertel  399: 
                    400: Event callback for when a client socket is writable.
                    401: 
                    402: This callback is established when a transaction reponse is
                    403: avaiable from lond.  The response is forwarded to the unix socket
                    404: as it becomes writable in this sub.
                    405: 
1.1       foxr      406: Parameters:
                    407: 
1.3       albertel  408: =item Event
                    409: 
                    410: The event that has been triggered. Event->w->data is
                    411: the data and Event->w->fd is the socket to write.
1.1       foxr      412: 
                    413: =cut
1.3       albertel  414: 
1.1       foxr      415: sub ClientWritable {
                    416:     my $Event    = shift;
                    417:     my $Watcher  = $Event->w;
                    418:     my $Data     = $Watcher->data;
                    419:     my $Socket   = $Watcher->fd;
                    420: 
                    421:     # Try to send the data:
                    422: 
                    423:     &Debug(6, "ClientWritable writing".$Data);
                    424:     &Debug(9, "Socket is: ".$Socket);
                    425: 
1.6       foxr      426:     if($Socket->connected) {
                    427: 	my $result = $Socket->send($Data, 0);
                    428: 	
                    429: 	# $result undefined: the write failed.
                    430: 	# otherwise $result is the number of bytes written.
                    431: 	# Remove that preceding string from the data.
                    432: 	# If the resulting data is empty, destroy the watcher
                    433: 	# and set up a read event handler to accept the next
                    434: 	# request.
                    435: 	
                    436: 	&Debug(9,"Send result is ".$result." Defined: ".defined($result));
1.29      foxr      437: 	if($result ne undef) {
1.6       foxr      438: 	    &Debug(9, "send result was defined");
                    439: 	    if($result == length($Data)) { # Entire string sent.
                    440: 		&Debug(9, "ClientWritable data all written");
                    441: 		$Watcher->cancel();
                    442: 		#
                    443: 		#  Set up to read next request from socket:
                    444: 		
                    445: 		my $descr     = sprintf("Connection to lonc client %d",
                    446: 					$ActiveClients{$Socket});
                    447: 		Event->io(cb    => \&ClientRequest,
                    448: 			  poll  => 'r',
                    449: 			  desc  => $descr,
                    450: 			  data  => "",
                    451: 			  fd    => $Socket);
                    452: 		
                    453: 	    } else {		# Partial string sent.
                    454: 		$Watcher->data(substr($Data, $result));
1.15      foxr      455: 		if($result == 0) {    # client hung up on us!!
                    456: 		    Log("INFO", "lonc pipe client hung up on us!");
                    457: 		    $Watcher->cancel;
                    458: 		    $Socket->shutdown(2);
                    459: 		    $Socket->close();
                    460: 		}
1.6       foxr      461: 	    }
                    462: 	    
                    463: 	} else {			# Error of some sort...
                    464: 	    
                    465: 	    # Some errnos are possible:
                    466: 	    my $errno = $!;
                    467: 	    if($errno == POSIX::EWOULDBLOCK   ||
                    468: 	       $errno == POSIX::EAGAIN        ||
                    469: 	       $errno == POSIX::EINTR) {
                    470: 		# No action taken?
                    471: 	    } else {		# Unanticipated errno.
                    472: 		&Debug(5,"ClientWritable error or peer shutdown".$RemoteHost);
                    473: 		$Watcher->cancel;	# Stop the watcher.
                    474: 		$Socket->shutdown(2); # Kill connection
                    475: 		$Socket->close();	# Close the socket.
                    476: 	    }
1.1       foxr      477: 	    
                    478: 	}
1.6       foxr      479:     } else {
                    480: 	$Watcher->cancel();	# A delayed request...just cancel.
1.1       foxr      481:     }
                    482: }
                    483: 
                    484: =pod
1.3       albertel  485: 
1.1       foxr      486: =head2 CompleteTransaction
1.3       albertel  487: 
                    488: Called when the reply data has been received for a lond 
1.1       foxr      489: transaction.   The reply data must now be sent to the
                    490: ultimate client on the other end of the Unix socket.  This is
                    491: done by setting up a writable event for the socket with the
                    492: data the reply data.
1.3       albertel  493: 
1.1       foxr      494: Parameters:
1.3       albertel  495: 
                    496: =item Socket
                    497: 
                    498: Socket on which the lond transaction occured.  This is a
                    499: LondConnection. The data received is in the TransactionReply member.
                    500: 
1.7       foxr      501: =item Transaction
1.3       albertel  502: 
1.7       foxr      503: The transaction that is being completed.
1.1       foxr      504: 
                    505: =cut
1.3       albertel  506: 
1.1       foxr      507: sub CompleteTransaction {
1.29      foxr      508:     &Debug(5,"Complete transaction");
1.1       foxr      509:     my $Socket = shift;
1.7       foxr      510:     my $Transaction = shift;
1.1       foxr      511: 
1.7       foxr      512:     if (!$Transaction->isDeferred()) { # Normal transaction
                    513: 	my $data   = $Socket->GetReply(); # Data to send.
1.39      foxr      514: 	if($LogTransactions) {
                    515: 	    Log("SUCCESS", "Reply from lond: '$data'");
                    516: 	}
1.7       foxr      517: 	StartClientReply($Transaction, $data);
                    518:     } else {			# Delete deferred transaction file.
1.9       foxr      519: 	Log("SUCCESS", "A delayed transaction was completed");
1.23      foxr      520: 	LogPerm("S:$Transaction->getClient() :".$Transaction->getRequest());
1.7       foxr      521: 	unlink $Transaction->getFile();
                    522:     }
1.6       foxr      523: }
                    524: =pod
                    525: =head1 StartClientReply
                    526: 
                    527:    Initiates a reply to a client where the reply data is a parameter.
                    528: 
1.7       foxr      529: =head2  parameters:
                    530: 
                    531: =item Transaction
                    532: 
                    533:     The transaction for which we are responding to the client.
                    534: 
                    535: =item data
                    536: 
                    537:     The data to send to apached client.
                    538: 
1.6       foxr      539: =cut
                    540: sub StartClientReply {
1.7       foxr      541:     my $Transaction   = shift;
1.6       foxr      542:     my $data     = shift;
1.1       foxr      543: 
1.12      foxr      544: 
1.7       foxr      545:     my $Client   = $Transaction->getClient();
                    546: 
1.1       foxr      547:     &Debug(8," Reply was: ".$data);
                    548:     my $Serial         = $ActiveClients{$Client};
                    549:     my $desc           = sprintf("Connection to lonc client %d",
                    550: 				 $Serial);
                    551:     Event->io(fd       => $Client,
                    552: 	      poll     => "w",
                    553: 	      desc     => $desc,
                    554: 	      cb       => \&ClientWritable,
                    555: 	      data     => $data);
                    556: }
1.4       foxr      557: =pod
                    558: =head2 FailTransaction
                    559: 
                    560:   Finishes a transaction with failure because the associated lond socket
1.7       foxr      561:   disconnected.  There are two possibilities:
                    562:   - The transaction is deferred: in which case we just quietly
                    563:     delete the transaction since there is no client connection.
                    564:   - The transaction is 'live' in which case we initiate the sending
                    565:     of "con_lost" to the client.
                    566: 
                    567: Deleting the transaction means killing it from the 
                    568: %ActiveTransactions hash.
1.4       foxr      569: 
                    570: Parameters:
                    571: 
                    572: =item client  
                    573:  
1.7       foxr      574:    The LondTransaction we are failing.
                    575:  
1.4       foxr      576: =cut
                    577: 
                    578: sub FailTransaction {
1.7       foxr      579:     my $transaction = shift;
1.17      foxr      580:     Log("WARNING", "Failing transaction ".$transaction->getRequest());
1.30      foxr      581:     Debug(1, "Failing transaction: ".$transaction->getRequest());
1.10      foxr      582:     if (!$transaction->isDeferred()) { # If the transaction is deferred we'll get to it.
1.11      foxr      583: 	my $client  = $transaction->getClient();
1.30      foxr      584: 	Debug(1," Replying con_lost to ".$transaction->getRequest());
1.11      foxr      585: 	StartClientReply($transaction, "con_lost\n");
1.7       foxr      586:     }
1.22      foxr      587:     if($ConnectionRetriesLeft <= 0) {
                    588: 	Log("CRITICAL", "Host marked dead: ".GetServerHost());
                    589:     }
1.4       foxr      590: 
                    591: }
                    592: 
                    593: =pod
1.6       foxr      594: =head1  EmptyQueue
1.7       foxr      595: 
1.6       foxr      596:   Fails all items in the work queue with con_lost.
1.7       foxr      597:   Note that each item in the work queue is a transaction.
                    598: 
1.6       foxr      599: =cut
                    600: sub EmptyQueue {
1.22      foxr      601:     $ConnectionRetriesLeft--;	# Counts as connection failure too.
1.6       foxr      602:     while($WorkQueue->Count()) {
1.10      foxr      603: 	my $request = $WorkQueue->dequeue(); # This is a transaction
1.7       foxr      604: 	FailTransaction($request);
1.6       foxr      605:     }
                    606: }
                    607: 
                    608: =pod
1.4       foxr      609: 
1.9       foxr      610: =head2 CloseAllLondConnections
                    611: 
                    612: Close all connections open on lond prior to exit e.g.
                    613: 
                    614: =cut
                    615: sub CloseAllLondConnections {
1.23      foxr      616:     foreach my $Socket (keys %ActiveConnections) {
1.9       foxr      617: 	KillSocket($Socket);
                    618:     }
                    619: }
                    620: =cut
                    621: 
                    622: =pod
                    623: 
1.4       foxr      624: =head2 KillSocket
                    625:  
                    626: Destroys a socket.  This function can be called either when a socket
                    627: has died of 'natural' causes or because a socket needs to be pruned due to
                    628: idleness.  If the socket has died naturally, if there are no longer any 
                    629: live connections a new connection is created (in case there are transactions
                    630: in the queue).  If the socket has been pruned, it is never re-created.
                    631: 
                    632: Parameters:
1.1       foxr      633: 
1.4       foxr      634: =item Socket
                    635:  
                    636:   The socket to kill off.
                    637: 
                    638: =item Restart
                    639: 
                    640: nonzero if we are allowed to create a new connection.
                    641: 
                    642: 
                    643: =cut
                    644: sub KillSocket {
                    645:     my $Socket = shift;
                    646: 
1.17      foxr      647:     Log("WARNING", "Shutting down a socket");
1.9       foxr      648:     $Socket->Shutdown();
                    649: 
1.7       foxr      650:     #  If the socket came from the active connection set,
                    651:     #  delete its transaction... note that FailTransaction should
                    652:     #  already have been called!!!
                    653:     #  otherwise it came from the idle set.
                    654:     #  
1.4       foxr      655:     
                    656:     if(exists($ActiveTransactions{$Socket})) {
                    657: 	delete ($ActiveTransactions{$Socket});
                    658:     }
                    659:     if(exists($ActiveConnections{$Socket})) {
                    660: 	delete($ActiveConnections{$Socket});
1.37      albertel  661: 	$ConnectionCount--;
                    662: 	if ($ConnectionCount < 0) { $ConnectionCount = 0; }
1.4       foxr      663:     }
1.6       foxr      664:     #  If the connection count has gone to zero and there is work in the
                    665:     #  work queue, the work all gets failed with con_lost.
                    666:     #
                    667:     if($ConnectionCount == 0) {
1.22      foxr      668: 	EmptyQueue();
1.4       foxr      669:     }
                    670: }
1.1       foxr      671: 
                    672: =pod
1.3       albertel  673: 
1.1       foxr      674: =head2 LondReadable
1.3       albertel  675: 
1.1       foxr      676: This function is called whenever a lond connection
                    677: is readable.  The action is state dependent:
                    678: 
1.3       albertel  679: =head3 State=Initialized
                    680: 
                    681: We''re waiting for the challenge, this is a no-op until the
1.1       foxr      682: state changes.
1.3       albertel  683: 
1.1       foxr      684: =head3 State=Challenged 
1.3       albertel  685: 
                    686: The challenge has arrived we need to transition to Writable.
1.1       foxr      687: The connection must echo the challenge back.
1.3       albertel  688: 
1.1       foxr      689: =head3 State=ChallengeReplied
1.3       albertel  690: 
                    691: The challenge has been replied to.  The we are receiveing the 
1.1       foxr      692: 'ok' from the partner.
1.3       albertel  693: 
1.40      foxr      694: =head3  State=ReadingVersionString
                    695: 
                    696: We have requested the lond version and are reading the
                    697: version back.  Upon completion, we'll store the version away
                    698: for future use(?).
                    699: 
                    700: =head3 State=HostSet
                    701: 
                    702: We have selected the domain name of our peer (multhomed hosts)
                    703: and are getting the reply (presumably ok) back.
                    704: 
1.1       foxr      705: =head3 State=RequestingKey
1.3       albertel  706: 
                    707: The ok has been received and we need to send the request for
1.1       foxr      708: an encryption key.  Transition to writable for that.
1.3       albertel  709: 
1.1       foxr      710: =head3 State=ReceivingKey
1.3       albertel  711: 
                    712: The the key has been requested, now we are reading the new key.
                    713: 
1.1       foxr      714: =head3 State=Idle 
1.3       albertel  715: 
                    716: The encryption key has been negotiated or we have finished 
1.1       foxr      717: reading data from the a transaction.   If the callback data has
                    718: a client as well as the socket iformation, then we are 
                    719: doing a transaction and the data received is relayed to the client
                    720: before the socket is put on the idle list.
1.3       albertel  721: 
1.1       foxr      722: =head3 State=SendingRequest
1.3       albertel  723: 
                    724: I do not think this state can be received here, but if it is,
1.1       foxr      725: the appropriate thing to do is to transition to writable, and send
                    726: the request.
1.3       albertel  727: 
1.1       foxr      728: =head3 State=ReceivingReply
1.3       albertel  729: 
                    730: We finished sending the request to the server and now transition
1.1       foxr      731: to readable to receive the reply. 
                    732: 
                    733: The parameter to this function are:
1.3       albertel  734: 
1.1       foxr      735: The event. Implicit in this is the watcher and its data.  The data 
                    736: contains at least the lond connection object and, if a 
                    737: transaction is in progress, the socket attached to the local client.
                    738: 
1.3       albertel  739: =cut
1.1       foxr      740: 
                    741: sub LondReadable {
1.8       foxr      742: 
1.41    ! albertel  743:     my $Event      = shift;
        !           744:     my $Watcher    = $Event->w;
        !           745:     my $Socket     = $Watcher->data;
        !           746:     my $client     = undef;
1.40      foxr      747: 
1.41    ! albertel  748:     &Debug(6,"LondReadable called state = ".$Socket->GetState());
1.40      foxr      749: 
                    750: 
1.41    ! albertel  751:     my $State = $Socket->GetState(); # All action depends on the state.
1.40      foxr      752: 
1.41    ! albertel  753:     SocketDump(6, $Socket);
        !           754:     my $status = $Socket->Readable();
1.40      foxr      755: 
1.41    ! albertel  756:     &Debug(2, "Socket->Readable returned: $status");
1.40      foxr      757: 
1.41    ! albertel  758:     if($status != 0) {
        !           759: 	# bad return from socket read. Currently this means that
        !           760: 	# The socket has become disconnected. We fail the transaction.
1.40      foxr      761: 
1.41    ! albertel  762: 	Log("WARNING",
        !           763: 	    "Lond connection lost.");
        !           764: 	if(exists($ActiveTransactions{$Socket})) {
        !           765: 	    FailTransaction($ActiveTransactions{$Socket});
        !           766: 	}
        !           767: 	$Watcher->cancel();
        !           768: 	KillSocket($Socket);
        !           769: 	$ConnectionRetriesLeft--;       # Counts as connection failure
        !           770: 	return;
        !           771:     }
        !           772:     SocketDump(6,$Socket);
1.17      foxr      773: 
1.41    ! albertel  774:     $State = $Socket->GetState(); # Update in case of transition.
        !           775:     &Debug(6, "After read, state is ".$State);
1.1       foxr      776: 
1.41    ! albertel  777:     if($State eq "Initialized") {
1.1       foxr      778: 
                    779: 
1.41    ! albertel  780:     } elsif ($State eq "ChallengeReceived") {
1.1       foxr      781: 	#  The challenge must be echoed back;  The state machine
                    782: 	# in the connection takes care of setting that up.  Just
                    783: 	# need to transition to writable:
1.41    ! albertel  784: 	
        !           785: 	$Watcher->cb(\&LondWritable);
        !           786: 	$Watcher->poll("w");
1.1       foxr      787: 
1.41    ! albertel  788:     } elsif ($State eq "ChallengeReplied") {
1.1       foxr      789: 
1.41    ! albertel  790:     } elsif ($State eq "RequestingVersion") {
        !           791: 	# Need to ask for the version... that is writiability:
1.1       foxr      792: 
1.41    ! albertel  793: 	$Watcher->cb(\&LondWritable);
        !           794: 	$Watcher->poll("w");
        !           795: 
        !           796:     } elsif ($State eq "ReadingVersionString") {
        !           797: 	# Read the rest of the version string... 
        !           798:     } elsif ($State eq "SetHost") {
        !           799: 	# Need to request the actual domain get set...
        !           800: 
        !           801: 	$Watcher->cb(\&LondWritable);
        !           802: 	$Watcher->poll("w");
        !           803:     } elsif ($State eq "HostSet") {
        !           804: 	# Reading the 'ok' from the peer.
        !           805: 
        !           806:     } elsif ($State eq "RequestingKey") {
1.1       foxr      807: 	#  The ok was received.  Now we need to request the key
                    808: 	#  That requires us to be writable:
                    809: 
1.41    ! albertel  810: 	$Watcher->cb(\&LondWritable);
        !           811: 	$Watcher->poll("w");
1.1       foxr      812: 
1.41    ! albertel  813:     } elsif ($State eq "ReceivingKey") {
1.1       foxr      814: 
1.41    ! albertel  815:     } elsif ($State eq "Idle") {
1.40      foxr      816:    
1.41    ! albertel  817: 	# This is as good a spot as any to get the peer version
        !           818: 	# string:
1.40      foxr      819:    
1.41    ! albertel  820: 	if($LondVersion eq "unknown") {
        !           821: 	    $LondVersion = $Socket->PeerVersion();
        !           822: 	    Log("INFO", "Connected to lond version: $LondVersion");
        !           823: 	}
1.1       foxr      824: 	# If necessary, complete a transaction and then go into the
                    825: 	# idle queue.
1.22      foxr      826: 	#  Note that a trasition to idle indicates a live lond
                    827: 	# on the other end so reset the connection retries.
                    828: 	#
1.41    ! albertel  829: 	$ConnectionRetriesLeft = $ConnectionRetries; # success resets the count
        !           830: 	$Watcher->cancel();
        !           831: 	if(exists($ActiveTransactions{$Socket})) {
        !           832: 	    Debug(5,"Completing transaction!!");
        !           833: 	    CompleteTransaction($Socket, 
        !           834: 				$ActiveTransactions{$Socket});
        !           835: 	} else {
        !           836: 	    Log("SUCCESS", "Connection ".$ConnectionCount." to "
        !           837: 		.$RemoteHost." now ready for action");
        !           838: 	}
        !           839: 	ServerToIdle($Socket);	# Next work unit or idle.
1.6       foxr      840: 	
1.41    ! albertel  841:     } elsif ($State eq "SendingRequest") {
1.1       foxr      842: 	#  We need to be writable for this and probably don't belong
                    843: 	#  here inthe first place.
                    844: 
1.41    ! albertel  845: 	Deubg(6, "SendingRequest state encountered in readable");
        !           846: 	$Watcher->poll("w");
        !           847: 	$Watcher->cb(\&LondWritable);
1.1       foxr      848: 
1.41    ! albertel  849:     } elsif ($State eq "ReceivingReply") {
1.1       foxr      850: 
                    851: 
1.41    ! albertel  852:     } else {
        !           853: 	# Invalid state.
        !           854: 	Debug(4, "Invalid state in LondReadable");
        !           855:     }
1.1       foxr      856: }
1.3       albertel  857: 
1.1       foxr      858: =pod
1.3       albertel  859: 
1.1       foxr      860: =head2 LondWritable
1.3       albertel  861: 
1.1       foxr      862: This function is called whenever a lond connection
                    863: becomes writable while there is a writeable monitoring
                    864: event.  The action taken is very state dependent:
1.3       albertel  865: 
1.1       foxr      866: =head3 State = Connected 
1.3       albertel  867: 
                    868: The connection is in the process of sending the 'init' hailing to the
                    869: lond on the remote end.  The connection object''s Writable member is
                    870: called.  On error, ConnectionError is called to destroy the connection
                    871: and remove it from the ActiveConnections hash
                    872: 
1.1       foxr      873: =head3 Initialized
1.3       albertel  874: 
                    875: 'init' has been sent, writability monitoring is removed and
                    876: readability monitoring is started with LondReadable as the callback.
                    877: 
1.1       foxr      878: =head3 ChallengeReceived
1.3       albertel  879: 
                    880: The connection has received the who are you challenge from the remote
                    881: system, and is in the process of sending the challenge
                    882: response. Writable is called.
                    883: 
1.1       foxr      884: =head3 ChallengeReplied
1.3       albertel  885: 
                    886: The connection has replied to the initial challenge The we switch to
                    887: monitoring readability looking for the server to reply with 'ok'.
                    888: 
1.1       foxr      889: =head3 RequestingKey
1.3       albertel  890: 
                    891: The connection is in the process of requesting its encryption key.
                    892: Writable is called.
                    893: 
1.1       foxr      894: =head3 ReceivingKey
1.3       albertel  895: 
                    896: The connection has sent the request for a key.  Switch to readability
                    897: monitoring to accept the key
                    898: 
1.1       foxr      899: =head3 SendingRequest
1.3       albertel  900: 
                    901: The connection is in the process of sending a request to the server.
                    902: This request is part of a client transaction.  All the states until
                    903: now represent the client setup protocol. Writable is called.
                    904: 
1.1       foxr      905: =head3 ReceivingReply
                    906: 
1.3       albertel  907: The connection has sent a request.  Now it must receive a reply.
                    908: Readability monitoring is requested.
                    909: 
                    910: This function is an event handler and therefore receives as
1.1       foxr      911: a parameter the event that has fired.  The data for the watcher
                    912: of this event is a reference to a list of one or two elements,
                    913: depending on state. The first (and possibly only) element is the
                    914: socket.  The second (present only if a request is in progress)
                    915: is the socket on which to return a reply to the caller.
                    916: 
                    917: =cut
1.3       albertel  918: 
1.1       foxr      919: sub LondWritable {
                    920:     my $Event   = shift;
                    921:     my $Watcher = $Event->w;
1.8       foxr      922:     my $Socket  = $Watcher->data;
                    923:     my $State   = $Socket->GetState();
1.1       foxr      924: 
1.8       foxr      925:     Debug(6,"LondWritable State = ".$State."\n");
1.1       foxr      926: 
1.8       foxr      927:  
1.1       foxr      928:     #  Figure out what to do depending on the state of the socket:
                    929:     
                    930: 
                    931: 
                    932: 
                    933:     SocketDump(6,$Socket);
                    934: 
1.41    ! albertel  935:     if      ($State eq "Connected")         {
1.1       foxr      936: 
1.41    ! albertel  937: 	if ($Socket->Writable() != 0) {
        !           938: 	    #  The write resulted in an error.
        !           939: 	    # We'll treat this as if the socket got disconnected:
        !           940: 	    Log("WARNING", "Connection to ".$RemoteHost.
        !           941: 		" has been disconnected");
        !           942: 	    FailTransaction($ActiveTransactions{$Socket});
        !           943: 	    $Watcher->cancel();
        !           944: 	    KillSocket($Socket);
        !           945: 	    return;
        !           946: 	}
1.40      foxr      947:       
1.41    ! albertel  948: 	#  "init" is being sent...
1.40      foxr      949:    
1.41    ! albertel  950:     } elsif ($State eq "Initialized")       {
1.4       foxr      951: 
1.41    ! albertel  952: 	# Now that init was sent, we switch 
        !           953: 	# to watching for readability:
1.1       foxr      954: 
1.41    ! albertel  955: 	$Watcher->cb(\&LondReadable);
        !           956: 	$Watcher->poll("r");
        !           957: 	
        !           958:     } elsif ($State eq "ChallengeReceived") {
        !           959: 	# We received the challenge, now we 
        !           960: 	# are echoing it back. This is a no-op,
        !           961: 	# we're waiting for the state to change
1.1       foxr      962: 	
1.41    ! albertel  963: 	if($Socket->Writable() != 0) {
1.5       foxr      964: 
1.41    ! albertel  965: 	    $Watcher->cancel();
        !           966: 	    KillSocket($Socket);
        !           967: 	    return;
        !           968: 	}
1.1       foxr      969: 	
1.41    ! albertel  970:     } elsif ($State eq "ChallengeReplied")  {
        !           971: 	# The echo was sent back, so we switch
        !           972: 	# to watching readability.
        !           973: 
        !           974: 	$Watcher->cb(\&LondReadable);
        !           975: 	$Watcher->poll("r");
        !           976:     } elsif ($State eq "RequestingVersion") {
        !           977: 	# Sending the peer a version request...
1.40      foxr      978:       
1.41    ! albertel  979: 	if($Socket->Writable() != 0) {
        !           980: 	    $Watcher->cancel();
        !           981: 	    KillSocket($Socket);
        !           982: 	    return;
        !           983: 	}
        !           984:     } elsif ($State eq "ReadingVersionString") {
        !           985: 	# Transition to read since we have sent the
        !           986: 	# version command and now just need to read the
        !           987: 	# version string from the peer:
1.40      foxr      988:       
1.41    ! albertel  989: 	$Watcher->cb(\&LondReadable);
        !           990: 	$Watcher->poll("r");
1.40      foxr      991:       
1.41    ! albertel  992:     } elsif ($State eq "SetHost") {
        !           993: 	#  Setting the remote domain...
1.40      foxr      994:       
1.41    ! albertel  995: 	if($Socket->Writable() != 0) {
        !           996: 	    $Watcher->cancel();
        !           997: 	    KillSocket($Socket);
        !           998: 	    return;
        !           999: 	}
        !          1000:     } elsif ($State eq "HostSet") {
        !          1001: 	# Back to readable to get the ok.
1.40      foxr     1002:       
1.41    ! albertel 1003: 	$Watcher->cb(\&LondReadable);
        !          1004: 	$Watcher->poll("r");
1.40      foxr     1005:       
                   1006: 
1.41    ! albertel 1007:     } elsif ($State eq "RequestingKey")     {
        !          1008: 	# At this time we're requesting the key.
        !          1009: 	# again, this is essentially a no-op.
        !          1010: 	# we'll write the next chunk until the
        !          1011: 	# state changes.
1.1       foxr     1012: 
1.41    ! albertel 1013: 	if($Socket->Writable() != 0) {
        !          1014: 	    # Write resulted in an error.
        !          1015: 
        !          1016: 	    $Watcher->cancel();
        !          1017: 	    KillSocket($Socket);
        !          1018: 	    return;
1.5       foxr     1019: 
1.41    ! albertel 1020: 	}
        !          1021:     } elsif ($State eq "ReceivingKey")      {
        !          1022: 	# Now we need to wait for the key
        !          1023: 	# to come back from the peer:
        !          1024: 
        !          1025: 	$Watcher->cb(\&LondReadable);
        !          1026: 	$Watcher->poll("r");
        !          1027: 
        !          1028:     } elsif ($State eq "SendingRequest")    {
1.40      foxr     1029:  
1.41    ! albertel 1030: 	# At this time we are sending a request to the
1.1       foxr     1031: 	# peer... write the next chunk:
                   1032: 
1.41    ! albertel 1033: 	if($Socket->Writable() != 0) {
1.1       foxr     1034: 
1.41    ! albertel 1035: 	    if(exists($ActiveTransactions{$Socket})) {
        !          1036: 		Debug(3, "Lond connection lost, failing transactions");
        !          1037: 		FailTransaction($ActiveTransactions{$Socket});
        !          1038: 	    }
        !          1039: 	    $Watcher->cancel();
        !          1040: 	    KillSocket($Socket);
        !          1041: 	    return;
1.5       foxr     1042: 	    
1.41    ! albertel 1043: 	}
        !          1044: 
        !          1045:     } elsif ($State eq "ReceivingReply")    {
        !          1046: 	# The send has completed.  Wait for the
        !          1047: 	# data to come in for a reply.
        !          1048: 	Debug(8,"Writable sent request/receiving reply");
        !          1049: 	$Watcher->cb(\&LondReadable);
        !          1050: 	$Watcher->poll("r");
1.1       foxr     1051: 
1.41    ! albertel 1052:     } else {
        !          1053: 	#  Control only passes here on an error: 
        !          1054: 	#  the socket state does not match any
        !          1055: 	#  of the known states... so an error
        !          1056: 	#  must be logged.
1.1       foxr     1057: 
1.41    ! albertel 1058: 	&Debug(4, "Invalid socket state ".$State."\n");
        !          1059:     }
1.1       foxr     1060:     
                   1061: }
1.6       foxr     1062: =pod
                   1063:     
                   1064: =cut
                   1065: sub QueueDelayed {
1.8       foxr     1066:     Debug(3,"QueueDelayed called");
                   1067: 
1.6       foxr     1068:     my $path = "$perlvar{'lonSockDir'}/delayed";
1.8       foxr     1069: 
                   1070:     Debug(4, "Delayed path: ".$path);
1.6       foxr     1071:     opendir(DIRHANDLE, $path);
1.8       foxr     1072:     
1.23      foxr     1073:     my @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;
1.6       foxr     1074:     closedir(DIRHANDLE);
                   1075:     my $dfname;
1.8       foxr     1076:     my $reqfile;
                   1077:     foreach $dfname (sort  @alldelayed) {
                   1078: 	$reqfile = "$path/$dfname";
                   1079: 	Debug(4, "queueing ".$reqfile);
1.6       foxr     1080: 	my $Handle = IO::File->new($reqfile);
                   1081: 	my $cmd    = <$Handle>;
1.8       foxr     1082: 	chomp $cmd;		# There may or may not be a newline...
1.12      foxr     1083: 	$cmd = $cmd."\n";	# now for sure there's exactly one newline.
1.7       foxr     1084: 	my $Transaction = LondTransaction->new($cmd);
                   1085: 	$Transaction->SetDeferred($reqfile);
                   1086: 	QueueTransaction($Transaction);
1.6       foxr     1087:     }
                   1088:     
                   1089: }
1.1       foxr     1090: 
                   1091: =pod
1.3       albertel 1092: 
1.1       foxr     1093: =head2 MakeLondConnection
1.3       albertel 1094: 
                   1095: Create a new lond connection object, and start it towards its initial
                   1096: idleness.  Once idle, it becomes elligible to receive transactions
                   1097: from the work queue.  If the work queue is not empty when the
                   1098: connection is completed and becomes idle, it will dequeue an entry and
                   1099: start off on it.
                   1100: 
1.1       foxr     1101: =cut
1.3       albertel 1102: 
1.1       foxr     1103: sub MakeLondConnection {     
                   1104:     Debug(4,"MakeLondConnection to ".GetServerHost()." on port "
                   1105: 	  .GetServerPort());
                   1106: 
                   1107:     my $Connection = LondConnection->new(&GetServerHost(),
                   1108: 					 &GetServerPort());
                   1109: 
1.30      foxr     1110:     if($Connection eq undef) {	# Needs to be more robust later.
1.9       foxr     1111: 	Log("CRITICAL","Failed to make a connection with lond.");
1.10      foxr     1112: 	$ConnectionRetriesLeft--;
                   1113: 	return 0;		# Failure.
1.5       foxr     1114:     }  else {
1.22      foxr     1115: 
1.5       foxr     1116: 	# The connection needs to have writability 
                   1117: 	# monitored in order to send the init sequence
                   1118: 	# that starts the whole authentication/key
                   1119: 	# exchange underway.
                   1120: 	#
                   1121: 	my $Socket = $Connection->GetSocket();
1.30      foxr     1122: 	if($Socket eq undef) {
1.5       foxr     1123: 	    die "did not get a socket from the connection";
                   1124: 	} else {
                   1125: 	    &Debug(9,"MakeLondConnection got socket: ".$Socket);
                   1126: 	}
1.1       foxr     1127: 	
1.21      foxr     1128: 	$Connection->SetTimeoutCallback(\&SocketTimeout);
                   1129: 
1.23      foxr     1130: 	my $event = Event->io(fd       => $Socket,
1.5       foxr     1131: 			   poll     => 'w',
                   1132: 			   cb       => \&LondWritable,
1.8       foxr     1133: 			   data     => $Connection,
1.5       foxr     1134: 			   desc => 'Connection to lond server');
                   1135: 	$ActiveConnections{$Connection} = $event;
                   1136: 	
                   1137: 	$ConnectionCount++;
1.8       foxr     1138: 	Debug(4, "Connection count = ".$ConnectionCount);
1.6       foxr     1139: 	if($ConnectionCount == 1) { # First Connection:
                   1140: 	    QueueDelayed;
                   1141: 	}
1.9       foxr     1142: 	Log("SUCESS", "Created connection ".$ConnectionCount
                   1143: 	    ." to host ".GetServerHost());
1.10      foxr     1144: 	return 1;		# Return success.
1.1       foxr     1145:     }
                   1146:     
                   1147: }
1.3       albertel 1148: 
1.1       foxr     1149: =pod
1.3       albertel 1150: 
1.1       foxr     1151: =head2 StartRequest
1.3       albertel 1152: 
                   1153: Starts a lond request going on a specified lond connection.
                   1154: parameters are:
                   1155: 
                   1156: =item $Lond
                   1157: 
                   1158: Connection to the lond that will send the transaction and receive the
                   1159: reply.
                   1160: 
                   1161: =item $Client
                   1162: 
                   1163: Connection to the client that is making this request We got the
                   1164: request from this socket, and when the request has been relayed to
                   1165: lond and we get a reply back from lond it will get sent to this
                   1166: socket.
                   1167: 
                   1168: =item $Request
                   1169: 
                   1170: The text of the request to send.
                   1171: 
1.1       foxr     1172: =cut
                   1173: 
                   1174: sub StartRequest {
                   1175:     my $Lond     = shift;
1.7       foxr     1176:     my $Request  = shift;	# This is a LondTransaction.
1.1       foxr     1177:     
1.7       foxr     1178:     Debug(6, "StartRequest: ".$Request->getRequest());
1.1       foxr     1179: 
                   1180:     my $Socket = $Lond->GetSocket();
                   1181:     
1.7       foxr     1182:     $Request->Activate($Lond);
                   1183:     $ActiveTransactions{$Lond} = $Request;
1.1       foxr     1184: 
1.7       foxr     1185:     $Lond->InitiateTransaction($Request->getRequest());
1.23      foxr     1186:     my $event = Event->io(fd      => $Socket,
1.1       foxr     1187: 		       poll    => "w",
                   1188: 		       cb      => \&LondWritable,
                   1189: 		       data    => $Lond,
                   1190: 		       desc    => "lond transaction connection");
                   1191:     $ActiveConnections{$Lond} = $event;
                   1192:     Debug(8," Start Request made watcher data with ".$event->data."\n");
                   1193: }
                   1194: 
                   1195: =pod
1.3       albertel 1196: 
1.1       foxr     1197: =head2 QueueTransaction
1.3       albertel 1198: 
                   1199: If there is an idle lond connection, it is put to work doing this
                   1200: transaction.  Otherwise, the transaction is placed in the work queue.
                   1201: If placed in the work queue and the maximum number of connections has
                   1202: not yet been created, a new connection will be started.  Our goal is
                   1203: to eventually have a sufficient number of connections that the work
                   1204: queue will typically be empty.  parameters are:
                   1205: 
                   1206: =item Socket
                   1207: 
                   1208: open on the lonc client.
                   1209: 
                   1210: =item Request
                   1211: 
                   1212: data to send to the lond.
1.1       foxr     1213: 
                   1214: =cut
1.3       albertel 1215: 
1.1       foxr     1216: sub QueueTransaction {
                   1217: 
1.7       foxr     1218:     my $requestData   = shift;	# This is a LondTransaction.
                   1219:     my $cmd           = $requestData->getRequest();
                   1220: 
                   1221:     Debug(6,"QueueTransaction: ".$cmd);
1.1       foxr     1222: 
                   1223:     my $LondSocket    = $IdleConnections->pop();
                   1224:     if(!defined $LondSocket) {	# Need to queue request.
1.29      foxr     1225: 	Debug(5,"Must queue...");
1.1       foxr     1226: 	$WorkQueue->enqueue($requestData);
                   1227: 	if($ConnectionCount < $MaxConnectionCount) {
1.22      foxr     1228: 	    if($ConnectionRetriesLeft > 0) {
1.29      foxr     1229: 		Debug(5,"Starting additional lond connection");
1.22      foxr     1230: 		if(MakeLondConnection() == 0) {
                   1231: 		    EmptyQueue();	# Fail transactions, can't make connection.
                   1232: 		}
                   1233: 	    } else {
                   1234: 		ShowStatus(GetServerHost()." >>> DEAD !!!! <<<");
                   1235: 		EmptyQueue();	# It's worse than that ... he's dead Jim.
1.17      foxr     1236: 	    }
1.1       foxr     1237: 	}
                   1238:     } else {			# Can start the request:
                   1239: 	Debug(8,"Can start...");
1.7       foxr     1240: 	StartRequest($LondSocket,  $requestData);
1.1       foxr     1241:     }
                   1242: }
                   1243: 
                   1244: #-------------------------- Lonc UNIX socket handling ---------------------
1.3       albertel 1245: 
1.1       foxr     1246: =pod
1.3       albertel 1247: 
1.1       foxr     1248: =head2 ClientRequest
1.3       albertel 1249: Callback that is called when data can be read from the UNIX domain
                   1250: socket connecting us with an apache server process.
1.1       foxr     1251: 
                   1252: =cut
                   1253: 
                   1254: sub ClientRequest {
                   1255:     Debug(6, "ClientRequest");
                   1256:     my $event   = shift;
                   1257:     my $watcher = $event->w;
                   1258:     my $socket  = $watcher->fd;
                   1259:     my $data    = $watcher->data;
                   1260:     my $thisread;
                   1261: 
                   1262:     Debug(9, "  Watcher named: ".$watcher->desc);
                   1263: 
                   1264:     my $rv = $socket->recv($thisread, POSIX::BUFSIZ, 0);
                   1265:     Debug(8, "rcv:  data length = ".length($thisread)
                   1266: 	  ." read =".$thisread);
1.29      foxr     1267:     unless (defined $rv  && length($thisread)) {
1.1       foxr     1268: 	 # Likely eof on socket.
                   1269: 	Debug(5,"Client Socket closed on lonc for ".$RemoteHost);
                   1270: 	close($socket);
                   1271: 	$watcher->cancel();
                   1272: 	delete($ActiveClients{$socket});
1.10      foxr     1273: 	return;
1.1       foxr     1274:     }
                   1275:     Debug(8,"Data: ".$data." this read: ".$thisread);
                   1276:     $data = $data.$thisread;	# Append new data.
                   1277:     $watcher->data($data);
                   1278:     if($data =~ /(.*\n)/) {	# Request entirely read.
1.10      foxr     1279: 	if($data eq "close_connection_exit\n") {
1.9       foxr     1280: 	    Log("CRITICAL",
                   1281: 		"Request Close Connection ... exiting");
                   1282: 	    CloseAllLondConnections();
                   1283: 	    exit;
                   1284: 	}
1.1       foxr     1285: 	Debug(8, "Complete transaction received: ".$data);
1.39      foxr     1286: 	if($LogTransactions) {
                   1287: 	    Log("SUCCESS", "Transaction: '$data'"); # Transaction has \n.
                   1288: 	}
1.8       foxr     1289: 	my $Transaction = LondTransaction->new($data);
1.7       foxr     1290: 	$Transaction->SetClient($socket);
                   1291: 	QueueTransaction($Transaction);
1.1       foxr     1292: 	$watcher->cancel();	# Done looking for input data.
                   1293:     }
                   1294: 
                   1295: }
                   1296: 
                   1297: 
                   1298: =pod
1.3       albertel 1299: 
1.1       foxr     1300: =head2  NewClient
1.3       albertel 1301: 
                   1302: Callback that is called when a connection is received on the unix
                   1303: socket for a new client of lonc.  The callback is parameterized by the
                   1304: event.. which is a-priori assumed to be an io event, and therefore has
                   1305: an fd member that is the Listener socket.  We Accept the connection
                   1306: and register a new event on the readability of that socket:
                   1307: 
1.1       foxr     1308: =cut
1.3       albertel 1309: 
1.1       foxr     1310: sub NewClient {
                   1311:     Debug(6, "NewClient");
                   1312:     my $event      = shift;		# Get the event parameters.
                   1313:     my $watcher    = $event->w; 
                   1314:     my $socket     = $watcher->fd;	# Get the event' socket.
                   1315:     my $connection = $socket->accept();	# Accept the client connection.
                   1316:     Debug(8,"Connection request accepted from "
                   1317: 	  .GetPeername($connection, AF_UNIX));
                   1318: 
                   1319: 
                   1320:     my $description = sprintf("Connection to lonc client %d",
                   1321: 			      $ClientConnection);
                   1322:     Debug(9, "Creating event named: ".$description);
                   1323:     Event->io(cb      => \&ClientRequest,
                   1324: 	      poll    => 'r',
                   1325: 	      desc    => $description,
                   1326: 	      data    => "",
                   1327: 	      fd      => $connection);
                   1328:     $ActiveClients{$connection} = $ClientConnection;
                   1329:     $ClientConnection++;
                   1330: }
1.3       albertel 1331: 
                   1332: =pod
                   1333: 
                   1334: =head2 GetLoncSocketPath
                   1335: 
                   1336: Returns the name of the UNIX socket on which to listen for client
                   1337: connections.
1.1       foxr     1338: 
                   1339: =cut
1.3       albertel 1340: 
1.1       foxr     1341: sub GetLoncSocketPath {
                   1342:     return $UnixSocketDir."/".GetServerHost();
                   1343: }
                   1344: 
1.3       albertel 1345: =pod
                   1346: 
                   1347: =head2 GetServerHost
                   1348: 
                   1349: Returns the host whose lond we talk with.
                   1350: 
1.1       foxr     1351: =cut
1.3       albertel 1352: 
1.7       foxr     1353: sub GetServerHost {
1.1       foxr     1354:     return $RemoteHost;		# Setup by the fork.
                   1355: }
1.3       albertel 1356: 
                   1357: =pod
                   1358: 
                   1359: =head2 GetServerPort
                   1360: 
                   1361: Returns the lond port number.
                   1362: 
1.1       foxr     1363: =cut
1.3       albertel 1364: 
1.7       foxr     1365: sub GetServerPort {
1.1       foxr     1366:     return $perlvar{londPort};
                   1367: }
1.3       albertel 1368: 
                   1369: =pod
                   1370: 
                   1371: =head2 SetupLoncListener
                   1372: 
                   1373: Setup a lonc listener event.  The event is called when the socket
                   1374: becomes readable.. that corresponds to the receipt of a new
                   1375: connection.  The event handler established will accept the connection
                   1376: (creating a communcations channel), that int turn will establish
                   1377: another event handler to subess requests.
1.1       foxr     1378: 
                   1379: =cut
1.3       albertel 1380: 
1.1       foxr     1381: sub SetupLoncListener {
                   1382: 
                   1383:     my $socket;
                   1384:     my $SocketName = GetLoncSocketPath();
                   1385:     unlink($SocketName);
1.7       foxr     1386:     unless ($socket =IO::Socket::UNIX->new(Local  => $SocketName,
1.1       foxr     1387: 					    Listen => 10, 
                   1388: 					    Type   => SOCK_STREAM)) {
                   1389: 	die "Failed to create a lonc listner socket";
                   1390:     }
                   1391:     Event->io(cb     => \&NewClient,
                   1392: 	      poll   => 'r',
                   1393: 	      desc   => 'Lonc listener Unix Socket',
                   1394: 	      fd     => $socket);
                   1395: }
                   1396: 
1.39      foxr     1397: #
                   1398: #   Toggle transaction logging.
                   1399: #  Implicit inputs:  
                   1400: #     LogTransactions
                   1401: #  Implicit Outputs:
                   1402: #     LogTransactions
                   1403: sub ToggleTransactionLogging {
                   1404:     print STDERR "Toggle transaction logging...\n";
                   1405:     if(!$LogTransactions) {
                   1406: 	$LogTransactions = 1;
                   1407:     } else {
                   1408: 	$LogTransactions = 0;
                   1409:     }
                   1410: 
                   1411: 
                   1412:     Log("SUCCESS", "Toggled transaction logging: $LogTransactions \n");
                   1413: }
                   1414: 
1.14      foxr     1415: =pod 
                   1416: 
                   1417: =head2 ChildStatus
                   1418:  
                   1419: Child USR1 signal handler to report the most recent status
                   1420: into the status file.
                   1421: 
1.22      foxr     1422: We also use this to reset the retries count in order to allow the
                   1423: client to retry connections with a previously dead server.
1.14      foxr     1424: =cut
                   1425: sub ChildStatus {
                   1426:     my $event = shift;
                   1427:     my $watcher = $event->w;
                   1428: 
                   1429:     Debug(2, "Reporting child status because : ".$watcher->data);
                   1430:     my $docdir = $perlvar{'lonDocRoot'};
                   1431:     my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt");
                   1432:     print $fh $$."\t".$RemoteHost."\t".$Status."\t".
                   1433: 	$RecentLogEntry."\n";
1.38      foxr     1434:     #
                   1435:     #  Write out information about each of the connections:
                   1436:     #
                   1437:     print $fh "Active connection statuses: \n";
                   1438:     my $i = 1;
                   1439:     print STDERR  "================================= Socket Status Dump:\n";
                   1440:     foreach my $item (keys %ActiveConnections) {
                   1441: 	my $Socket = $ActiveConnections{$item}->data;
                   1442: 	my $state  = $Socket->GetState();
                   1443: 	print $fh "Connection $i State: $state\n";
                   1444: 	print STDERR "---------------------- Connection $i \n";
                   1445: 	$Socket->Dump();
                   1446: 	$i++;	
                   1447:     }
1.22      foxr     1448:     $ConnectionRetriesLeft = $ConnectionRetries;
1.14      foxr     1449: }
                   1450: 
1.1       foxr     1451: =pod
1.3       albertel 1452: 
1.10      foxr     1453: =head2 SignalledToDeath
                   1454: 
                   1455: Called in response to a signal that causes a chid process to die.
                   1456: 
                   1457: =cut
                   1458: 
                   1459: 
                   1460: sub SignalledToDeath {
1.14      foxr     1461:     my $event  = shift;
                   1462:     my $watcher= $event->w;
                   1463: 
                   1464:     Debug(2,"Signalled to death! via ".$watcher->data);
1.17      foxr     1465:     my ($signal) = $watcher->data;
1.10      foxr     1466:     chomp($signal);
                   1467:     Log("CRITICAL", "Abnormal exit.  Child $$ for $RemoteHost "
                   1468: 	."died through "."\"$signal\"");
                   1469:     LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "
                   1470: 	    ."\"$signal\"");
1.12      foxr     1471:     exit 0;
1.10      foxr     1472: 
                   1473: }
1.16      foxr     1474: 
                   1475: =head2 ToggleDebug
                   1476: 
                   1477: This sub toggles trace debugging on and off.
                   1478: 
                   1479: =cut
                   1480: 
                   1481: sub ToggleDebug {
                   1482:     my $Current    = $DebugLevel;
                   1483:        $DebugLevel = $NextDebugLevel;
                   1484:        $NextDebugLevel = $Current;
                   1485: 
                   1486:     Log("SUCCESS", "New debugging level for $RemoteHost now $DebugLevel");
                   1487: 
                   1488: }
                   1489: 
1.1       foxr     1490: =head2 ChildProcess
                   1491: 
                   1492: This sub implements a child process for a single lonc daemon.
                   1493: 
                   1494: =cut
                   1495: 
                   1496: sub ChildProcess {
                   1497: 
                   1498: 
1.14      foxr     1499:     #
                   1500:     #  Signals must be handled by the Event framework...
                   1501: #
                   1502: 
                   1503:     Event->signal(signal   => "QUIT",
                   1504: 		  cb       => \&SignalledToDeath,
                   1505: 		  data     => "QUIT");
                   1506:     Event->signal(signal   => "HUP",
                   1507: 		  cb       => \&ChildStatus,
                   1508: 		  data     => "HUP");
                   1509:     Event->signal(signal   => "USR1",
                   1510: 		  cb       => \&ChildStatus,
                   1511: 		  data     => "USR1");
1.39      foxr     1512:     Event->signal(signal   => "USR2",
                   1513: 		  cb       => \&ToggleTransactionLogging);
1.16      foxr     1514:     Event->signal(signal   => "INT",
                   1515: 		  cb       => \&ToggleDebug,
                   1516: 		  data     => "INT");
1.1       foxr     1517: 
                   1518:     SetupTimer();
                   1519:     
                   1520:     SetupLoncListener();
                   1521:     
                   1522:     $Event::Debuglevel = $DebugLevel;
                   1523:     
                   1524:     Debug(9, "Making initial lond connection for ".$RemoteHost);
                   1525: 
                   1526: # Setup the initial server connection:
                   1527:     
1.14      foxr     1528:      # &MakeLondConnection(); // let first work requirest do it.
1.10      foxr     1529: 
1.5       foxr     1530: 
1.1       foxr     1531:     Debug(9,"Entering event loop");
                   1532:     my $ret = Event::loop();		#  Start the main event loop.
                   1533:     
                   1534:     
                   1535:     die "Main event loop exited!!!";
                   1536: }
                   1537: 
                   1538: #  Create a new child for host passed in:
                   1539: 
                   1540: sub CreateChild {
1.12      foxr     1541:     my $sigset = POSIX::SigSet->new(SIGINT);
                   1542:     sigprocmask(SIG_BLOCK, $sigset);
1.1       foxr     1543:     my $host = shift;
                   1544:     $RemoteHost = $host;
1.9       foxr     1545:     Log("CRITICAL", "Forking server for ".$host);
1.23      foxr     1546:     my $pid          = fork;
1.1       foxr     1547:     if($pid) {			# Parent
1.17      foxr     1548: 	$RemoteHost = "Parent";
1.27      foxr     1549: 	$ChildHash{$pid} = $host;
1.26      foxr     1550: 	$HostToPid{$host}= $pid;
1.12      foxr     1551: 	sigprocmask(SIG_UNBLOCK, $sigset);
                   1552: 
1.1       foxr     1553:     } else {			# child.
1.5       foxr     1554: 	ShowStatus("Connected to ".$RemoteHost);
1.23      foxr     1555: 	$SIG{INT} = 'DEFAULT';
1.12      foxr     1556: 	sigprocmask(SIG_UNBLOCK, $sigset);
                   1557: 	ChildProcess;		# Does not return.
1.1       foxr     1558:     }
                   1559: 
                   1560: }
                   1561: #
                   1562: #  Parent process logic pass 1:
                   1563: #   For each entry in the hosts table, we will
                   1564: #  fork off an instance of ChildProcess to service the transactions
                   1565: #  to that host.  Each pid will be entered in a global hash
                   1566: #  with the value of the key, the host.
                   1567: #  The parent will then enter a loop to wait for process exits.
                   1568: #  Each exit gets logged and the child gets restarted.
                   1569: #
                   1570: 
1.5       foxr     1571: #
                   1572: #   Fork and start in new session so hang-up isn't going to 
                   1573: #   happen without intent.
                   1574: #
                   1575: 
                   1576: 
1.6       foxr     1577: 
                   1578: 
1.8       foxr     1579: 
1.6       foxr     1580: 
                   1581: ShowStatus("Forming new session");
                   1582: my $childpid = fork;
                   1583: if ($childpid != 0) {
                   1584:     sleep 4;			# Give child a chacne to break to
                   1585:     exit 0;			# a new sesion.
                   1586: }
1.8       foxr     1587: #
                   1588: #   Write my pid into the pid file so I can be located
                   1589: #
                   1590: 
                   1591: ShowStatus("Parent writing pid file:");
1.23      foxr     1592: my $execdir = $perlvar{'lonDaemons'};
1.8       foxr     1593: open (PIDSAVE, ">$execdir/logs/lonc.pid");
                   1594: print PIDSAVE "$$\n";
                   1595: close(PIDSAVE);
1.6       foxr     1596: 
1.17      foxr     1597: 
                   1598: 
1.6       foxr     1599: if (POSIX::setsid() < 0) {
                   1600:     print "Could not create new session\n";
                   1601:     exit -1;
                   1602: }
1.5       foxr     1603: 
                   1604: ShowStatus("Forking node servers");
                   1605: 
1.9       foxr     1606: Log("CRITICAL", "--------------- Starting children ---------------");
                   1607: 
1.31      foxr     1608: LondConnection::ReadConfig;               # Read standard config files.
1.1       foxr     1609: my $HostIterator = LondConnection::GetHostIterator;
                   1610: while (! $HostIterator->end()) {
                   1611: 
1.23      foxr     1612:     my $hostentryref = $HostIterator->get();
1.1       foxr     1613:     CreateChild($hostentryref->[0]);
1.26      foxr     1614:     $HostHash{$hostentryref->[0]} = $hostentryref->[4];
1.1       foxr     1615:     $HostIterator->next();
                   1616: }
1.12      foxr     1617: $RemoteHost = "Parent Server";
1.1       foxr     1618: 
                   1619: # Maintain the population:
1.5       foxr     1620: 
                   1621: ShowStatus("Parent keeping the flock");
1.1       foxr     1622: 
1.10      foxr     1623: #
                   1624: #   Set up parent signals:
                   1625: #
1.12      foxr     1626: 
1.14      foxr     1627: $SIG{INT}  = \&Terminate;
                   1628: $SIG{TERM} = \&Terminate; 
1.13      foxr     1629: $SIG{HUP}  = \&Restart;
1.14      foxr     1630: $SIG{USR1} = \&CheckKids; 
1.24      foxr     1631: $SIG{USR2} = \&UpdateKids;	# LonManage update request.
1.10      foxr     1632: 
1.1       foxr     1633: while(1) {
1.23      foxr     1634:     my $deadchild = wait();
1.1       foxr     1635:     if(exists $ChildHash{$deadchild}) {	# need to restart.
1.23      foxr     1636: 	my $deadhost = $ChildHash{$deadchild};
1.26      foxr     1637: 	delete($HostToPid{$deadhost});
1.1       foxr     1638: 	delete($ChildHash{$deadchild});
1.9       foxr     1639: 	Log("WARNING","Lost child pid= ".$deadchild.
1.1       foxr     1640: 	      "Connected to host ".$deadhost);
1.9       foxr     1641: 	Log("INFO", "Restarting child procesing ".$deadhost);
1.1       foxr     1642: 	CreateChild($deadhost);
                   1643:     }
1.13      foxr     1644: }
                   1645: 
1.14      foxr     1646: 
                   1647: 
                   1648: =pod
                   1649: 
                   1650: =head1 CheckKids
                   1651: 
                   1652:   Since kids do not die as easily in this implementation
                   1653: as the previous one, there  is no need to restart the
                   1654: dead ones (all dead kids get restarted when they die!!)
                   1655: The only thing this function does is to pass USR1 to the
                   1656: kids so that they report their status.
                   1657: 
                   1658: =cut
                   1659: 
                   1660: sub CheckKids {
                   1661:     Debug(2, "Checking status of children");
                   1662:     my $docdir = $perlvar{'lonDocRoot'};
                   1663:     my $fh = IO::File->new(">$docdir/lon-status/loncstatus.txt");
                   1664:     my $now=time;
                   1665:     my $local=localtime($now);
                   1666:     print $fh "LONC status $local - parent $$ \n\n";
1.23      foxr     1667:     foreach my $pid (keys %ChildHash) {
1.14      foxr     1668: 	Debug(2, "Sending USR1 -> $pid");
                   1669: 	kill 'USR1' => $pid;	# Tell Child to report status.
                   1670: 	sleep 1;		# Wait so file doesn't intermix.
                   1671:     }
                   1672: }
1.24      foxr     1673: 
                   1674: =pod
                   1675: 
                   1676: =head1  UpdateKids
                   1677: 
1.25      foxr     1678: parent's SIGUSR2 handler.  This handler:
1.24      foxr     1679: 
                   1680: =item
                   1681: 
                   1682: Rereads the hosts file.
                   1683: 
                   1684: =item
                   1685:  
                   1686: Kills off (via sigint) children for hosts that have disappeared.
                   1687: 
                   1688: =item
                   1689: 
1.27      foxr     1690: QUITs  children for hosts that already exist (this just forces a status display
1.24      foxr     1691: and resets the connection retry count for that host.
                   1692: 
                   1693: =item
                   1694: 
                   1695: Starts new children for hosts that have been added to the hosts.tab file since
                   1696: the start of the master program and maintains them.
                   1697: 
                   1698: =cut
                   1699: 
                   1700: sub UpdateKids {
1.27      foxr     1701: 
1.25      foxr     1702:     Log("INFO", "Updating connections via SIGUSR2");
1.27      foxr     1703: 
                   1704:     #  Just in case we need to kill our own lonc, we wait a few seconds to
                   1705:     #  give it a chance to receive and relay lond's response to the 
                   1706:     #  re-init command.
                   1707:     #
                   1708: 
                   1709:     sleep(2);			# Wait a couple of seconds.
                   1710: 
                   1711:     my %hosts;                   # Indexed by loncapa hostname, value=ip.
                   1712:     
                   1713:     # Need to re-read  the host table:
                   1714:     
                   1715:     
                   1716:     LondConnection::ReadConfig();
                   1717:     my $I = LondConnection::GetHostIterator;
                   1718:     while (! $I->end()) {
                   1719: 	my $item = $I->get();
                   1720: 	$hosts{$item->[0]} = $item->[4];
                   1721: 	$I->next();
                   1722:     }
                   1723: 
                   1724:     #  The logic below is written for clarity not for efficiency.
                   1725:     #  Since I anticipate that this function is only rarely called, that's
                   1726:     #  appropriate.  There are certainly ways to combine the loops below,
                   1727:     #  and anyone wishing to obscure the logic is welcome to go for it.
                   1728:     #  Note that we don't re-direct sigchild.  Instead we do what's needed
                   1729:     #  to the data structures that keep track of children to ensure that
                   1730:     #  when sigchild is honored, no new child is born.
                   1731:     #
                   1732: 
                   1733:     #  For each existing child; if it's host doesn't exist, kill the child.
                   1734: 
                   1735:     foreach my $child (keys %ChildHash) {
                   1736: 	my $oldhost = $ChildHash{$child};
                   1737: 	if (!(exists $hosts{$oldhost})) {
                   1738: 	    Log("CRITICAL", "Killing child for $oldhost  host no longer exists");
                   1739: 	    delete $ChildHash{$child};
                   1740: 	    delete $HostToPid{$oldhost};
                   1741: 	    kill 'QUIT' => $child;
                   1742: 	}
                   1743:     }
                   1744:     # For each remaining existing child; if it's host's ip has changed,
                   1745:     # Restart the child on the new IP.
                   1746: 
                   1747:     foreach my $child (keys %ChildHash) {
                   1748: 	my $oldhost = $ChildHash{$child};
                   1749: 	my $oldip   = $HostHash{$oldhost};
                   1750: 	if ($hosts{$oldhost} ne $oldip) {
                   1751: 
                   1752: 	    # kill the old child.
                   1753: 
                   1754: 	    Log("CRITICAL", "Killing child for $oldhost host ip has changed...");
                   1755: 	    delete $ChildHash{$child};
                   1756: 	    delete $HostToPid{$oldhost};
                   1757: 	    kill 'QUIT' => $child;
                   1758: 
                   1759: 	    # Do the book-keeping needed to start a new child on the
                   1760: 	    # new ip.
                   1761: 
                   1762: 	    $HostHash{$oldhost} = $hosts{$oldhost};
                   1763: 	    CreateChild($oldhost);
                   1764: 	}
                   1765:     }
                   1766:     # Finally, for each new host, not in the host hash, create a
                   1767:     # enter the host and create a new child.
                   1768:     # Force a status display of any existing process.
                   1769: 
                   1770:     foreach my $host (keys %hosts) {
                   1771: 	if(!(exists $HostHash{$host})) {
                   1772: 	    Log("INFO", "New host $host discovered in hosts.tab...");
                   1773: 	    $HostHash{$host} = $hosts{$host};
                   1774: 	    CreateChild($host);
                   1775: 	} else {
                   1776: 	    kill 'HUP' => $HostToPid{$host};    # status display.
                   1777: 	}
                   1778:     }
1.24      foxr     1779: }
                   1780: 
1.14      foxr     1781: 
1.13      foxr     1782: =pod
                   1783: 
                   1784: =head1 Restart
                   1785: 
                   1786: Signal handler for HUP... all children are killed and
                   1787: we self restart.  This is an el-cheapo way to re read
                   1788: the config file.
                   1789: 
                   1790: =cut
                   1791: 
                   1792: sub Restart {
1.23      foxr     1793:     &KillThemAll;		# First kill all the children.
1.13      foxr     1794:     Log("CRITICAL", "Restarting");
                   1795:     my $execdir = $perlvar{'lonDaemons'};
                   1796:     unlink("$execdir/logs/lonc.pid");
1.28      albertel 1797:     exec("$execdir/loncnew");
1.10      foxr     1798: }
1.12      foxr     1799: 
                   1800: =pod
                   1801: 
                   1802: =head1 KillThemAll
                   1803: 
                   1804: Signal handler that kills all children by sending them a 
1.17      foxr     1805: SIGHUP.  Responds to sigint and sigterm.
1.12      foxr     1806: 
                   1807: =cut
                   1808: 
1.10      foxr     1809: sub KillThemAll {
1.12      foxr     1810:     Debug(2, "Kill them all!!");
                   1811:     local($SIG{CHLD}) = 'IGNORE';      # Our children >will< die.
1.23      foxr     1812:     foreach my $pid (keys %ChildHash) {
1.12      foxr     1813: 	my $serving = $ChildHash{$pid};
                   1814: 	Debug(2, "Killing lonc for $serving pid = $pid");
                   1815: 	ShowStatus("Killing lonc for $serving pid = $pid");
                   1816: 	Log("CRITICAL", "Killing lonc for $serving pid = $pid");
1.17      foxr     1817: 	kill 'QUIT' => $pid;
                   1818: 	delete($ChildHash{$pid});
1.12      foxr     1819:     }
1.14      foxr     1820:     my $execdir = $perlvar{'lonDaemons'};
                   1821:     unlink("$execdir/logs/lonc.pid");
1.17      foxr     1822: 
1.1       foxr     1823: }
1.12      foxr     1824: 
1.14      foxr     1825: =pod
                   1826: 
                   1827: =head1 Terminate
                   1828:  
                   1829: Terminate the system.
                   1830: 
                   1831: =cut
                   1832: 
                   1833: sub Terminate {
                   1834:     KillThemAll;
1.17      foxr     1835:     Log("CRITICAL","Master process exiting");
                   1836:     exit 0;
1.14      foxr     1837: 
                   1838: }
1.12      foxr     1839: =pod
1.1       foxr     1840: 
                   1841: =head1 Theory
1.3       albertel 1842: 
                   1843: The event class is used to build this as a single process with an
                   1844: event driven model.  The following events are handled:
1.1       foxr     1845: 
                   1846: =item UNIX Socket connection Received
                   1847: 
                   1848: =item Request data arrives on UNIX data transfer socket.
                   1849: 
                   1850: =item lond connection becomes writable.
                   1851: 
                   1852: =item timer fires at 1 second intervals.
                   1853: 
                   1854: All sockets are run in non-blocking mode.  Timeouts managed by the timer
                   1855: handler prevents hung connections.
                   1856: 
                   1857: Key data structures:
                   1858: 
1.3       albertel 1859: =item RequestQueue
                   1860: 
                   1861: A queue of requests received from UNIX sockets that are
                   1862: waiting for a chance to be forwarded on a lond connection socket.
                   1863: 
                   1864: =item ActiveConnections
                   1865: 
                   1866: A hash of lond connections that have transactions in process that are
                   1867: available to be timed out.
                   1868: 
                   1869: =item ActiveTransactions
                   1870: 
                   1871: A hash indexed by lond connections that contain the client reply
                   1872: socket for each connection that has an active transaction on it.
                   1873: 
                   1874: =item IdleConnections
                   1875: 
                   1876: A hash of lond connections that have no work to do.  These connections
                   1877: can be closed if they are idle for a long enough time.
1.1       foxr     1878: 
                   1879: =cut

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