Annotation of loncom/loncnew, revision 1.31

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

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