Annotation of loncom/loncnew, revision 1.21

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

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