--- loncom/loncnew 2003/04/18 03:10:36 1.3
+++ loncom/loncnew 2005/01/19 21:38:25 1.57.2.1
@@ -2,13 +2,12 @@
# The LearningOnline Network with CAPA
# lonc maintains the connections to remote computers
#
-# $Id: loncnew,v 1.3 2003/04/18 03:10:36 albertel Exp $
+# $Id: loncnew,v 1.57.2.1 2005/01/19 21:38:25 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
-#
-# LON-CAPA is free software; you can redistribute it and/or modify
+## LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
@@ -27,47 +26,42 @@
# http://www.lon-capa.org/
#
#
-# new lonc handles n requestors spread out bver m connections to londs.
+# new lonc handles n request out bver m connections to londs.
# This module is based on the Event class.
# Development iterations:
# - Setup basic event loop. (done)
# - Add timer dispatch. (done)
# - Add ability to accept lonc UNIX domain sockets. (done)
# - Add ability to create/negotiate lond connections (done).
-# - Add general logic for dispatching requests and timeouts.
-# - Add support for the lonc/lond requests.
-# - Add logging/status monitoring.
-# - Add Signal handling - HUP restarts. USR1 status report.
-# - Add Configuration file I/O
-# - Add Pending request processing on startup.
-# - Add management/status request interface.
+# - Add general logic for dispatching requests and timeouts. (done).
+# - Add support for the lonc/lond requests. (done).
+# - Add logging/status monitoring. (done)
+# - Add Signal handling - HUP restarts. USR1 status report. (done)
+# - Add Configuration file I/O (done).
+# - Add management/status request interface. (done)
+# - Add deferred request capability. (done)
+# - Detect transmission timeouts. (done)
+#
+use strict;
use lib "/home/httpd/lib/perl/";
-use lib "/home/foxr/newloncapa/types";
use Event qw(:DEFAULT );
use POSIX qw(:signal_h);
+use POSIX;
use IO::Socket;
use IO::Socket::INET;
use IO::Socket::UNIX;
+use IO::File;
+use IO::Handle;
use Socket;
use Crypt::IDEA;
use LONCAPA::Queue;
use LONCAPA::Stack;
use LONCAPA::LondConnection;
+use LONCAPA::LondTransaction;
use LONCAPA::Configuration;
use LONCAPA::HashIterator;
-
-print "Loncnew starting\n";
-
-#
-# Disable all signals we might receive from outside for now.
-#
-$SIG{QUIT} = IGNORE;
-$SIG{HUP} = IGNORE;
-$SIG{USR1} = IGNORE;
-$SIG{INT} = IGNORE;
-$SIG{CHLD} = IGNORE;
-$SIG{__DIE__} = IGNORE;
+use Fcntl qw(:flock);
# Read the httpd configuration file to get perl variables
@@ -80,29 +74,134 @@ my %perlvar = %{$perlvarref};
# parent and shared variables.
my %ChildHash; # by pid -> host.
+my %HostToPid; # By host -> pid.
+my %HostHash; # by loncapaname -> IP.
-my $MaxConnectionCount = 5; # Will get from config later.
+my $MaxConnectionCount = 10; # Will get from config later.
my $ClientConnection = 0; # Uniquifier for client events.
-my $DebugLevel = 5;
-my $IdleTimeout= 3600; # Wait an hour before pruning connections.
+my $DebugLevel = 0;
+my $NextDebugLevel= 2; # So Sigint can toggle this.
+my $IdleTimeout= 600; # Wait 10 minutes before pruning connections.
+
+my $LogTransactions = 0; # When True, all transactions/replies get logged.
#
# The variables below are only used by the child processes.
#
my $RemoteHost; # Name of host child is talking to.
-my $UnixSocketDir= "/home/httpd/sockets";
+my $UnixSocketDir= $perlvar{'lonSockDir'};
my $IdleConnections = Stack->new(); # Set of idle connections
my %ActiveConnections; # Connections to the remote lond.
-my %ActiveTransactions; # Transactions in flight.
+my %ActiveTransactions; # LondTransactions in flight.
my %ActiveClients; # Serial numbers of active clients by socket.
my $WorkQueue = Queue->new(); # Queue of pending transactions.
-my $ClientQueue = Queue->new(); # Queue of clients causing xactinos.
my $ConnectionCount = 0;
+my $IdleSeconds = 0; # Number of seconds idle.
+my $Status = ""; # Current status string.
+my $RecentLogEntry = "";
+my $ConnectionRetries=2; # Number of connection retries allowed.
+my $ConnectionRetriesLeft=2; # Number of connection retries remaining.
+my $LondVersion = "unknown"; # Version of lond we talk with.
+my $KeyMode = ""; # e.g. ssl, local, insecure from last connect.
+my $LondConnecting = 0; # True when a connection is being built.
+my $DieWhenIdle = 0; # When true children die when trimmed -> 0.
#
+# The hash below gives the HTML format for log messages
+# given a severity.
+#
+my %LogFormats;
+
+$LogFormats{"CRITICAL"} = "CRITICAL: %s";
+$LogFormats{"SUCCESS"} = "SUCCESS: %s";
+$LogFormats{"INFO"} = "INFO: %s";
+$LogFormats{"WARNING"} = "WARNING: %s";
+$LogFormats{"DEFAULT"} = " %s ";
+
+
+# UpdateStatus;
+# Update the idle status display to show how many connections
+# are left, retries and other stuff.
+#
+sub UpdateStatus {
+ if ($ConnectionRetriesLeft > 0) {
+ ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount
+ ." Retries remaining: ".$ConnectionRetriesLeft
+ ." ($KeyMode)");
+ } else {
+ ShowStatus(GetServerHost()." >> DEAD <<");
+ }
+}
+
+
+=pod
+
+=head2 LogPerm
+
+Makes an entry into the permanent log file.
+
+=cut
+sub LogPerm {
+ my $message=shift;
+ my $execdir=$perlvar{'lonDaemons'};
+ my $now=time;
+ my $local=localtime($now);
+ my $fh=IO::File->new(">>$execdir/logs/lonnet.perm.log");
+ print $fh "$now:$message:$local\n";
+}
+
+=pod
+
+=head2 Log
+
+Logs a message to the log file.
+Parameters:
+
+=item severity
+
+One of CRITICAL, WARNING, INFO, SUCCESS used to select the
+format string used to format the message. if the severity is
+not a defined severity the Default format string is used.
+
+=item message
+
+The base message. In addtion to the format string, the message
+will be appended to a string containing the name of our remote
+host and the time will be formatted into the message.
+
+=cut
+
+sub Log {
+
+ my ($severity, $message) = @_;
+
+ if(!$LogFormats{$severity}) {
+ $severity = "DEFAULT";
+ }
+
+ my $format = $LogFormats{$severity};
+
+ # Put the window dressing in in front of the message format:
+
+ my $now = time;
+ my $local = localtime($now);
+ my $finalformat = "$local ($$) [$RemoteHost] [$Status] ";
+ my $finalformat = $finalformat.$format."\n";
+
+ # open the file and put the result.
+
+ my $execdir = $perlvar{'lonDaemons'};
+ my $fh = IO::File->new(">>$execdir/logs/lonc.log");
+ my $msg = sprintf($finalformat, $message);
+ $RecentLogEntry = $msg;
+ print $fh $msg;
+
+
+}
+
=pod
@@ -113,14 +212,16 @@ Returns the name of the host that a sock
=cut
sub GetPeername {
- my $connection = shift;
- my $AdrFamily = shift;
+
+
+ my ($connection, $AdrFamily) = @_;
+
my $peer = $connection->peername();
my $peerport;
my $peerip;
if($AdrFamily == AF_INET) {
($peerport, $peerip) = sockaddr_in($peer);
- my $peername = gethostbyaddr($iaddr, $AdrFamily);
+ my $peername = gethostbyaddr($peerip, $AdrFamily);
return $peername;
} elsif ($AdrFamily == AF_UNIX) {
my $peerfile;
@@ -128,7 +229,6 @@ sub GetPeername {
return $peerfile;
}
}
-#----------------------------- Timer management ------------------------
=pod
=head2 Debug
@@ -138,36 +238,153 @@ Invoked to issue a debug message.
=cut
sub Debug {
- my $level = shift;
- my $message = shift;
+
+ my ($level, $message) = @_;
+
if ($level <= $DebugLevel) {
- print $message." host = ".$RemoteHost."\n";
+ Log("INFO", "-Debug- $message host = $RemoteHost");
}
}
sub SocketDump {
- my $level = shift;
- my $socket= shift;
+
+ my ($level, $socket) = @_;
+
if($level <= $DebugLevel) {
- $socket->Dump();
+ $socket->Dump(-1); # Ensure it will get dumped.
}
}
=pod
+=head2 ShowStatus
+
+ Place some text as our pid status.
+ and as what we return in a SIGUSR1
+
+=cut
+sub ShowStatus {
+ my $state = shift;
+ my $now = time;
+ my $local = localtime($now);
+ $Status = $local.": ".$state;
+ $0='lonc: '.$state.' '.$local;
+}
+
+=pod
+
+=head 2 SocketTimeout
+
+ Called when an action on the socket times out. The socket is
+ destroyed and any active transaction is failed.
+
+
+=cut
+sub SocketTimeout {
+ my $Socket = shift;
+ Log("WARNING", "A socket timeout was detected");
+ Debug(5, " SocketTimeout called: ");
+ $Socket->Dump(0);
+ if(exists($ActiveTransactions{$Socket})) {
+ FailTransaction($ActiveTransactions{$Socket});
+ }
+ KillSocket($Socket); # A transaction timeout also counts as
+ # a connection failure:
+ $ConnectionRetriesLeft--;
+ if($ConnectionRetriesLeft <= 0) {
+ Log("CRITICAL", "Host marked DEAD: ".GetServerHost());
+ $LondConnecting = 0;
+ }
+
+}
+#----------------------------- Timer management ------------------------
+
+=pod
+
=head2 Tick
Invoked each timer tick.
=cut
+
sub Tick {
+ my ($Event) = @_;
+ my $clock_watcher = $Event->w;
+
my $client;
- Debug(6, "Tick");
- Debug(6, " Current connection count: ".$ConnectionCount);
- foreach $client (keys %ActiveClients) {
- Debug(7, " Have client: with id: ".$ActiveClients{$client});
+ UpdateStatus();
+
+ # Is it time to prune connection count:
+
+
+ if($IdleConnections->Count() &&
+ ($WorkQueue->Count() == 0)) { # Idle connections and nothing to do?
+ $IdleSeconds++;
+ if($IdleSeconds > $IdleTimeout) { # Prune a connection...
+ my $Socket = $IdleConnections->pop();
+ KillSocket($Socket);
+ $IdleSeconds = 0; # Otherwise all connections get trimmed to fast.
+ UpdateStatus();
+ if(($ConnectionCount == 0) && $DieWhenIdle) {
+ #
+ # Create a lock file since there will be a time window
+ # between our exit and the parent's picking up the listen
+ # during which no listens will be done on the
+ # lonnet client socket.
+ #
+ my $lock_file = GetLoncSocketPath().".lock";
+ open(LOCK,">$lock_file");
+ print LOCK "Contents not important";
+ close(LOCK);
+
+ exit(0);
+ }
+ }
+ } else {
+ $IdleSeconds = 0; # Reset idle count if not idle.
+ }
+ #
+ # For each inflight transaction, tick down its timeout counter.
+ #
+
+ foreach my $item (keys %ActiveConnections) {
+ my $State = $ActiveConnections{$item}->data->GetState();
+ if ($State ne 'Idle') {
+ Debug(5,"Ticking Socket $State $item");
+ $ActiveConnections{$item}->data->Tick();
+ }
}
+ # Do we have work in the queue, but no connections to service them?
+ # If so, try to make some new connections to get things going again.
+ #
+ # Note this code is dead now...
+ #
+ my $Requests = $WorkQueue->Count();
+ if (($ConnectionCount == 0) && ($Requests > 0) && (!$LondConnecting)) {
+ if ($ConnectionRetriesLeft > 0) {
+ Debug(5,"Work but no connections, Make a new one");
+ my $success;
+ $success = &MakeLondConnection;
+ if($success == 0) { # All connections failed:
+ Debug(5,"Work in queue failed to make any connectiouns\n");
+ EmptyQueue(); # Fail pending transactions with con_lost.
+ CloseAllLondConnections(); # Should all be closed but....
+ }
+ } else {
+ $LondConnecting = 0;
+ ShowStatus(GetServerHost()." >>> DEAD!!! <<<");
+ Debug(5,"Work in queue, but gave up on connections..flushing\n");
+ EmptyQueue(); # Connections can't be established.
+ CloseAllLondConnections(); # Should all already be closed but...
+ }
+
+ }
+ if ($ConnectionCount == 0) {
+ $KeyMode = "";
+ $clock_watcher->cancel();
+ }
+ &UpdateStatus();
}
=pod
@@ -188,7 +405,7 @@ Trigger disconnections of idle sockets.
sub SetupTimer {
Debug(6, "SetupTimer");
- Event->timer(interval => 1, debug => 1, cb => \&Tick );
+ Event->timer(interval => 1, cb => \&Tick );
}
=pod
@@ -208,24 +425,22 @@ long enough, it will be shut down and re
sub ServerToIdle {
my $Socket = shift; # Get the socket.
+ $KeyMode = $Socket->{AuthenticationMode};
+ delete($ActiveTransactions{$Socket}); # Server has no transaction
- &Debug(6, "Server to idle");
+ &Debug(5, "Server to idle");
# If there's work to do, start the transaction:
- $reqdata = $WorkQueue->dequeue();
- Debug(9, "Queue gave request data: ".$reqdata);
- unless($reqdata eq undef) {
- my $unixSocket = $ClientQueue->dequeue();
- &Debug(6, "Starting new work request");
- &Debug(7, "Request: ".$reqdata);
-
- &StartRequest($Socket, $unixSocket, $reqdata);
+ my $reqdata = $WorkQueue->dequeue(); # This is a LondTransaction
+ if ($reqdata ne undef) {
+ Debug(5, "Queue gave request data: ".$reqdata->getRequest());
+ &StartRequest($Socket, $reqdata);
+
} else {
# There's no work waiting, so push the server to idle list.
- &Debug(8, "No new work requests, server connection going idle");
- delete($ActiveTransactions{$Socket});
+ &Debug(5, "No new work requests, server connection going idle");
$IdleConnections->push($Socket);
}
}
@@ -260,51 +475,61 @@ sub ClientWritable {
&Debug(6, "ClientWritable writing".$Data);
&Debug(9, "Socket is: ".$Socket);
- my $result = $Socket->send($Data, 0);
-
- # $result undefined: the write failed.
- # otherwise $result is the number of bytes written.
- # Remove that preceding string from the data.
- # If the resulting data is empty, destroy the watcher
- # and set up a read event handler to accept the next
- # request.
-
- &Debug(9,"Send result is ".$result." Defined: ".defined($result));
- if(defined($result)) {
- &Debug(9, "send result was defined");
- if($result == length($Data)) { # Entire string sent.
- &Debug(9, "ClientWritable data all written");
- $Watcher->cancel();
- #
- # Set up to read next request from socket:
-
- my $descr = sprintf("Connection to lonc client %d",
- $ActiveClients{$Socket});
- Event->io(cb => \&ClientRequest,
- poll => 'r',
- desc => $descr,
- data => "",
- fd => $Socket);
-
- } else { # Partial string sent.
- $Watcher->data(substr($Data, $result));
- }
+ if($Socket->connected) {
+ my $result = $Socket->send($Data, 0);
- } else { # Error of some sort...
-
- # Some errnos are possible:
- my $errno = $!;
- if($errno == POSIX::EWOULDBLOCK ||
- $errno == POSIX::EAGAIN ||
- $errno == POSIX::EINTR) {
- # No action taken?
- } else { # Unanticipated errno.
- &Debug(5,"ClientWritable error or peer shutdown".$RemoteHost);
- $Watcher->cancel; # Stop the watcher.
- $Socket->shutdown(2); # Kill connection
- $Socket->close(); # Close the socket.
- }
+ # $result undefined: the write failed.
+ # otherwise $result is the number of bytes written.
+ # Remove that preceding string from the data.
+ # If the resulting data is empty, destroy the watcher
+ # and set up a read event handler to accept the next
+ # request.
+ &Debug(9,"Send result is ".$result." Defined: ".defined($result));
+ if($result ne undef) {
+ &Debug(9, "send result was defined");
+ if($result == length($Data)) { # Entire string sent.
+ &Debug(9, "ClientWritable data all written");
+ $Watcher->cancel();
+ #
+ # Set up to read next request from socket:
+
+ my $descr = sprintf("Connection to lonc client %d",
+ $ActiveClients{$Socket});
+ Event->io(cb => \&ClientRequest,
+ poll => 'r',
+ desc => $descr,
+ data => "",
+ fd => $Socket);
+
+ } else { # Partial string sent.
+ $Watcher->data(substr($Data, $result));
+ if($result == 0) { # client hung up on us!!
+ # Log("INFO", "lonc pipe client hung up on us!");
+ $Watcher->cancel;
+ $Socket->shutdown(2);
+ $Socket->close();
+ }
+ }
+
+ } else { # Error of some sort...
+
+ # Some errnos are possible:
+ my $errno = $!;
+ if($errno == POSIX::EWOULDBLOCK ||
+ $errno == POSIX::EAGAIN ||
+ $errno == POSIX::EINTR) {
+ # No action taken?
+ } else { # Unanticipated errno.
+ &Debug(5,"ClientWritable error or peer shutdown".$RemoteHost);
+ $Watcher->cancel; # Stop the watcher.
+ $Socket->shutdown(2); # Kill connection
+ $Socket->close(); # Close the socket.
+ }
+
+ }
+ } else {
+ $Watcher->cancel(); # A delayed request...just cancel.
}
}
@@ -325,18 +550,53 @@ Parameters:
Socket on which the lond transaction occured. This is a
LondConnection. The data received is in the TransactionReply member.
-=item Client
+=item Transaction
-Unix domain socket open on the ultimate client.
+The transaction that is being completed.
=cut
sub CompleteTransaction {
- &Debug(6,"Complete transaction");
- my $Socket = shift;
- my $Client = shift;
+ &Debug(5,"Complete transaction");
+
+ my ($Socket, $Transaction) = @_;
+
+ if (!$Transaction->isDeferred()) { # Normal transaction
+ my $data = $Socket->GetReply(); # Data to send.
+ if($LogTransactions) {
+ Log("SUCCESS", "Reply from lond: '$data'");
+ }
+ StartClientReply($Transaction, $data);
+ } else { # Delete deferred transaction file.
+ Log("SUCCESS", "A delayed transaction was completed");
+ LogPerm("S:$Transaction->getClient() :".$Transaction->getRequest());
+ unlink $Transaction->getFile();
+ }
+}
+
+=pod
+
+=head1 StartClientReply
+
+ Initiates a reply to a client where the reply data is a parameter.
+
+=head2 parameters:
+
+=item Transaction
+
+ The transaction for which we are responding to the client.
+
+=item data
+
+ The data to send to apached client.
+
+=cut
+
+sub StartClientReply {
- my $data = $Socket->GetReply(); # Data to send.
+ my ($Transaction, $data) = @_;
+
+ my $Client = $Transaction->getClient();
&Debug(8," Reply was: ".$data);
my $Serial = $ActiveClients{$Client};
@@ -349,6 +609,128 @@ sub CompleteTransaction {
data => $data);
}
+=pod
+
+=head2 FailTransaction
+
+ Finishes a transaction with failure because the associated lond socket
+ disconnected. There are two possibilities:
+ - The transaction is deferred: in which case we just quietly
+ delete the transaction since there is no client connection.
+ - The transaction is 'live' in which case we initiate the sending
+ of "con_lost" to the client.
+
+Deleting the transaction means killing it from the %ActiveTransactions hash.
+
+Parameters:
+
+=item client
+
+ The LondTransaction we are failing.
+
+
+=cut
+
+sub FailTransaction {
+ my $transaction = shift;
+
+ # If the socket is dead, that's already logged.
+
+ if ($ConnectionRetriesLeft > 0) {
+ Log("WARNING", "Failing transaction "
+ .$transaction->getRequest());
+ }
+ Debug(1, "Failing transaction: ".$transaction->getRequest());
+ if (!$transaction->isDeferred()) { # If the transaction is deferred we'll get to it.
+ my $client = $transaction->getClient();
+ Debug(1," Replying con_lost to ".$transaction->getRequest());
+ StartClientReply($transaction, "con_lost\n");
+ }
+
+}
+
+=pod
+=head1 EmptyQueue
+
+ Fails all items in the work queue with con_lost.
+ Note that each item in the work queue is a transaction.
+
+=cut
+sub EmptyQueue {
+ $ConnectionRetriesLeft--; # Counts as connection failure too.
+ while($WorkQueue->Count()) {
+ my $request = $WorkQueue->dequeue(); # This is a transaction
+ FailTransaction($request);
+ }
+}
+
+=pod
+
+=head2 CloseAllLondConnections
+
+Close all connections open on lond prior to exit e.g.
+
+=cut
+sub CloseAllLondConnections {
+ foreach my $Socket (keys %ActiveConnections) {
+ if(exists($ActiveTransactions{$Socket})) {
+ FailTransaction($ActiveTransactions{$Socket});
+ }
+ KillSocket($Socket);
+ }
+}
+=cut
+
+=pod
+
+=head2 KillSocket
+
+Destroys a socket. This function can be called either when a socket
+has died of 'natural' causes or because a socket needs to be pruned due to
+idleness. If the socket has died naturally, if there are no longer any
+live connections a new connection is created (in case there are transactions
+in the queue). If the socket has been pruned, it is never re-created.
+
+Parameters:
+
+=item Socket
+
+ The socket to kill off.
+
+=item Restart
+
+nonzero if we are allowed to create a new connection.
+
+
+=cut
+sub KillSocket {
+ my $Socket = shift;
+
+ Log("WARNING", "Shutting down a socket");
+ $Socket->Shutdown();
+
+ # If the socket came from the active connection set,
+ # delete its transaction... note that FailTransaction should
+ # already have been called!!!
+ # otherwise it came from the idle set.
+ #
+
+ if(exists($ActiveTransactions{$Socket})) {
+ delete ($ActiveTransactions{$Socket});
+ }
+ if(exists($ActiveConnections{$Socket})) {
+ delete($ActiveConnections{$Socket});
+ $ConnectionCount--;
+ if ($ConnectionCount < 0) { $ConnectionCount = 0; }
+ }
+ # If the connection count has gone to zero and there is work in the
+ # work queue, the work all gets failed with con_lost.
+ #
+ if($ConnectionCount == 0) {
+ EmptyQueue();
+ CloseAllLondConnections; # Should all already be closed but...
+ }
+}
=pod
@@ -372,6 +754,17 @@ The connection must echo the challenge b
The challenge has been replied to. The we are receiveing the
'ok' from the partner.
+=head3 State=ReadingVersionString
+
+We have requested the lond version and are reading the
+version back. Upon completion, we'll store the version away
+for future use(?).
+
+=head3 State=HostSet
+
+We have selected the domain name of our peer (multhomed hosts)
+and are getting the reply (presumably ok) back.
+
=head3 State=RequestingKey
The ok has been received and we need to send the request for
@@ -409,59 +802,114 @@ transaction is in progress, the socket a
=cut
sub LondReadable {
+
my $Event = shift;
my $Watcher = $Event->w;
my $Socket = $Watcher->data;
my $client = undef;
+ &Debug(6,"LondReadable called state = ".$Socket->GetState());
+
my $State = $Socket->GetState(); # All action depends on the state.
- &Debug(6,"LondReadable called state = ".$State);
SocketDump(6, $Socket);
+ my $status = $Socket->Readable();
+
+ &Debug(2, "Socket->Readable returned: $status");
+
+ if($status != 0) {
+ # bad return from socket read. Currently this means that
+ # The socket has become disconnected. We fail the transaction.
- if($Socket->Readable() != 0) {
- # bad return from socket read.
+ Log("WARNING",
+ "Lond connection lost.");
+ if(exists($ActiveTransactions{$Socket})) {
+ FailTransaction($ActiveTransactions{$Socket});
+ } else {
+ # Socket is connecting and failed... need to mark
+ # no longer connecting.
+
+ $LondConnecting = 0;
+ }
+ $Watcher->cancel();
+ KillSocket($Socket);
+ $ConnectionRetriesLeft--; # Counts as connection failure
+ return;
}
SocketDump(6,$Socket);
$State = $Socket->GetState(); # Update in case of transition.
&Debug(6, "After read, state is ".$State);
- if($State eq "Initialized") {
+ if($State eq "Initialized") {
} elsif ($State eq "ChallengeReceived") {
# The challenge must be echoed back; The state machine
# in the connection takes care of setting that up. Just
# need to transition to writable:
-
- $Watcher->poll("w");
+
$Watcher->cb(\&LondWritable);
+ $Watcher->poll("w");
} elsif ($State eq "ChallengeReplied") {
+ } elsif ($State eq "RequestingVersion") {
+ # Need to ask for the version... that is writiability:
+
+ $Watcher->cb(\&LondWritable);
+ $Watcher->poll("w");
+
+ } elsif ($State eq "ReadingVersionString") {
+ # Read the rest of the version string...
+ } elsif ($State eq "SetHost") {
+ # Need to request the actual domain get set...
+
+ $Watcher->cb(\&LondWritable);
+ $Watcher->poll("w");
+ } elsif ($State eq "HostSet") {
+ # Reading the 'ok' from the peer.
} elsif ($State eq "RequestingKey") {
# The ok was received. Now we need to request the key
# That requires us to be writable:
- $Watcher->poll("w");
$Watcher->cb(\&LondWritable);
+ $Watcher->poll("w");
} elsif ($State eq "ReceivingKey") {
} elsif ($State eq "Idle") {
+
+ # This is as good a spot as any to get the peer version
+ # string:
+
+ if($LondVersion eq "unknown") {
+ $LondVersion = $Socket->PeerVersion();
+ Log("INFO", "Connected to lond version: $LondVersion");
+ }
# If necessary, complete a transaction and then go into the
# idle queue.
+ # Note that a trasition to idle indicates a live lond
+ # on the other end so reset the connection retries.
+ #
+ $ConnectionRetriesLeft = $ConnectionRetries; # success resets the count
+ $Watcher->cancel();
if(exists($ActiveTransactions{$Socket})) {
- Debug(8,"Completing transaction!!");
+ Debug(5,"Completing transaction!!");
CompleteTransaction($Socket,
$ActiveTransactions{$Socket});
+ } else {
+ Log("SUCCESS", "Connection ".$ConnectionCount." to "
+ .$RemoteHost." now ready for action");
}
- $Watcher->cancel();
ServerToIdle($Socket); # Next work unit or idle.
+ #
+ $LondConnecting = 0; # Best spot I can think of for this.
+ #
+
} elsif ($State eq "SendingRequest") {
# We need to be writable for this and probably don't belong
# here inthe first place.
@@ -474,7 +922,7 @@ sub LondReadable {
} else {
- # Invalid state.
+ # Invalid state.
Debug(4, "Invalid state in LondReadable");
}
}
@@ -543,82 +991,116 @@ is the socket on which to return a reply
sub LondWritable {
my $Event = shift;
my $Watcher = $Event->w;
- my @data = $Watcher->data;
- Debug(6,"LondWritable State = ".$State." data has ".@data." elts.\n");
+ my $Socket = $Watcher->data;
+ my $State = $Socket->GetState();
- my $Socket = $data[0]; # I know there's at least a socket.
+ Debug(6,"LondWritable State = ".$State."\n");
+
# Figure out what to do depending on the state of the socket:
- my $State = $Socket->GetState();
SocketDump(6,$Socket);
+ # If the socket is writable, we must always write.
+ # Only by writing will we undergo state transitions.
+ # Old logic wrote in state specific code below, however
+ # That forces us at least through another invocation of
+ # this function after writability is possible again.
+ # This logic also factors out common code for handling
+ # write failures... in all cases, write failures
+ # Kill the socket.
+ # This logic makes the branches of the >big< if below
+ # so that the writing states are actually NO-OPs.
+
+ if ($Socket->Writable() != 0) {
+ # The write resulted in an error.
+ # We'll treat this as if the socket got disconnected:
+ Log("WARNING", "Connection to ".$RemoteHost.
+ " has been disconnected");
+ if(exists($ActiveTransactions{$Socket})) {
+ FailTransaction($ActiveTransactions{$Socket});
+ } else {
+ # In the process of conneting, so need to turn that off.
+
+ $LondConnecting = 0;
+ }
+ $Watcher->cancel();
+ KillSocket($Socket);
+ return;
+ }
+
+
+
if ($State eq "Connected") {
- # "init" is being sent...
- if ($Socket->Writable() != 0) {
- # The write resulted in an error.
- }
-
+ # "init" is being sent...
+
} elsif ($State eq "Initialized") {
# Now that init was sent, we switch
# to watching for readability:
- $Watcher->poll("r");
$Watcher->cb(\&LondReadable);
-
+ $Watcher->poll("r");
+
} elsif ($State eq "ChallengeReceived") {
# We received the challenge, now we
# are echoing it back. This is a no-op,
# we're waiting for the state to change
- if($Socket->Writable() != 0) {
- # Write of the next chunk resulted in an error.
- }
-
} elsif ($State eq "ChallengeReplied") {
# The echo was sent back, so we switch
# to watching readability.
+ $Watcher->cb(\&LondReadable);
$Watcher->poll("r");
+ } elsif ($State eq "RequestingVersion") {
+ # Sending the peer a version request...
+
+ } elsif ($State eq "ReadingVersionString") {
+ # Transition to read since we have sent the
+ # version command and now just need to read the
+ # version string from the peer:
+
+ $Watcher->cb(\&LondReadable);
+ $Watcher->poll("r");
+
+ } elsif ($State eq "SetHost") {
+ # Setting the remote domain...
+
+ } elsif ($State eq "HostSet") {
+ # Back to readable to get the ok.
+
$Watcher->cb(\&LondReadable);
+ $Watcher->poll("r");
+
} elsif ($State eq "RequestingKey") {
# At this time we're requesting the key.
# again, this is essentially a no-op.
- # we'll write the next chunk until the
- # state changes.
-
- if($Socket->Writable() != 0) {
- # Write resulted in an error.
- }
} elsif ($State eq "ReceivingKey") {
# Now we need to wait for the key
# to come back from the peer:
- $Watcher->poll("r");
$Watcher->cb(\&LondReadable);
+ $Watcher->poll("r");
} elsif ($State eq "SendingRequest") {
+
# At this time we are sending a request to the
# peer... write the next chunk:
- if($Socket->Writable() != 0) {
- # Write resulted in an error.
-
- }
} elsif ($State eq "ReceivingReply") {
# The send has completed. Wait for the
# data to come in for a reply.
Debug(8,"Writable sent request/receiving reply");
- $Watcher->poll("r");
$Watcher->cb(\&LondReadable);
+ $Watcher->poll("r");
} else {
# Control only passes here on an error:
@@ -630,6 +1112,34 @@ sub LondWritable {
}
}
+=pod
+
+=cut
+sub QueueDelayed {
+ Debug(3,"QueueDelayed called");
+
+ my $path = "$perlvar{'lonSockDir'}/delayed";
+
+ Debug(4, "Delayed path: ".$path);
+ opendir(DIRHANDLE, $path);
+
+ my @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;
+ closedir(DIRHANDLE);
+ my $dfname;
+ my $reqfile;
+ foreach $dfname (sort @alldelayed) {
+ $reqfile = "$path/$dfname";
+ Debug(4, "queueing ".$reqfile);
+ my $Handle = IO::File->new($reqfile);
+ my $cmd = <$Handle>;
+ chomp $cmd; # There may or may not be a newline...
+ $cmd = $cmd."\n"; # now for sure there's exactly one newline.
+ my $Transaction = LondTransaction->new($cmd);
+ $Transaction->SetDeferred($reqfile);
+ QueueTransaction($Transaction);
+ }
+
+}
=pod
@@ -650,32 +1160,45 @@ sub MakeLondConnection {
my $Connection = LondConnection->new(&GetServerHost(),
&GetServerPort());
- if($Connection == undef) { # Needs to be more robust later.
- die "Failed to make a connection!!".$!."\n";
+ if($Connection eq undef) { # Needs to be more robust later.
+ Log("CRITICAL","Failed to make a connection with lond.");
+ $ConnectionRetriesLeft--;
+ return 0; # Failure.
+ } else {
+
+ # The connection needs to have writability
+ # monitored in order to send the init sequence
+ # that starts the whole authentication/key
+ # exchange underway.
+ #
+ my $Socket = $Connection->GetSocket();
+ if($Socket eq undef) {
+ die "did not get a socket from the connection";
+ } else {
+ &Debug(9,"MakeLondConnection got socket: ".$Socket);
+ }
- }
- # The connection needs to have writability
- # monitored in order to send the init sequence
- # that starts the whole authentication/key
- # exchange underway.
- #
- my $Socket = $Connection->GetSocket();
- if($Socket == undef) {
- die "did not get a socket from the connection";
- } else {
- &Debug(9,"MakeLondConnection got socket: ".$Socket);
- }
-
-
- $event = Event->io(fd => $Socket,
- poll => 'w',
- cb => \&LondWritable,
- data => ($Connection, undef),
- desc => 'Connection to lond server');
- $ActiveConnections{$Lond} = $event;
+ $Connection->SetTimeoutCallback(\&SocketTimeout);
- $ConnectionCount++;
-
+ my $event = Event->io(fd => $Socket,
+ poll => 'w',
+ cb => \&LondWritable,
+ data => $Connection,
+ desc => 'Connection to lond server');
+ $ActiveConnections{$Connection} = $event;
+ if ($ConnectionCount == 0) {
+ &SetupTimer; # Need to handle timeouts with connections...
+ }
+ $ConnectionCount++;
+ Debug(4, "Connection count = ".$ConnectionCount);
+ if($ConnectionCount == 1) { # First Connection:
+ QueueDelayed;
+ }
+ Log("SUCESS", "Created connection ".$ConnectionCount
+ ." to host ".GetServerHost());
+ $LondConnecting = 1; # Connection in progress.
+ return 1; # Return success.
+ }
}
@@ -705,18 +1228,18 @@ The text of the request to send.
=cut
sub StartRequest {
- my $Lond = shift;
- my $Client = shift;
- my $Request = shift;
+
+ my ($Lond, $Request) = @_;
- Debug(6, "StartRequest: ".$Request);
+ Debug(6, "StartRequest: ".$Request->getRequest());
my $Socket = $Lond->GetSocket();
- $ActiveTransactions{$Lond} = $Client; # Socket to relay to client.
+ $Request->Activate($Lond);
+ $ActiveTransactions{$Lond} = $Request;
- $Lond->InitiateTransaction($Request);
- $event = Event->io(fd => $Lond->GetSocket(),
+ $Lond->InitiateTransaction($Request->getRequest());
+ my $event = Event->io(fd => $Socket,
poll => "w",
cb => \&LondWritable,
data => $Lond,
@@ -747,23 +1270,35 @@ data to send to the lond.
=cut
sub QueueTransaction {
- my $requestSocket = shift;
- my $requestData = shift;
- Debug(6,"QueueTransaction: ".$requestData);
+ my $requestData = shift; # This is a LondTransaction.
+ my $cmd = $requestData->getRequest();
+
+ Debug(6,"QueueTransaction: ".$cmd);
my $LondSocket = $IdleConnections->pop();
if(!defined $LondSocket) { # Need to queue request.
- Debug(8,"Must queue...");
- $ClientQueue->enqueue($requestSocket);
+ Debug(5,"Must queue...");
$WorkQueue->enqueue($requestData);
- if($ConnectionCount < $MaxConnectionCount) {
- Debug(4,"Starting additional lond connection");
- MakeLondConnection();
+ Debug(5, "Queue Transaction startnew $ConnectionCount $LondConnecting");
+ if(($ConnectionCount < $MaxConnectionCount) && (! $LondConnecting)) {
+
+ if($ConnectionRetriesLeft > 0) {
+ Debug(5,"Starting additional lond connection");
+ if(&MakeLondConnection() == 0) {
+ EmptyQueue(); # Fail transactions, can't make connection.
+ CloseAllLondConnections; # Should all be closed but...
+ }
+ } else {
+ ShowStatus(GetServerHost()." >>> DEAD !!!! <<<");
+ $LondConnecting = 0;
+ EmptyQueue(); # It's worse than that ... he's dead Jim.
+ CloseAllLondConnections; # Should all be closed but..
+ }
}
} else { # Can start the request:
Debug(8,"Can start...");
- StartRequest($LondSocket, $requestSocket, $requestData);
+ StartRequest($LondSocket, $requestData);
}
}
@@ -772,7 +1307,6 @@ sub QueueTransaction {
=pod
=head2 ClientRequest
-
Callback that is called when data can be read from the UNIX domain
socket connecting us with an apache server process.
@@ -791,19 +1325,31 @@ sub ClientRequest {
my $rv = $socket->recv($thisread, POSIX::BUFSIZ, 0);
Debug(8, "rcv: data length = ".length($thisread)
." read =".$thisread);
- unless (defined $rv && length($thisread)) {
+ unless (defined $rv && length($thisread)) {
# Likely eof on socket.
Debug(5,"Client Socket closed on lonc for ".$RemoteHost);
close($socket);
$watcher->cancel();
delete($ActiveClients{$socket});
+ return;
}
Debug(8,"Data: ".$data." this read: ".$thisread);
$data = $data.$thisread; # Append new data.
$watcher->data($data);
- if($data =~ /(.*\n)/) { # Request entirely read.
+ if($data =~ /\n$/) { # Request entirely read.
+ if($data eq "close_connection_exit\n") {
+ Log("CRITICAL",
+ "Request Close Connection ... exiting");
+ CloseAllLondConnections();
+ exit;
+ }
Debug(8, "Complete transaction received: ".$data);
- QueueTransaction($socket, $data);
+ if($LogTransactions) {
+ Log("SUCCESS", "Transaction: '$data'"); # Transaction has \n.
+ }
+ my $Transaction = LondTransaction->new($data);
+ $Transaction->SetClient($socket);
+ QueueTransaction($Transaction);
$watcher->cancel(); # Done looking for input data.
}
@@ -865,7 +1411,7 @@ Returns the host whose lond we talk with
=cut
-sub GetServerHost { # Stub - get this from config.
+sub GetServerHost {
return $RemoteHost; # Setup by the fork.
}
@@ -877,7 +1423,7 @@ Returns the lond port number.
=cut
-sub GetServerPort { # Stub - get this from config.
+sub GetServerPort {
return $perlvar{londPort};
}
@@ -898,8 +1444,8 @@ sub SetupLoncListener {
my $socket;
my $SocketName = GetLoncSocketPath();
unlink($SocketName);
- unless ($socket = IO::Socket::UNIX->new(Local => $SocketName,
- Listen => 10,
+ unless ($socket =IO::Socket::UNIX->new(Local => $SocketName,
+ Listen => 250,
Type => SOCK_STREAM)) {
die "Failed to create a lonc listner socket";
}
@@ -909,8 +1455,106 @@ sub SetupLoncListener {
fd => $socket);
}
+#
+# Toggle transaction logging.
+# Implicit inputs:
+# LogTransactions
+# Implicit Outputs:
+# LogTransactions
+sub ToggleTransactionLogging {
+ print STDERR "Toggle transaction logging...\n";
+ if(!$LogTransactions) {
+ $LogTransactions = 1;
+ } else {
+ $LogTransactions = 0;
+ }
+
+
+ Log("SUCCESS", "Toggled transaction logging: $LogTransactions \n");
+}
+
+=pod
+
+=head2 ChildStatus
+
+Child USR1 signal handler to report the most recent status
+into the status file.
+
+We also use this to reset the retries count in order to allow the
+client to retry connections with a previously dead server.
+=cut
+
+sub ChildStatus {
+ my $event = shift;
+ my $watcher = $event->w;
+
+ Debug(2, "Reporting child status because : ".$watcher->data);
+ my $docdir = $perlvar{'lonDocRoot'};
+
+ open(LOG,">>$docdir/lon-status/loncstatus.txt");
+ flock(LOG,LOCK_EX);
+ print LOG $$."\t".$RemoteHost."\t".$Status."\t".
+ $RecentLogEntry."\n";
+ #
+ # Write out information about each of the connections:
+ #
+ if ($DebugLevel > 2) {
+ print LOG "Active connection statuses: \n";
+ my $i = 1;
+ print STDERR "================================= Socket Status Dump:\n";
+ foreach my $item (keys %ActiveConnections) {
+ my $Socket = $ActiveConnections{$item}->data;
+ my $state = $Socket->GetState();
+ print LOG "Connection $i State: $state\n";
+ print STDERR "---------------------- Connection $i \n";
+ $Socket->Dump(-1); # Ensure it gets dumped..
+ $i++;
+ }
+ }
+ flock(LOG,LOCK_UN);
+ close(LOG);
+ $ConnectionRetriesLeft = $ConnectionRetries;
+}
+
=pod
+=head2 SignalledToDeath
+
+Called in response to a signal that causes a chid process to die.
+
+=cut
+
+
+sub SignalledToDeath {
+ my $event = shift;
+ my $watcher= $event->w;
+
+ Debug(2,"Signalled to death! via ".$watcher->data);
+ my ($signal) = $watcher->data;
+ chomp($signal);
+ Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost "
+ ."died through "."\"$signal\"");
+ LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "
+ ."\"$signal\"");
+ exit 0;
+
+}
+
+=head2 ToggleDebug
+
+This sub toggles trace debugging on and off.
+
+=cut
+
+sub ToggleDebug {
+ my $Current = $DebugLevel;
+ $DebugLevel = $NextDebugLevel;
+ $NextDebugLevel = $Current;
+
+ Log("SUCCESS", "New debugging level for $RemoteHost now $DebugLevel");
+
+}
+
=head2 ChildProcess
This sub implements a child process for a single lonc daemon.
@@ -919,18 +1563,26 @@ This sub implements a child process for
sub ChildProcess {
- print "Loncnew\n";
- # For now turn off signals.
-
- $SIG{QUIT} = IGNORE;
- $SIG{HUP} = IGNORE;
- $SIG{USR1} = IGNORE;
- $SIG{INT} = IGNORE;
- $SIG{CHLD} = IGNORE;
- $SIG{__DIE__} = IGNORE;
+ #
+ # Signals must be handled by the Event framework...
+#
+
+ Event->signal(signal => "QUIT",
+ cb => \&SignalledToDeath,
+ data => "QUIT");
+ Event->signal(signal => "HUP",
+ cb => \&ChildStatus,
+ data => "HUP");
+ Event->signal(signal => "USR1",
+ cb => \&ChildStatus,
+ data => "USR1");
+ Event->signal(signal => "USR2",
+ cb => \&ToggleTransactionLogging);
+ Event->signal(signal => "INT",
+ cb => \&ToggleDebug,
+ data => "INT");
- SetupTimer();
SetupLoncListener();
@@ -940,8 +1592,9 @@ sub ChildProcess {
# Setup the initial server connection:
- &MakeLondConnection();
-
+ # &MakeLondConnection(); // let first work requirest do it.
+
+
Debug(9,"Entering event loop");
my $ret = Event::loop(); # Start the main event loop.
@@ -953,14 +1606,23 @@ sub ChildProcess {
sub CreateChild {
my $host = shift;
+
+ my $sigset = POSIX::SigSet->new(SIGINT);
+ sigprocmask(SIG_BLOCK, $sigset);
$RemoteHost = $host;
- Debug(3, "Forking off child for ".$RemoteHost);
- sleep(5);
- $pid = fork;
+ Log("CRITICAL", "Forking server for ".$host);
+ my $pid = fork;
if($pid) { # Parent
- $ChildHash{$pid} = $RemoteHost;
+ $RemoteHost = "Parent";
+ $ChildHash{$pid} = $host;
+ $HostToPid{$host}= $pid;
+ sigprocmask(SIG_UNBLOCK, $sigset);
+
} else { # child.
- ChildProcess;
+ ShowStatus("Connected to ".$RemoteHost);
+ $SIG{INT} = 'DEFAULT';
+ sigprocmask(SIG_UNBLOCK, $sigset);
+ ChildProcess; # Does not return.
}
}
@@ -974,27 +1636,299 @@ sub CreateChild {
# Each exit gets logged and the child gets restarted.
#
+#
+# Fork and start in new session so hang-up isn't going to
+# happen without intent.
+#
+
+
+
+
+
+
+ShowStatus("Forming new session");
+my $childpid = fork;
+if ($childpid != 0) {
+ sleep 4; # Give child a chacne to break to
+ exit 0; # a new sesion.
+}
+#
+# Write my pid into the pid file so I can be located
+#
+
+ShowStatus("Parent writing pid file:");
+my $execdir = $perlvar{'lonDaemons'};
+open (PIDSAVE, ">$execdir/logs/lonc.pid");
+print PIDSAVE "$$\n";
+close(PIDSAVE);
+
+
+
+if (POSIX::setsid() < 0) {
+ print "Could not create new session\n";
+ exit -1;
+}
+
+ShowStatus("Forking node servers");
+
+Log("CRITICAL", "--------------- Starting children ---------------");
+
+LondConnection::ReadConfig; # Read standard config files.
my $HostIterator = LondConnection::GetHostIterator;
while (! $HostIterator->end()) {
- $hostentryref = $HostIterator->get();
+ my $hostentryref = $HostIterator->get();
CreateChild($hostentryref->[0]);
+ $HostHash{$hostentryref->[0]} = $hostentryref->[4];
$HostIterator->next();
}
+$RemoteHost = "Parent Server";
# Maintain the population:
+ShowStatus("Parent keeping the flock");
+
+#
+# Set up parent signals:
+#
+
+$SIG{INT} = \&Terminate;
+$SIG{TERM} = \&Terminate;
+$SIG{HUP} = \&Restart;
+$SIG{USR1} = \&CheckKids;
+$SIG{USR2} = \&UpdateKids; # LonManage update request.
+
while(1) {
- $deadchild = wait();
+ my $deadchild = wait();
if(exists $ChildHash{$deadchild}) { # need to restart.
- $deadhost = $ChildHash{$deadchild};
+ my $deadhost = $ChildHash{$deadchild};
+ delete($HostToPid{$deadhost});
delete($ChildHash{$deadchild});
- Debug(4,"Lost child pid= ".$deadchild.
+ Log("WARNING","Lost child pid= ".$deadchild.
"Connected to host ".$deadhost);
+ Log("INFO", "Restarting child procesing ".$deadhost);
CreateChild($deadhost);
}
}
+
+
+=pod
+
+=head1 CheckKids
+
+ Since kids do not die as easily in this implementation
+as the previous one, there is no need to restart the
+dead ones (all dead kids get restarted when they die!!)
+The only thing this function does is to pass USR1 to the
+kids so that they report their status.
+
+=cut
+
+sub CheckKids {
+ Debug(2, "Checking status of children");
+ my $docdir = $perlvar{'lonDocRoot'};
+ my $fh = IO::File->new(">$docdir/lon-status/loncstatus.txt");
+ my $now=time;
+ my $local=localtime($now);
+ print $fh "LONC status $local - parent $$ \n\n";
+ foreach my $pid (keys %ChildHash) {
+ Debug(2, "Sending USR1 -> $pid");
+ kill 'USR1' => $pid; # Tell Child to report status.
+ }
+}
+
+=pod
+
+=head1 UpdateKids
+
+parent's SIGUSR2 handler. This handler:
+
+=item
+
+Rereads the hosts file.
+
+=item
+
+Kills off (via sigint) children for hosts that have disappeared.
+
+=item
+
+QUITs children for hosts that already exist (this just forces a status display
+and resets the connection retry count for that host.
+
+=item
+
+Starts new children for hosts that have been added to the hosts.tab file since
+the start of the master program and maintains them.
+
+=cut
+
+sub UpdateKids {
+
+ Log("INFO", "Updating connections via SIGUSR2");
+
+ # Just in case we need to kill our own lonc, we wait a few seconds to
+ # give it a chance to receive and relay lond's response to the
+ # re-init command.
+ #
+
+ sleep(2); # Wait a couple of seconds.
+
+ my %hosts; # Indexed by loncapa hostname, value=ip.
+
+ # Need to re-read the host table:
+
+
+ LondConnection::ReadConfig();
+ my $I = LondConnection::GetHostIterator;
+ while (! $I->end()) {
+ my $item = $I->get();
+ $hosts{$item->[0]} = $item->[4];
+ $I->next();
+ }
+
+ # The logic below is written for clarity not for efficiency.
+ # Since I anticipate that this function is only rarely called, that's
+ # appropriate. There are certainly ways to combine the loops below,
+ # and anyone wishing to obscure the logic is welcome to go for it.
+ # Note that we don't re-direct sigchild. Instead we do what's needed
+ # to the data structures that keep track of children to ensure that
+ # when sigchild is honored, no new child is born.
+ #
+
+ # For each existing child; if it's host doesn't exist, kill the child.
+
+ foreach my $child (keys %ChildHash) {
+ my $oldhost = $ChildHash{$child};
+ if (!(exists $hosts{$oldhost})) {
+ Log("CRITICAL", "Killing child for $oldhost host no longer exists");
+ delete $ChildHash{$child};
+ delete $HostToPid{$oldhost};
+ kill 'QUIT' => $child;
+ }
+ }
+ # For each remaining existing child; if it's host's ip has changed,
+ # Restart the child on the new IP.
+
+ foreach my $child (keys %ChildHash) {
+ my $oldhost = $ChildHash{$child};
+ my $oldip = $HostHash{$oldhost};
+ if ($hosts{$oldhost} ne $oldip) {
+
+ # kill the old child.
+
+ Log("CRITICAL", "Killing child for $oldhost host ip has changed...");
+ delete $ChildHash{$child};
+ delete $HostToPid{$oldhost};
+ kill 'QUIT' => $child;
+
+ # Do the book-keeping needed to start a new child on the
+ # new ip.
+
+ $HostHash{$oldhost} = $hosts{$oldhost};
+ CreateChild($oldhost);
+ }
+ }
+ # Finally, for each new host, not in the host hash, create a
+ # enter the host and create a new child.
+ # Force a status display of any existing process.
+
+ foreach my $host (keys %hosts) {
+ if(!(exists $HostHash{$host})) {
+ Log("INFO", "New host $host discovered in hosts.tab...");
+ $HostHash{$host} = $hosts{$host};
+ CreateChild($host);
+ } else {
+ kill 'HUP' => $HostToPid{$host}; # status display.
+ }
+ }
+}
+
+
+=pod
+
+=head1 Restart
+
+Signal handler for HUP... all children are killed and
+we self restart. This is an el-cheapo way to re read
+the config file.
+
+=cut
+
+sub Restart {
+ &KillThemAll; # First kill all the children.
+ Log("CRITICAL", "Restarting");
+ my $execdir = $perlvar{'lonDaemons'};
+ unlink("$execdir/logs/lonc.pid");
+ exec("$execdir/loncnew");
+}
+
+=pod
+
+=head1 KillThemAll
+
+Signal handler that kills all children by sending them a
+SIGHUP. Responds to sigint and sigterm.
+
+=cut
+
+sub KillThemAll {
+ Debug(2, "Kill them all!!");
+ local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die.
+ foreach my $pid (keys %ChildHash) {
+ my $serving = $ChildHash{$pid};
+ ShowStatus("Nicely Killing lonc for $serving pid = $pid");
+ Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid");
+ kill 'QUIT' => $pid;
+ }
+
+
+}
+
+
+#
+# Kill all children via KILL. Just in case the
+# first shot didn't get them.
+
+sub really_kill_them_all_dammit
+{
+ Debug(2, "Kill them all Dammit");
+ local($SIG{CHLD} = 'IGNORE'); # In case some purist reenabled them.
+ foreach my $pid (keys %ChildHash) {
+ my $serving = $ChildHash{$pid};
+ &ShowStatus("Nastily killing lonc for $serving pid = $pid");
+ Log("CRITICAL", "Nastily killing lonc for $serving pid = $pid");
+ kill 'KILL' => $pid;
+ delete($ChildHash{$pid});
+ my $execdir = $perlvar{'lonDaemons'};
+ unlink("$execdir/logs/lonc.pid");
+ }
+}
+=pod
+
+=head1 Terminate
+
+Terminate the system.
+
+=cut
+
+sub Terminate {
+ &Log("CRITICAL", "Asked to kill children.. first be nice...");
+ &KillThemAll;
+ #
+ # By now they really should all be dead.. but just in case
+ # send them all SIGKILL's after a bit of waiting:
+
+ sleep(4);
+ &Log("CRITICAL", "Now kill children nasty");
+ &really_kill_them_all_dammit;
+ Log("CRITICAL","Master process exiting");
+ exit 0;
+
+}
+=pod
+
=head1 Theory
The event class is used to build this as a single process with an