--- loncom/loncnew 2003/07/03 02:10:18 1.14
+++ loncom/loncnew 2003/09/16 09:46:42 1.24
@@ -2,13 +2,12 @@
# The LearningOnline Network with CAPA
# lonc maintains the connections to remote computers
#
-# $Id: loncnew,v 1.14 2003/07/03 02:10:18 foxr Exp $
+# $Id: loncnew,v 1.24 2003/09/16 09:46:42 foxr 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,7 +26,7 @@
# 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)
@@ -46,6 +45,55 @@
# Change log:
# $Log: loncnew,v $
+# Revision 1.24 2003/09/16 09:46:42 foxr
+# Added skeletal infrastructure to support SIGUSR2 update hosts request.
+#
+# Revision 1.23 2003/09/15 09:24:49 foxr
+# Add use strict and fix all the fallout from that.
+#
+# Revision 1.22 2003/09/02 10:34:47 foxr
+# - Fix errors in host dead detection logic (too many cases where the
+# retries left were not getting incremented or just not checked).
+# - Added some additional status to the ps axuww display:
+# o Remaining retries on a host.
+# o >>> DEAD <<< indicator if I've given up on a host.
+# - Tested the SIGHUP will reset the retries remaining count (thanks to
+# the above status stuff, and get allow the loncnew to re-try again
+# on the host (thanks to the log).
+#
+# Revision 1.21 2003/08/26 09:19:51 foxr
+# How embarrassing... put in the SocketTimeout function in loncnew and forgot
+# to actually hook it into the LondTransaction. Added this to MakeLondConnection
+# where it belongs... hopefully transactions (not just connection attempts) will
+# timeout more speedily than the socket errors will catch it.
+#
+# Revision 1.20 2003/08/25 18:48:11 albertel
+# - fixing a forgotten ;
+#
+# Revision 1.19 2003/08/19 09:31:46 foxr
+# Get socket directory from configuration rather than the old hard coded test
+# way that I forgot to un-hard code.
+#
+# Revision 1.18 2003/08/06 09:52:29 foxr
+# Also needed to remember to fail in-flight transactions if their sends fail.
+#
+# Revision 1.17 2003/08/03 00:44:31 foxr
+# 1. Correct handling of connection failure: Assume it means the host is
+# unreachable and fail all of the queued transactions. Note that the
+# inflight transactions should fail on their own time due either to timeout
+# or send/receive failures.
+# 2. Correct handling of logs for forced death signals. Pull the signal
+# from the event watcher.
+#
+# Revision 1.16 2003/07/29 02:33:05 foxr
+# Add SIGINT processing to child processes to toggle annoying trace mode
+# on/off.. will try to use this to isolate the compute boud process issue.
+#
+# Revision 1.15 2003/07/15 02:07:05 foxr
+# Added code for lonc/lond transaction timeouts. Who knows if it works right.
+# The intent is for a timeout to fail any transaction in progress and kill
+# off the sockt that timed out.
+#
# Revision 1.14 2003/07/03 02:10:18 foxr
# Get all of the signals to work correctly.
#
@@ -58,7 +106,7 @@
# Revision 1.10 2003/06/24 02:46:04 foxr
# Put a limit on the number of times we'll retry a connection.
# Start getting the signal stuff put in as well...note that need to get signals
-# going or else 6the client will permanently give up on dead servers.
+# going or else the client will permanently give up on dead servers.
#
# Revision 1.9 2003/06/13 02:38:43 foxr
# Add logging in 'expected format'
@@ -72,7 +120,7 @@
# complete coding to support deferred transactions.
#
#
-
+use strict;
use lib "/home/httpd/lib/perl/";
use lib "/home/foxr/newloncapa/types";
use Event qw(:DEFAULT );
@@ -120,13 +168,14 @@ my $MaxConnectionCount = 10; # Will get
my $ClientConnection = 0; # Uniquifier for client events.
my $DebugLevel = 0;
+my $NextDebugLevel= 10; # So Sigint can toggle this.
my $IdleTimeout= 3600; # Wait an hour before pruning connections.
#
# 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; # LondTransactions in flight.
@@ -235,7 +284,7 @@ sub GetPeername {
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;
@@ -256,7 +305,7 @@ sub Debug {
my $level = shift;
my $message = shift;
if ($level <= $DebugLevel) {
- print $message." host = ".$RemoteHost."\n";
+ Log("INFO", "-Debug- $message host = $RemoteHost");
}
}
@@ -286,6 +335,23 @@ sub ShowStatus {
=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;
+
+ KillSocket($Socket); # A transaction timeout also counts as
+ # a connection failure:
+ $ConnectionRetriesLeft--;
+}
+
+=pod
+
=head2 Tick
Invoked each timer tick.
@@ -295,8 +361,12 @@ Invoked each timer tick.
sub Tick {
my $client;
- ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount);
-
+ if($ConnectionRetriesLeft > 0) {
+ ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount
+ ." Retries remaining: ".$ConnectionRetriesLeft);
+ } else {
+ ShowStatus(GetServerHost()." >> DEAD <<");
+ }
# Is it time to prune connection count:
@@ -304,13 +374,19 @@ sub Tick {
($WorkQueue->Count() == 0)) { # Idle connections and nothing to do?
$IdleSeconds++;
if($IdleSeconds > $IdleTimeout) { # Prune a connection...
- $Socket = $IdleConnections->pop();
+ my $Socket = $IdleConnections->pop();
KillSocket($Socket);
}
} else {
$IdleSeconds = 0; # Reset idle count if not idle.
}
-
+ #
+ # For each inflight transaction, tick down its timeout counter.
+ #
+ foreach my $item (keys %ActiveTransactions) {
+ my $Socket = $ActiveTransactions{$item}->getServer();
+ $Socket->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.
#
@@ -321,10 +397,16 @@ sub Tick {
my $Connections = ($Requests <= $MaxConnectionCount) ?
$Requests : $MaxConnectionCount;
Debug(1,"Work but no connections, start ".$Connections." of them");
- for ($i =0; $i < $Connections; $i++) {
- MakeLondConnection();
+ my $successCount = 0;
+ for (my $i =0; $i < $Connections; $i++) {
+ $successCount += MakeLondConnection();
+ }
+ if($successCount == 0) { # All connections failed:
+ Debug(1,"Work in queue failed to make any connectiouns\n");
+ EmptyQueue(); # Fail pending transactions with con_lost.
}
} else {
+ ShowStatus(GetServerHost()." >>> DEAD!!! <<<");
Debug(1,"Work in queue, but gave up on connections..flushing\n");
EmptyQueue(); # Connections can't be established.
}
@@ -376,7 +458,7 @@ sub ServerToIdle {
# If there's work to do, start the transaction:
- $reqdata = $WorkQueue->dequeue(); # This is a LondTransaction
+ my $reqdata = $WorkQueue->dequeue(); # This is a LondTransaction
unless($reqdata eq undef) {
Debug(9, "Queue gave request data: ".$reqdata->getRequest());
&StartRequest($Socket, $reqdata);
@@ -448,6 +530,12 @@ sub ClientWritable {
} 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...
@@ -504,7 +592,7 @@ sub CompleteTransaction {
StartClientReply($Transaction, $data);
} else { # Delete deferred transaction file.
Log("SUCCESS", "A delayed transaction was completed");
- LogPerm("S:$Client:".$Transaction->getRequest());
+ LogPerm("S:$Transaction->getClient() :".$Transaction->getRequest());
unlink $Transaction->getFile();
}
}
@@ -565,12 +653,16 @@ Parameters:
sub FailTransaction {
my $transaction = shift;
+ 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");
}
+ if($ConnectionRetriesLeft <= 0) {
+ Log("CRITICAL", "Host marked dead: ".GetServerHost());
+ }
}
@@ -582,6 +674,7 @@ sub FailTransaction {
=cut
sub EmptyQueue {
+ $ConnectionRetriesLeft--; # Counts as connection failure too.
while($WorkQueue->Count()) {
my $request = $WorkQueue->dequeue(); # This is a transaction
FailTransaction($request);
@@ -596,7 +689,7 @@ Close all connections open on lond prior
=cut
sub CloseAllLondConnections {
- foreach $Socket (keys %ActiveConnections) {
+ foreach my $Socket (keys %ActiveConnections) {
KillSocket($Socket);
}
}
@@ -627,6 +720,7 @@ nonzero if we are allowed to create a ne
sub KillSocket {
my $Socket = shift;
+ Log("WARNING", "Shutting down a socket");
$Socket->Shutdown();
# If the socket came from the active connection set,
@@ -647,7 +741,7 @@ sub KillSocket {
# work queue, the work all gets failed with con_lost.
#
if($ConnectionCount == 0) {
- EmptyQueue;
+ EmptyQueue();
}
}
@@ -716,25 +810,28 @@ sub LondReadable {
my $Socket = $Watcher->data;
my $client = undef;
- &Debug(6,"LondReadable called state = ".$State);
+ &Debug(6,"LondReadable called state = ".$Socket->GetState());
my $State = $Socket->GetState(); # All action depends on the 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.
+ Log("WARNING",
+ "Lond connection lost.");
if(exists($ActiveTransactions{$Socket})) {
- Debug(3,"Lond connection lost failing transaction");
FailTransaction($ActiveTransactions{$Socket});
}
$Watcher->cancel();
KillSocket($Socket);
+ $ConnectionRetriesLeft--; # Counts as connection failure
return;
}
SocketDump(6,$Socket);
@@ -768,6 +865,10 @@ sub LondReadable {
} elsif ($State eq "Idle") {
# 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!!");
@@ -880,6 +981,7 @@ sub LondWritable {
# We'll treat this as if the socket got disconnected:
Log("WARNING", "Connection to ".$RemoteHost.
" has been disconnected");
+ FailTransaction($ActiveTransactions{$Socket});
$Watcher->cancel();
KillSocket($Socket);
return;
@@ -979,8 +1081,7 @@ sub QueueDelayed {
Debug(4, "Delayed path: ".$path);
opendir(DIRHANDLE, $path);
- @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;
- Debug(4, "Got ".$alldelayed." delayed files");
+ my @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;
closedir(DIRHANDLE);
my $dfname;
my $reqfile;
@@ -1022,7 +1123,7 @@ sub MakeLondConnection {
$ConnectionRetriesLeft--;
return 0; # Failure.
} else {
- $ConnectionRetriesLeft = $ConnectionRetries; # success resets the count
+
# The connection needs to have writability
# monitored in order to send the init sequence
# that starts the whole authentication/key
@@ -1035,8 +1136,9 @@ sub MakeLondConnection {
&Debug(9,"MakeLondConnection got socket: ".$Socket);
}
-
- $event = Event->io(fd => $Socket,
+ $Connection->SetTimeoutCallback(\&SocketTimeout);
+
+ my $event = Event->io(fd => $Socket,
poll => 'w',
cb => \&LondWritable,
data => $Connection,
@@ -1092,7 +1194,7 @@ sub StartRequest {
$ActiveTransactions{$Lond} = $Request;
$Lond->InitiateTransaction($Request->getRequest());
- $event = Event->io(fd => $Socket,
+ my $event = Event->io(fd => $Socket,
poll => "w",
cb => \&LondWritable,
data => $Lond,
@@ -1134,8 +1236,15 @@ sub QueueTransaction {
Debug(8,"Must queue...");
$WorkQueue->enqueue($requestData);
if($ConnectionCount < $MaxConnectionCount) {
- Debug(4,"Starting additional lond connection");
- MakeLondConnection();
+ if($ConnectionRetriesLeft > 0) {
+ Debug(4,"Starting additional lond connection");
+ if(MakeLondConnection() == 0) {
+ EmptyQueue(); # Fail transactions, can't make connection.
+ }
+ } else {
+ ShowStatus(GetServerHost()." >>> DEAD !!!! <<<");
+ EmptyQueue(); # It's worse than that ... he's dead Jim.
+ }
}
} else { # Can start the request:
Debug(8,"Can start...");
@@ -1300,6 +1409,8 @@ sub SetupLoncListener {
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;
@@ -1310,6 +1421,7 @@ sub ChildStatus {
my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt");
print $fh $$."\t".$RemoteHost."\t".$Status."\t".
$RecentLogEntry."\n";
+ $ConnectionRetriesLeft = $ConnectionRetries;
}
=pod
@@ -1326,16 +1438,31 @@ sub SignalledToDeath {
my $watcher= $event->w;
Debug(2,"Signalled to death! via ".$watcher->data);
- my ($signal) = @_;
+ 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\"");
- die("Signal abnormal end");
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.
@@ -1348,12 +1475,6 @@ sub ChildProcess {
#
# Signals must be handled by the Event framework...
#
-# $SIG{QUIT} = \&SignalledToDeath;
-# $SIG{HUP} = \&ChildStatus;
-# $SIG{USR1} = IGNORE;
-# $SIG{INT} = DEFAULT;
-# $SIG{CHLD} = IGNORE;
-# $SIG{__DIE__} = \&SignalledToDeath;
Event->signal(signal => "QUIT",
cb => \&SignalledToDeath,
@@ -1364,6 +1485,9 @@ sub ChildProcess {
Event->signal(signal => "USR1",
cb => \&ChildStatus,
data => "USR1");
+ Event->signal(signal => "INT",
+ cb => \&ToggleDebug,
+ data => "INT");
SetupTimer();
@@ -1393,14 +1517,15 @@ sub CreateChild {
my $host = shift;
$RemoteHost = $host;
Log("CRITICAL", "Forking server for ".$host);
- $pid = fork;
+ my $pid = fork;
if($pid) { # Parent
+ $RemoteHost = "Parent";
$ChildHash{$pid} = $RemoteHost;
sigprocmask(SIG_UNBLOCK, $sigset);
} else { # child.
ShowStatus("Connected to ".$RemoteHost);
- $SIG{INT} = DEFAULT;
+ $SIG{INT} = 'DEFAULT';
sigprocmask(SIG_UNBLOCK, $sigset);
ChildProcess; # Does not return.
}
@@ -1437,11 +1562,13 @@ if ($childpid != 0) {
#
ShowStatus("Parent writing pid file:");
-$execdir = $perlvar{'lonDaemons'};
+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;
@@ -1454,7 +1581,7 @@ Log("CRITICAL", "--------------- Startin
my $HostIterator = LondConnection::GetHostIterator;
while (! $HostIterator->end()) {
- $hostentryref = $HostIterator->get();
+ my $hostentryref = $HostIterator->get();
CreateChild($hostentryref->[0]);
$HostIterator->next();
}
@@ -1472,11 +1599,12 @@ $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($ChildHash{$deadchild});
Log("WARNING","Lost child pid= ".$deadchild.
"Connected to host ".$deadhost);
@@ -1506,7 +1634,7 @@ sub CheckKids {
my $now=time;
my $local=localtime($now);
print $fh "LONC status $local - parent $$ \n\n";
- foreach $pid (keys %ChildHash) {
+ foreach my $pid (keys %ChildHash) {
Debug(2, "Sending USR1 -> $pid");
kill 'USR1' => $pid; # Tell Child to report status.
sleep 1; # Wait so file doesn't intermix.
@@ -1515,6 +1643,36 @@ sub CheckKids {
=pod
+=head1 UpdateKids
+
+parent's SIGUSR1 handler. This handler:
+
+=item
+
+Rereads the hosts file.
+
+=item
+
+Kills off (via sigint) children for hosts that have disappeared.
+
+=item
+
+HUP's 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 {
+}
+
+
+=pod
+
=head1 Restart
Signal handler for HUP... all children are killed and
@@ -1524,7 +1682,7 @@ the config file.
=cut
sub Restart {
- KillThemAll; # First kill all the children.
+ &KillThemAll; # First kill all the children.
Log("CRITICAL", "Restarting");
my $execdir = $perlvar{'lonDaemons'};
unlink("$execdir/logs/lonc.pid");
@@ -1536,25 +1694,24 @@ sub Restart {
=head1 KillThemAll
Signal handler that kills all children by sending them a
-SIGINT. Responds to sigint and sigterm.
+SIGHUP. Responds to sigint and sigterm.
=cut
sub KillThemAll {
Debug(2, "Kill them all!!");
local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die.
- foreach $pid (keys %ChildHash) {
+ foreach my $pid (keys %ChildHash) {
my $serving = $ChildHash{$pid};
Debug(2, "Killing lonc for $serving pid = $pid");
ShowStatus("Killing lonc for $serving pid = $pid");
Log("CRITICAL", "Killing lonc for $serving pid = $pid");
- kill('INT', $pid);
- delete($ChildeHash{$pid});
+ kill 'QUIT' => $pid;
+ delete($ChildHash{$pid});
}
my $execdir = $perlvar{'lonDaemons'};
unlink("$execdir/logs/lonc.pid");
- ShowStatus("Killing the master process");
- Log("CRITICAL", "Killing the master process.");
+
}
=pod
@@ -1567,7 +1724,8 @@ Terminate the system.
sub Terminate {
KillThemAll;
- exit;
+ Log("CRITICAL","Master process exiting");
+ exit 0;
}
=pod