--- loncom/loncnew 2005/01/17 22:18:44 1.67
+++ loncom/loncnew 2010/12/20 11:15:51 1.90
@@ -2,7 +2,7 @@
# The LearningOnline Network with CAPA
# lonc maintains the connections to remote computers
#
-# $Id: loncnew,v 1.67 2005/01/17 22:18:44 albertel Exp $
+# $Id: loncnew,v 1.90 2010/12/20 11:15:51 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -60,7 +60,6 @@ use LONCAPA::Stack;
use LONCAPA::LondConnection;
use LONCAPA::LondTransaction;
use LONCAPA::Configuration;
-use LONCAPA::HashIterator;
use Fcntl qw(:flock);
@@ -73,9 +72,8 @@ my %perlvar = %{$perlvarref};
#
# parent and shared variables.
-my %ChildHash; # by pid -> host.
-my %HostToPid; # By host -> pid.
-my %HostHash; # by loncapaname -> IP.
+my %ChildPid; # by pid -> host.
+my %ChildHost; # by host.
my %listening_to; # Socket->host table for who the parent
# is listening to.
my %parent_dispatchers; # host-> listener watcher events.
@@ -87,7 +85,7 @@ my $ClientConnection = 0; # Uniquifier f
my $DebugLevel = 0;
my $NextDebugLevel= 2; # So Sigint can toggle this.
-my $IdleTimeout= 600; # Wait 10 minutes before pruning connections.
+my $IdleTimeout= 7200; # Wait two hours before pruning connections.
my $LogTransactions = 0; # When True, all transactions/replies get logged.
my $executable = $0; # Get the full path to me.
@@ -96,6 +94,8 @@ my $executable = $0; # Get the full
# The variables below are only used by the child processes.
#
my $RemoteHost; # Name of host child is talking to.
+my $RemoteHostId; # default lonid of host child is talking to.
+my @all_host_ids;
my $UnixSocketDir= $perlvar{'lonSockDir'};
my $IdleConnections = Stack->new(); # Set of idle connections
my %ActiveConnections; # Connections to the remote lond.
@@ -106,15 +106,14 @@ 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 $ConnectionRetries=5; # Number of connection retries allowed.
+my $ConnectionRetriesLeft=5; # 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 = 1; # When true children die when trimmed -> 0.
my $I_am_child = 0; # True if this is the child process.
#
@@ -152,12 +151,14 @@ sub UpdateStatus {
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");
+ chomp($message);
print $fh "$now:$message:$local\n";
}
@@ -197,7 +198,7 @@ sub Log {
my $now = time;
my $local = localtime($now);
my $finalformat = "$local ($$) [$RemoteHost] [$Status] ";
- my $finalformat = $finalformat.$format."\n";
+ $finalformat = $finalformat.$format."\n";
# open the file and put the result.
@@ -271,6 +272,7 @@ sub SocketDump {
and as what we return in a SIGUSR1
=cut
+
sub ShowStatus {
my $state = shift;
my $now = time;
@@ -281,13 +283,14 @@ sub ShowStatus {
=pod
-=head 2 SocketTimeout
+=head2 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");
@@ -305,12 +308,13 @@ sub SocketTimeout {
}
}
+
#
# This function should be called by the child in all cases where it must
-# exit. If the child process is running with the DieWhenIdle turned on
-# it must create a lock file for the AF_UNIX socket in order to prevent
-# connection requests from lonnet in the time between process exit
-# and the parent picking up the listen again.
+# exit. The child process must create a lock file for the AF_UNIX socket
+# in order to prevent connection requests from lonnet in the time between
+# process exit and the parent picking up the listen again.
+#
# Parameters:
# exit_code - Exit status value, however see the next parameter.
# message - If this optional parameter is supplied, the exit
@@ -321,24 +325,20 @@ sub child_exit {
# Regardless of how we exit, we may need to do the lock thing:
- if($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);
- }
- # Now figure out how we exit:
+ #
+ # 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);
+ unlink(&GetLoncSocketPath());
- if($message) {
- die $message;
+ if ($message) {
+ die($message);
} else {
exit($exit_code);
}
@@ -372,7 +372,7 @@ sub Tick {
KillSocket($Socket);
$IdleSeconds = 0; # Otherwise all connections get trimmed to fast.
UpdateStatus();
- if(($ConnectionCount == 0) && $DieWhenIdle) {
+ if(($ConnectionCount == 0)) {
&child_exit(0);
}
@@ -503,6 +503,9 @@ the data and Event->w->fd is the socket
sub ClientWritable {
my $Event = shift;
my $Watcher = $Event->w;
+ if (!defined($Watcher)) {
+ &child_exit(-1,'No watcher for event in ClientWritable');
+ }
my $Data = $Watcher->data;
my $Socket = $Watcher->fd;
@@ -566,6 +569,7 @@ sub ClientWritable {
}
} else {
$Watcher->cancel(); # A delayed request...just cancel.
+ return;
}
}
@@ -605,8 +609,8 @@ sub CompleteTransaction {
StartClientReply($Transaction, $data);
} else { # Delete deferred transaction file.
Log("SUCCESS", "A delayed transaction was completed");
- LogPerm("S:$Transaction->getClient() :".$Transaction->getRequest());
- unlink $Transaction->getFile();
+ LogPerm("S:".$Transaction->getClient().":".$Transaction->getRequest());
+ unlink($Transaction->getFile());
}
}
@@ -674,9 +678,9 @@ sub FailTransaction {
if ($ConnectionRetriesLeft > 0) {
Log("WARNING", "Failing transaction "
- .$transaction->getRequest());
+ .$transaction->getLoggableRequest());
}
- Debug(1, "Failing transaction: ".$transaction->getRequest());
+ Debug(1, "Failing transaction: ".$transaction->getLoggableRequest());
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());
@@ -686,12 +690,14 @@ sub FailTransaction {
}
=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()) {
@@ -707,6 +713,7 @@ sub EmptyQueue {
Close all connections open on lond prior to exit e.g.
=cut
+
sub CloseAllLondConnections {
foreach my $Socket (keys %ActiveConnections) {
if(exists($ActiveTransactions{$Socket})) {
@@ -715,7 +722,6 @@ sub CloseAllLondConnections {
KillSocket($Socket);
}
}
-=cut
=pod
@@ -737,8 +743,8 @@ Parameters:
nonzero if we are allowed to create a new connection.
-
=cut
+
sub KillSocket {
my $Socket = shift;
@@ -755,6 +761,7 @@ sub KillSocket {
delete ($ActiveTransactions{$Socket});
}
if(exists($ActiveConnections{$Socket})) {
+ $ActiveConnections{$Socket}->cancel;
delete($ActiveConnections{$Socket});
$ConnectionCount--;
if ($ConnectionCount < 0) { $ConnectionCount = 0; }
@@ -766,6 +773,7 @@ sub KillSocket {
EmptyQueue();
CloseAllLondConnections; # Should all already be closed but...
}
+ UpdateStatus();
}
=pod
@@ -950,7 +958,7 @@ sub LondReadable {
# We need to be writable for this and probably don't belong
# here inthe first place.
- Deubg(6, "SendingRequest state encountered in readable");
+ Debug(6, "SendingRequest state encountered in readable");
$Watcher->poll("w");
$Watcher->cb(\&LondWritable);
@@ -1148,9 +1156,12 @@ sub LondWritable {
}
}
+
=pod
=cut
+
+
sub QueueDelayed {
Debug(3,"QueueDelayed called");
@@ -1158,19 +1169,19 @@ sub QueueDelayed {
Debug(4, "Delayed path: ".$path);
opendir(DIRHANDLE, $path);
-
- my @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;
+
+ my $host_id_re = '(?:'.join('|',map {quotemeta($_)} (@all_host_ids)).')';
+ my @alldelayed = grep(/\.$host_id_re$/, readdir(DIRHANDLE));
closedir(DIRHANDLE);
- my $dfname;
- my $reqfile;
- foreach $dfname (sort @alldelayed) {
- $reqfile = "$path/$dfname";
- Debug(4, "queueing ".$reqfile);
+ foreach my $dfname (sort(@alldelayed)) {
+ my $reqfile = "$path/$dfname";
+ my ($host_id) = ($dfname =~ /\.([^.]*)$/);
+ Debug(4, "queueing ".$reqfile." for $host_id");
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);
+ my $Transaction = LondTransaction->new("sethost:$host_id:$cmd");
$Transaction->SetDeferred($reqfile);
QueueTransaction($Transaction);
}
@@ -1194,14 +1205,16 @@ sub MakeLondConnection {
.GetServerPort());
my $Connection = LondConnection->new(&GetServerHost(),
- &GetServerPort());
+ &GetServerPort(),
+ &GetHostId());
- if($Connection eq undef) { # Needs to be more robust later.
+ if($Connection eq undef) {
Log("CRITICAL","Failed to make a connection with lond.");
$ConnectionRetriesLeft--;
return 0; # Failure.
} else {
+ $LondConnecting = 1; # Connection in progress.
# The connection needs to have writability
# monitored in order to send the init sequence
# that starts the whole authentication/key
@@ -1232,7 +1245,6 @@ sub MakeLondConnection {
}
Log("SUCESS", "Created connection ".$ConnectionCount
." to host ".GetServerHost());
- $LondConnecting = 1; # Connection in progress.
return 1; # Return success.
}
@@ -1373,14 +1385,23 @@ sub ClientRequest {
$data = $data.$thisread; # Append new data.
$watcher->data($data);
if($data =~ /\n$/) { # Request entirely read.
- if($data eq "close_connection_exit\n") {
+ if ($data eq "close_connection_exit\n") {
Log("CRITICAL",
"Request Close Connection ... exiting");
CloseAllLondConnections();
exit;
+ } elsif ($data eq "reset_retries\n") {
+ Log("INFO", "Resetting Connection Retries.");
+ $ConnectionRetriesLeft = $ConnectionRetries;
+ &UpdateStatus();
+ my $Transaction = LondTransaction->new($data);
+ $Transaction->SetClient($socket);
+ StartClientReply($Transaction, "ok\n");
+ $watcher->cancel();
+ return;
}
Debug(8, "Complete transaction received: ".$data);
- if($LogTransactions) {
+ if ($LogTransactions) {
Log("SUCCESS", "Transaction: '$data'"); # Transaction has \n.
}
my $Transaction = LondTransaction->new($data);
@@ -1395,7 +1416,7 @@ sub ClientRequest {
# Accept a connection request for a client (lonc child) and
# start up an event watcher to keep an eye on input from that
# Event. This can be called both from NewClient and from
-# ChildProcess if we are started in DieWhenIdle mode.
+# ChildProcess.
# Parameters:
# $socket - The listener socket.
# Returns:
@@ -1484,6 +1505,18 @@ sub GetServerHost {
=pod
+=head2 GetServerId
+
+Returns the hostid whose lond we talk with.
+
+=cut
+
+sub GetHostId {
+ return $RemoteHostId; # Setup by the fork.
+}
+
+=pod
+
=head2 GetServerPort
Returns the lond port number.
@@ -1511,15 +1544,14 @@ another event handler to subess requests
=cut
sub SetupLoncListener {
+ my ($host,$SocketName) = @_;
+ if (!$host) { $host = &GetServerHost(); }
+ if (!$SocketName) { $SocketName = &GetLoncSocketPath($host); }
- my $host = GetServerHost(); # Default host.
- if (@_) {
- ($host) = @_ # Override host with parameter.
- }
- my $socket;
- my $SocketName = GetLoncSocketPath($host);
unlink($SocketName);
+
+ my $socket;
unless ($socket =IO::Socket::UNIX->new(Local => $SocketName,
Listen => 250,
Type => SOCK_STREAM)) {
@@ -1559,6 +1591,7 @@ 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 {
@@ -1591,6 +1624,7 @@ sub ChildStatus {
flock(LOG,LOCK_UN);
close(LOG);
$ConnectionRetriesLeft = $ConnectionRetries;
+ UpdateStatus();
}
=pod
@@ -1611,12 +1645,14 @@ sub SignalledToDeath {
chomp($signal);
Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost "
."died through "."\"$signal\"");
- LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "
- ."\"$signal\"");
+ #LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "
+# ."\"$signal\"");
exit 0;
}
+=pod
+
=head2 ToggleDebug
This sub toggles trace debugging on and off.
@@ -1632,6 +1668,8 @@ sub ToggleDebug {
}
+=pod
+
=head2 ChildProcess
This sub implements a child process for a single lonc daemon.
@@ -1642,7 +1680,7 @@ Optional parameter:
=cut
sub ChildProcess {
- # If we are in DieWhenIdle mode, we've inherited all the
+ # We've inherited all the
# events of our parent and those have to be cancelled or else
# all holy bloody chaos will result.. trust me, I already made
# >that< mistake.
@@ -1710,7 +1748,7 @@ sub ChildProcess {
desc => 'Lonc Listener Unix Socket',
fd => $socket);
- $Event::Debuglevel = $DebugLevel;
+ $Event::DebugLevel = $DebugLevel;
Debug(9, "Making initial lond connection for ".$RemoteHost);
@@ -1718,12 +1756,9 @@ sub ChildProcess {
# &MakeLondConnection(); // let first work request do it.
- # If We are in diwhenidle, need to accept the connection since the
- # event may not fire.
+ # need to accept the connection since the event may not fire.
- if ($DieWhenIdle) {
- &accept_client($socket);
- }
+ &accept_client($socket);
Debug(9,"Entering event loop");
my $ret = Event::loop(); # Start the main event loop.
@@ -1735,7 +1770,7 @@ sub ChildProcess {
# Create a new child for host passed in:
sub CreateChild {
- my ($host, $socket) = @_;
+ my ($host, $hostid) = @_;
my $sigset = POSIX::SigSet->new(SIGINT);
sigprocmask(SIG_BLOCK, $sigset);
@@ -1744,19 +1779,15 @@ sub CreateChild {
my $pid = fork;
if($pid) { # Parent
$RemoteHost = "Parent";
- $ChildHash{$pid} = $host;
- $HostToPid{$host}= $pid;
+ $ChildPid{$pid} = $host;
sigprocmask(SIG_UNBLOCK, $sigset);
-
+ undef(@all_host_ids);
} else { # child.
+ $RemoteHostId = $hostid;
ShowStatus("Connected to ".$RemoteHost);
$SIG{INT} = 'DEFAULT';
sigprocmask(SIG_UNBLOCK, $sigset);
- if(defined $socket) {
- &ChildProcess($socket);
- } else {
- ChildProcess; # Does not return.
- }
+ &ChildProcess(); # Does not return.
}
}
@@ -1784,25 +1815,50 @@ sub parent_client_connection {
my ($event) = @_;
my $watcher = $event->w;
my $socket = $watcher->fd;
-
- # Lookup the host associated with this socket:
-
- my $host = $listening_to{$socket};
-
- # Start the child:
-
-
-
- &Debug(9,"Creating child for $host (parent_client_connection)");
- &CreateChild($host, $socket);
-
- # Clean up the listen since now the child takes over until it exits.
-
- $watcher->cancel(); # Nolonger listening to this event
- delete($listening_to{$socket});
- delete($parent_dispatchers{$host});
- $socket->close();
+ my $connection = $socket->accept(); # Accept the client connection.
+ Event->io(cb => \&get_remote_hostname,
+ poll => 'r',
+ data => "",
+ fd => $connection);
+ }
+}
+
+sub get_remote_hostname {
+ my ($event) = @_;
+ my $watcher = $event->w;
+ my $socket = $watcher->fd;
+
+ my $thisread;
+ my $rv = $socket->recv($thisread, POSIX::BUFSIZ, 0);
+ Debug(8, "rcv: data length = ".length($thisread)." read =".$thisread);
+ if (!defined($rv) || length($thisread) == 0) {
+ # Likely eof on socket.
+ Debug(5,"Client Socket closed on lonc for p_c_c");
+ close($socket);
+ $watcher->cancel();
+ return;
+ }
+
+ my $data = $watcher->data().$thisread;
+ $watcher->data($data);
+ if($data =~ /\n$/) { # Request entirely read.
+ chomp($data);
+ } else {
+ return;
+ }
+
+ &Debug(5,"Creating child for $data (parent_client_connection)");
+ (my $hostname,my $lonid,@all_host_ids) = split(':',$data);
+ $ChildHost{$hostname}++;
+ if ($ChildHost{$hostname} == 1) {
+ &CreateChild($hostname,$lonid);
+ } else {
+ &Log('WARNING',"Request for a second child on $hostname");
}
+ # Clean up the listen since now the child takes over until it exits.
+ $watcher->cancel(); # Nolonger listening to this event
+ $socket->send("done\n");
+ $socket->close();
}
# parent_listen:
@@ -1824,32 +1880,50 @@ sub parent_listen {
my ($loncapa_host) = @_;
Debug(5, "parent_listen: $loncapa_host");
- my $socket = &SetupLoncListener($loncapa_host);
+ my ($socket,$file);
+ if (!$loncapa_host) {
+ $loncapa_host = 'common_parent';
+ $file = $perlvar{'lonSockCreate'};
+ } else {
+ $file = &GetLoncSocketPath($loncapa_host);
+ }
+ $socket = &SetupLoncListener($loncapa_host,$file);
+
$listening_to{$socket} = $loncapa_host;
if (!$socket) {
die "Unable to create a listen socket for $loncapa_host";
}
- my $lock_file = &GetLoncSocketPath($loncapa_host).".lock";
+ my $lock_file = $file.".lock";
unlink($lock_file); # No problem if it doesn't exist yet [startup e.g.]
- my $watcher = Event->io(cb => \&parent_client_connection,
- poll => 'r',
- desc => "Parent listener unix socket ($loncapa_host)",
- fd => $socket);
+ my $watcher =
+ Event->io(cb => \&parent_client_connection,
+ poll => 'r',
+ desc => "Parent listener unix socket ($loncapa_host)",
+ data => "",
+ fd => $socket);
$parent_dispatchers{$loncapa_host} = $watcher;
}
+sub parent_clean_up {
+ my ($loncapa_host) = @_;
+ Debug(1, "parent_clean_up: $loncapa_host");
+
+ my $socket_file = &GetLoncSocketPath($loncapa_host);
+ unlink($socket_file); # No problem if it doesn't exist yet [startup e.g.]
+ my $lock_file = $socket_file.".lock";
+ unlink($lock_file); # No problem if it doesn't exist yet [startup e.g.]
+}
+
+
-# listen_on_all_unix_sockets:
-# This sub initiates a listen on all unix domain lonc client sockets.
-# This will be called in the case where we are trimming idle processes.
-# When idle processes are trimmed, loncnew starts up with no children,
-# and only spawns off children when a connection request occurs on the
-# client unix socket. The spawned child continues to run until it has
-# been idle a while at which point it eventually exits and once more
-# the parent picks up the listen.
+# This sub initiates a listen on the common unix domain lonc client socket.
+# loncnew starts up with no children, and only spawns off children when a
+# connection request occurs on the common client unix socket. The spawned
+# child continues to run until it has been idle a while at which point it
+# eventually exits and once more the parent picks up the listen.
#
# Parameters:
# NONE
@@ -1858,16 +1932,9 @@ sub parent_listen {
# Returns:
# NONE
#
-sub listen_on_all_unix_sockets {
- Debug(5, "listen_on_all_unix_sockets");
- my $host_iterator = &LondConnection::GetHostIterator();
- while (!$host_iterator->end()) {
- my $host_entry_ref = $host_iterator->get();
- my $host_name = $host_entry_ref->[0];
- Debug(9, "Listen for $host_name");
- &parent_listen($host_name);
- $host_iterator->next();
- }
+sub listen_on_common_socket {
+ Debug(5, "listen_on_common_socket");
+ &parent_listen();
}
# server_died is called whenever a child process exits.
@@ -1889,12 +1956,12 @@ sub server_died {
}
# need the host to restart:
- my $host = $ChildHash{$pid};
+ my $host = $ChildPid{$pid};
if($host) { # It's for real...
&Debug(9, "Caught sigchild for $host");
- delete($ChildHash{$pid});
- delete($HostToPid{$host});
- &parent_listen($host);
+ delete($ChildPid{$pid});
+ delete($ChildHost{$host});
+ &parent_clean_up($host);
} else {
&Debug(5, "Caught sigchild for pid not in hosts hash: $pid");
@@ -1951,21 +2018,9 @@ ShowStatus("Forking node servers");
Log("CRITICAL", "--------------- Starting children ---------------");
LondConnection::ReadConfig; # Read standard config files.
-my $HostIterator = LondConnection::GetHostIterator;
-if ($DieWhenIdle) {
- $RemoteHost = "[parent]";
- &listen_on_all_unix_sockets();
-} else {
-
- while (! $HostIterator->end()) {
-
- my $hostentryref = $HostIterator->get();
- CreateChild($hostentryref->[0]);
- $HostHash{$hostentryref->[0]} = $hostentryref->[4];
- $HostIterator->next();
- }
-}
+$RemoteHost = "[parent]";
+&listen_on_common_socket();
$RemoteHost = "Parent Server";
@@ -1974,68 +2029,38 @@ $RemoteHost = "Parent Server";
ShowStatus("Parent keeping the flock");
-if ($DieWhenIdle) {
- # We need to setup a SIGChild event to handle the exit (natural or otherwise)
- # of the children.
-
- Event->signal(cb => \&server_died,
- desc => "Child exit handler",
- signal => "CHLD");
-
-
- # Set up all the other signals we set up. We'll vector them off to the
- # same subs as we would for DieWhenIdle false and, if necessary, conditionalize
- # the code there.
-
- $parent_handlers{INT} = Event->signal(cb => \&Terminate,
- desc => "Parent INT handler",
- signal => "INT");
- $parent_handlers{TERM} = Event->signal(cb => \&Terminate,
- desc => "Parent TERM handler",
- signal => "TERM");
- $parent_handlers{HUP} = Event->signal(cb => \&Restart,
- desc => "Parent HUP handler.",
- signal => "HUP");
- $parent_handlers{USR1} = Event->signal(cb => \&CheckKids,
- desc => "Parent USR1 handler",
- signal => "USR1");
- $parent_handlers{USR2} = Event->signal(cb => \&UpdateKids,
- desc => "Parent USR2 handler.",
- signal => "USR2");
-
- # Start procdesing events.
-
- $Event::DebugLevel = $DebugLevel;
- Debug(9, "Parent entering event loop");
- my $ret = Event::loop();
- die "Main Event loop exited: $ret";
-
-
-} else {
- #
- # Set up parent signals:
- #
-
- $SIG{INT} = \&Terminate;
- $SIG{TERM} = \&Terminate;
- $SIG{HUP} = \&Restart;
- $SIG{USR1} = \&CheckKids;
- $SIG{USR2} = \&UpdateKids; # LonManage update request.
-
- while(1) {
- my $deadchild = wait();
- if(exists $ChildHash{$deadchild}) { # need to restart.
- my $deadhost = $ChildHash{$deadchild};
- delete($HostToPid{$deadhost});
- delete($ChildHash{$deadchild});
- Log("WARNING","Lost child pid= ".$deadchild.
- "Connected to host ".$deadhost);
- Log("INFO", "Restarting child procesing ".$deadhost);
- CreateChild($deadhost);
- }
- }
-}
+# We need to setup a SIGChild event to handle the exit (natural or otherwise)
+# of the children.
+Event->signal(cb => \&server_died,
+ desc => "Child exit handler",
+ signal => "CHLD");
+
+
+# Set up all the other signals we set up.
+
+$parent_handlers{INT} = Event->signal(cb => \&Terminate,
+ desc => "Parent INT handler",
+ signal => "INT");
+$parent_handlers{TERM} = Event->signal(cb => \&Terminate,
+ desc => "Parent TERM handler",
+ signal => "TERM");
+$parent_handlers{HUP} = Event->signal(cb => \&KillThemAll,
+ desc => "Parent HUP handler.",
+ signal => "HUP");
+$parent_handlers{USR1} = Event->signal(cb => \&CheckKids,
+ desc => "Parent USR1 handler",
+ signal => "USR1");
+$parent_handlers{USR2} = Event->signal(cb => \&UpdateKids,
+ desc => "Parent USR2 handler.",
+ signal => "USR2");
+
+# Start procdesing events.
+
+$Event::DebugLevel = $DebugLevel;
+Debug(9, "Parent entering event loop");
+my $ret = Event::loop();
+die "Main Event loop exited: $ret";
=pod
@@ -2059,7 +2084,7 @@ sub CheckKids {
foreach my $host (keys %parent_dispatchers) {
print $fh "LONC Parent process listening for $host\n";
}
- foreach my $pid (keys %ChildHash) {
+ foreach my $pid (keys %ChildPid) {
Debug(2, "Sending USR1 -> $pid");
kill 'USR1' => $pid; # Tell Child to report status.
}
@@ -2103,8 +2128,7 @@ sub UpdateKids {
# The down side is transactions that are in flight will get timed out
# (lost unless they are critical).
- &Restart();
-
+ &KillThemAll();
}
@@ -2137,15 +2161,19 @@ SIGHUP. Responds to sigint and sigterm.
sub KillThemAll {
Debug(2, "Kill them all!!");
- local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die.
- foreach my $pid (keys %ChildHash) {
- my $serving = $ChildHash{$pid};
+
+ #local($SIG{CHLD}) = 'IGNORE';
+ # Our children >will< die.
+ # but we need to catch their death and cleanup after them in case this is
+ # a restart set of kills
+ my @allpids = keys(%ChildPid);
+ foreach my $pid (@allpids) {
+ my $serving = $ChildPid{$pid};
ShowStatus("Nicely Killing lonc for $serving pid = $pid");
Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid");
kill 'QUIT' => $pid;
}
-
-
+ ShowStatus("Finished killing child processes off.");
}
@@ -2157,16 +2185,17 @@ 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};
+ foreach my $pid (keys %ChildPid) {
+ my $serving = $ChildPid{$pid};
&ShowStatus("Nastily killing lonc for $serving pid = $pid");
Log("CRITICAL", "Nastily killing lonc for $serving pid = $pid");
kill 'KILL' => $pid;
- delete($ChildHash{$pid});
+ delete($ChildPid{$pid});
my $execdir = $perlvar{'lonDaemons'};
unlink("$execdir/logs/lonc.pid");
}
}
+
=pod
=head1 Terminate
@@ -2189,6 +2218,14 @@ sub Terminate {
exit 0;
}
+
+sub my_hostname {
+ use Sys::Hostname;
+ my $name = &hostname();
+ &Debug(9,"Name is $name");
+ return $name;
+}
+
=pod
=head1 Theory
@@ -2230,3 +2267,183 @@ A hash of lond connections that have no
can be closed if they are idle for a long enough time.
=cut
+
+=pod
+
+=head1 Log messages
+
+The following is a list of log messages that can appear in the
+lonc.log file. Each log file has a severity and a message.
+
+=over 2
+
+=item Warning A socket timeout was detected
+
+If there are pending transactions in the socket's queue,
+they are failed (saved if critical). If the connection
+retry count gets exceeded by this, the
+remote host is marked as dead.
+Called when timeouts occured during the connection and
+connection dialog with a remote host.
+
+=item Critical Host makred DEAD <hostname>
+
+The numer of retry counts for contacting a host was
+exceeded. The host is marked dead an no
+further attempts will be made by that child.
+
+=item Info lonc pipe client hung up on us
+
+Write to the client pipe indicated no data transferred
+Socket to remote host is shut down. Reply to the client
+is discarded. Note: This is commented out in &ClientWriteable
+
+=item Success Reply from lond: <data>
+
+Can be enabled for debugging by setting LogTransactions to nonzero.
+Indicates a successful transaction with lond, <data> is the data received
+from the remote lond.
+
+=item Success A delayed transaction was completed
+
+A transaction that must be reliable was executed and completed
+as lonc restarted. This is followed by a mesage of the form
+
+ S: client-name : request
+
+=item WARNING Failing transaction <cmd>:<subcmd>
+
+Transaction failed on a socket, but the failure retry count for the remote
+node has not yet been exhausted (the node is not yet marked dead).
+cmd is the command, subcmd is the subcommand. This results from a con_lost
+when communicating with lond.
+
+=item WARNING Shutting down a socket
+
+Called when a socket is being closed to lond. This is emitted both when
+idle pruning is being done and when the socket has been disconnected by the remote.
+
+=item WARNING Lond connection lost.
+
+Called when a read from lond's socket failed indicating lond has closed the
+connection or died. This should be followed by one or more
+
+ "WARNING Failing transaction..." msgs for each in-flight or queued transaction.
+
+=item INFO Connected to lond version: <version>
+
+When connection negotiation is complete, the lond version is requested and logged here.
+
+=item SUCCESS Connection n to host now ready for action
+
+Emitted when connection has been completed with lond. n is then number of
+concurrent connections and host, the host to which the connection has just
+been established.
+
+=item WARNING Connection to host has been disconnected
+
+Write to a lond resulted in failure status. Connection to lond is dropped.
+
+=item SUCCESS Created connection n to host host
+
+Initial connection request to host..(before negotiation).
+
+=item CRITICAL Request Close Connection ... exiting
+
+Client has sent "close_connection_exit" The loncnew server is exiting.
+
+=item INFO Resetting Connection Retries
+
+Client has sent "reset_retries" The lond connection retries are reset to zero for the
+corresponding lond.
+
+=item SUCCESS Transaction <data>
+
+Only emitted if the global variable $LogTransactions was set to true.
+A client has requested a lond transaction <data> is the contents of the request.
+
+=item SUCCESS Toggled transaction logging <LogTransactions>
+
+The state of the $LogTransactions global has been toggled, and its current value
+(after being toggled) is displayed. When non zero additional logging of transactions
+is enabled for debugging purposes. Transaction logging is toggled on receipt of a USR2
+signal.
+
+=item CRITICAL Abnormal exit. Child <pid> for <host> died thorugh signal.
+
+QUIT signal received. lonc child process is exiting.
+
+=item SUCCESS New debugging level for <RemoteHost> now <DebugLevel>
+
+Debugging toggled for the host loncnew is talking with.
+Currently debugging is a level based scheme with higher number
+conveying more information. The daemon starts out at
+DebugLevel 0 and can toggle back and forth between that and
+DebugLevel 2 These are controlled by
+the global variables $DebugLevel and $NextDebugLevel
+The debug level can go up to 9.
+SIGINT toggles the debug level. The higher the debug level the
+more debugging information is spewed. See the Debug
+sub in loncnew.
+
+=item CRITICAL Forking server for host
+
+A child is being created to service requests for the specified host.
+
+
+=item WARNING Request for a second child on hostname
+
+Somehow loncnew was asked to start a second child on a host that already had a child
+servicing it. This request is not honored, but themessage is emitted. This could happen
+due to a race condition. When a client attempts to contact loncnew for a new host, a child
+is forked off to handle the requests for that server. The parent then backs off the Unix
+domain socket leaving it for the child to service all requests. If in the time between
+creating the child, and backing off, a new connection request comes in to the unix domain
+socket, this could trigger (unlikely but remotely possible),.
+
+=item CRITICAL ------ Starting Children ----
+
+This message should probably be changed to "Entering event loop" as the loncnew only starts
+children as needed. This message is emitted as new events are established and
+the event processing loop is entered.
+
+=item INFO Updating connections via SIGUSR2
+
+SIGUSR2 received. The original code would kill all clients, re-read the host file,
+then restart children for each host. Now that childrean aree started on demand, this
+just kills all child processes and lets requests start them as needed again.
+
+
+=item CRITICAL Restarting
+
+SigHUP received. all the children are killed and the script exec's itself to start again.
+
+=item CRITICAL Nicely killing lonc for host pid = <pid>
+
+Attempting to kill the child that is serving the specified host (pid given) cleanly via
+SIGQUIT The child should handle that, clean up nicely and exit.
+
+=item CRITICAL Nastily killing lonc for host pid = <pid>
+
+The child specified did not die when requested via SIGQUIT. Therefore it is killed
+via SIGKILL.
+
+=item CRITICAL Asked to kill children.. first be nice..
+
+In the parent's INT handler. INT kills the child processes. This inidicate loncnew
+is about to attempt to kill all known children via SIGQUIT. This message should be followed
+by one "Nicely killing" message for each extant child.
+
+=item CRITICAL Now kill children nasty
+
+In the parent's INT handler. remaining children are about to be killed via
+SIGKILL. Should be followed by a Nastily killing... for each lonc child that
+refused to die.
+
+=item CRITICAL Master process exiting
+
+In the parent's INT handler. just prior to the exit 0 call.
+
+=back
+
+=cut