--- loncom/loncnew 2003/10/07 11:23:03 1.27
+++ loncom/loncnew 2004/09/29 10:37:35 1.61
@@ -2,7 +2,7 @@
# The LearningOnline Network with CAPA
# lonc maintains the connections to remote computers
#
-# $Id: loncnew,v 1.27 2003/10/07 11:23:03 foxr Exp $
+# $Id: loncnew,v 1.61 2004/09/29 10:37:35 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -35,105 +35,16 @@
# - Add ability to create/negotiate lond connections (done).
# - Add general logic for dispatching requests and timeouts. (done).
# - Add support for the lonc/lond requests. (done).
-# - Add logging/status monitoring.
-# - Add Signal handling - HUP restarts. USR1 status report.
+# - 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.
+# - Add management/status request interface. (done)
# - Add deferred request capability. (done)
-# - Detect transmission timeouts.
+# - Detect transmission timeouts. (done)
#
-# Change log:
-# $Log: loncnew,v $
-# Revision 1.27 2003/10/07 11:23:03 foxr
-# Installed and tested code to process reinit in parent server.
-#
-# Revision 1.26 2003/09/30 11:11:17 foxr
-# Add book-keeping hashes to support the re-init procedure.
-#
-# Revision 1.25 2003/09/23 11:22:14 foxr
-# Tested ability to receive sigusr2 This is now logged and must be
-# properly implemented as a re-read of hosts and re-init of appropriate
-# children.
-#
-# 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.
-#
-# Revision 1.13 2003/07/02 01:31:55 foxr
-# Added kill -HUP logic (restart).
-#
-# Revision 1.11 2003/06/25 01:54:44 foxr
-# Fix more problems with transaction failure.
-#
-# 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 the client will permanently give up on dead servers.
-#
-# Revision 1.9 2003/06/13 02:38:43 foxr
-# Add logging in 'expected format'
-#
-# Revision 1.8 2003/06/11 02:04:35 foxr
-# Support delayed transactions... this is done uniformly by encapsulating
-# transactions in an object ... a LondTransaction that is implemented by
-# LondTransaction.pm
-#
-# Revision 1.7 2003/06/03 01:59:39 foxr
-# complete coding to support deferred transactions.
-#
-#
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;
@@ -152,11 +63,6 @@ use LONCAPA::Configuration;
use LONCAPA::HashIterator;
-#
-# Disable all signals we might receive from outside for now.
-#
-
-
# Read the httpd configuration file to get perl variables
# normally set in apache modules:
@@ -175,8 +81,10 @@ 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.
+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.
@@ -192,8 +100,16 @@ my $ConnectionCount = 0;
my $IdleSeconds = 0; # Number of seconds idle.
my $Status = ""; # Current status string.
my $RecentLogEntry = "";
-my $ConnectionRetries=5; # Number of connection retries allowed.
-my $ConnectionRetriesLeft=5; # Number of connection retries remaining.
+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.
+
+
+# DO NOT SET THE NEXT VARIABLE TO NON ZERO!!!!!!!!!!!!!!!
+
+my $DieWhenIdle = 0; # When true children die when trimmed -> 0.
#
# The hash below gives the HTML format for log messages
@@ -201,13 +117,27 @@ my $ConnectionRetriesLeft=5; # Number of
#
my %LogFormats;
-$LogFormats{"CRITICAL"} = "<font color=red>CRITICAL: %s</font>";
-$LogFormats{"SUCCESS"} = "<font color=green>SUCCESS: %s</font>";
-$LogFormats{"INFO"} = "<font color=yellow>INFO: %s</font>";
-$LogFormats{"WARNING"} = "<font color=blue>WARNING: %s</font>";
+$LogFormats{"CRITICAL"} = "<font color='red'>CRITICAL: %s</font>";
+$LogFormats{"SUCCESS"} = "<font color='green'>SUCCESS: %s</font>";
+$LogFormats{"INFO"} = "<font color='yellow'>INFO: %s</font>";
+$LogFormats{"WARNING"} = "<font color='blue'>WARNING: %s</font>";
$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
@@ -247,9 +177,9 @@ host and the time will be formatted into
=cut
sub Log {
- my $severity = shift;
- my $message = shift;
-
+
+ my ($severity, $message) = @_;
+
if(!$LogFormats{$severity}) {
$severity = "DEFAULT";
}
@@ -284,8 +214,10 @@ 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;
@@ -299,7 +231,6 @@ sub GetPeername {
return $peerfile;
}
}
-#----------------------------- Timer management ------------------------
=pod
=head2 Debug
@@ -309,18 +240,20 @@ Invoked to issue a debug message.
=cut
sub Debug {
- my $level = shift;
- my $message = shift;
+
+ my ($level, $message) = @_;
+
if ($level <= $DebugLevel) {
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.
}
}
@@ -351,11 +284,22 @@ sub ShowStatus {
=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
@@ -367,13 +311,12 @@ Invoked each timer tick.
sub Tick {
+ my ($Event) = @_;
+ my $clock_watcher = $Event->w;
+
my $client;
- if($ConnectionRetriesLeft > 0) {
- ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount
- ." Retries remaining: ".$ConnectionRetriesLeft);
- } else {
- ShowStatus(GetServerHost()." >> DEAD <<");
- }
+ UpdateStatus();
+
# Is it time to prune connection count:
@@ -383,6 +326,22 @@ sub Tick {
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.
@@ -390,35 +349,43 @@ sub Tick {
#
# For each inflight transaction, tick down its timeout counter.
#
- foreach my $item (keys %ActiveTransactions) {
- my $Socket = $ActiveTransactions{$item}->getServer();
- $Socket->Tick();
+
+ 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)) {
+ if (($ConnectionCount == 0) && ($Requests > 0) && (!$LondConnecting)) {
if ($ConnectionRetriesLeft > 0) {
- my $Connections = ($Requests <= $MaxConnectionCount) ?
- $Requests : $MaxConnectionCount;
- Debug(1,"Work but no connections, start ".$Connections." of them");
- 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");
+ 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(1,"Work in queue, but gave up on connections..flushing\n");
+ 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();
+ }
}
=pod
@@ -439,7 +406,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
@@ -459,21 +426,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:
my $reqdata = $WorkQueue->dequeue(); # This is a LondTransaction
- unless($reqdata eq undef) {
- Debug(9, "Queue gave request data: ".$reqdata->getRequest());
+ 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");
+ &Debug(5, "No new work requests, server connection going idle");
$IdleConnections->push($Socket);
}
}
@@ -519,7 +487,7 @@ sub ClientWritable {
# request.
&Debug(9,"Send result is ".$result." Defined: ".defined($result));
- if(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");
@@ -538,7 +506,7 @@ 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!");
+ # Log("INFO", "lonc pipe client hung up on us!");
$Watcher->cancel;
$Socket->shutdown(2);
$Socket->close();
@@ -590,12 +558,15 @@ The transaction that is being completed.
=cut
sub CompleteTransaction {
- &Debug(6,"Complete transaction");
- my $Socket = shift;
- my $Transaction = 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");
@@ -603,7 +574,9 @@ sub CompleteTransaction {
unlink $Transaction->getFile();
}
}
+
=pod
+
=head1 StartClientReply
Initiates a reply to a client where the reply data is a parameter.
@@ -619,17 +592,16 @@ sub CompleteTransaction {
The data to send to apached client.
=cut
+
sub StartClientReply {
- my $Transaction = shift;
- my $data = shift;
+ my ($Transaction, $data) = @_;
my $Client = $Transaction->getClient();
&Debug(8," Reply was: ".$data);
my $Serial = $ActiveClients{$Client};
my $desc = sprintf("Connection to lonc client %d",
-
$Serial);
Event->io(fd => $Client,
poll => "w",
@@ -637,7 +609,9 @@ sub StartClientReply {
cb => \&ClientWritable,
data => $data);
}
+
=pod
+
=head2 FailTransaction
Finishes a transaction with failure because the associated lond socket
@@ -647,8 +621,7 @@ sub StartClientReply {
- 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.
+Deleting the transaction means killing it from the %ActiveTransactions hash.
Parameters:
@@ -656,20 +629,24 @@ Parameters:
The LondTransaction we are failing.
+
=cut
sub FailTransaction {
my $transaction = shift;
- Log("WARNING", "Failing transaction ".$transaction->getRequest());
+
+ # 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");
}
- if($ConnectionRetriesLeft <= 0) {
- Log("CRITICAL", "Host marked dead: ".GetServerHost());
- }
}
@@ -697,7 +674,10 @@ Close all connections open on lond prior
=cut
sub CloseAllLondConnections {
foreach my $Socket (keys %ActiveConnections) {
- KillSocket($Socket);
+ if(exists($ActiveTransactions{$Socket})) {
+ FailTransaction($ActiveTransactions{$Socket});
+ }
+ KillSocket($Socket);
}
}
=cut
@@ -741,14 +721,15 @@ sub KillSocket {
}
if(exists($ActiveConnections{$Socket})) {
delete($ActiveConnections{$Socket});
+ $ConnectionCount--;
+ if ($ConnectionCount < 0) { $ConnectionCount = 0; }
}
- $ConnectionCount--;
-
# 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...
}
}
@@ -774,6 +755,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
@@ -828,13 +820,18 @@ sub LondReadable {
&Debug(2, "Socket->Readable returned: $status");
if($status != 0) {
- # bad return from socket read. Currently this means that
+ # 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})) {
FailTransaction($ActiveTransactions{$Socket});
+ } else {
+ # Socket is connecting and failed... need to mark
+ # no longer connecting.
+
+ $LondConnecting = 0;
}
$Watcher->cancel();
KillSocket($Socket);
@@ -846,19 +843,34 @@ sub LondReadable {
$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->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
@@ -870,6 +882,14 @@ sub LondReadable {
} 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
@@ -878,7 +898,7 @@ sub LondReadable {
$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 {
@@ -886,6 +906,10 @@ sub LondReadable {
.$RemoteHost." now ready for action");
}
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
@@ -899,7 +923,7 @@ sub LondReadable {
} else {
- # Invalid state.
+ # Invalid state.
Debug(4, "Invalid state in LondReadable");
}
}
@@ -981,21 +1005,40 @@ sub LondWritable {
SocketDump(6,$Socket);
- if ($State eq "Connected") {
-
- 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 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});
- $Watcher->cancel();
- KillSocket($Socket);
- return;
+ } else {
+ # In the process of conneting, so need to turn that off.
+
+ $LondConnecting = 0;
}
- # "init" is being sent...
+ $Watcher->cancel();
+ KillSocket($Socket);
+ return;
+ }
-
+
+
+ if ($State eq "Connected") {
+
+ # "init" is being sent...
+
} elsif ($State eq "Initialized") {
# Now that init was sent, we switch
@@ -1003,40 +1046,43 @@ sub LondWritable {
$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) {
-
- $Watcher->cancel();
- KillSocket($Socket);
- return;
- }
-
} 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.
- $Watcher->cancel();
- KillSocket($Socket);
- return;
-
- }
} elsif ($State eq "ReceivingKey") {
# Now we need to wait for the key
# to come back from the peer:
@@ -1045,20 +1091,10 @@ sub LondWritable {
$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) {
-
- if(exists($ActiveTransactions{$Socket})) {
- Debug(3, "Lond connection lost, failing transactions");
- FailTransaction($ActiveTransactions{$Socket});
- }
- $Watcher->cancel();
- KillSocket($Socket);
- return;
-
- }
} elsif ($State eq "ReceivingReply") {
# The send has completed. Wait for the
@@ -1125,7 +1161,7 @@ sub MakeLondConnection {
my $Connection = LondConnection->new(&GetServerHost(),
&GetServerPort());
- if($Connection == undef) { # Needs to be more robust later.
+ if($Connection eq undef) { # Needs to be more robust later.
Log("CRITICAL","Failed to make a connection with lond.");
$ConnectionRetriesLeft--;
return 0; # Failure.
@@ -1137,7 +1173,7 @@ sub MakeLondConnection {
# exchange underway.
#
my $Socket = $Connection->GetSocket();
- if($Socket == undef) {
+ if($Socket eq undef) {
die "did not get a socket from the connection";
} else {
&Debug(9,"MakeLondConnection got socket: ".$Socket);
@@ -1151,7 +1187,9 @@ sub MakeLondConnection {
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:
@@ -1159,6 +1197,7 @@ sub MakeLondConnection {
}
Log("SUCESS", "Created connection ".$ConnectionCount
." to host ".GetServerHost());
+ $LondConnecting = 1; # Connection in progress.
return 1; # Return success.
}
@@ -1190,8 +1229,8 @@ The text of the request to send.
=cut
sub StartRequest {
- my $Lond = shift;
- my $Request = shift; # This is a LondTransaction.
+
+ my ($Lond, $Request) = @_;
Debug(6, "StartRequest: ".$Request->getRequest());
@@ -1240,17 +1279,22 @@ sub QueueTransaction {
my $LondSocket = $IdleConnections->pop();
if(!defined $LondSocket) { # Need to queue request.
- Debug(8,"Must queue...");
+ Debug(5,"Must queue...");
$WorkQueue->enqueue($requestData);
- if($ConnectionCount < $MaxConnectionCount) {
+ Debug(5, "Queue Transaction startnew $ConnectionCount $LondConnecting");
+ if(($ConnectionCount < $MaxConnectionCount) && (! $LondConnecting)) {
+
if($ConnectionRetriesLeft > 0) {
- Debug(4,"Starting additional lond connection");
- if(MakeLondConnection() == 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:
@@ -1282,7 +1326,7 @@ 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);
@@ -1293,7 +1337,7 @@ sub ClientRequest {
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");
@@ -1301,6 +1345,9 @@ sub ClientRequest {
exit;
}
Debug(8, "Complete transaction received: ".$data);
+ if($LogTransactions) {
+ Log("SUCCESS", "Transaction: '$data'"); # Transaction has \n.
+ }
my $Transaction = LondTransaction->new($data);
$Transaction->SetClient($socket);
QueueTransaction($Transaction);
@@ -1351,10 +1398,20 @@ sub NewClient {
Returns the name of the UNIX socket on which to listen for client
connections.
+=head2 Parameters:
+
+ host (optional) - Name of the host socket to return.. defaults to
+ the return from GetServerHost().
+
=cut
sub GetLoncSocketPath {
- return $UnixSocketDir."/".GetServerHost();
+
+ my $host = GetServerHost(); # Default host.
+ if (@_) {
+ ($host) = @_; # Override if supplied.
+ }
+ return $UnixSocketDir."/".$host;
}
=pod
@@ -1391,22 +1448,46 @@ connection. The event handler establish
(creating a communcations channel), that int turn will establish
another event handler to subess requests.
+=head2 Parameters:
+
+ host (optional) Name of the host to set up a unix socket to.
+
=cut
sub SetupLoncListener {
+ my $host = GetServerHost(); # Default host.
+ if (@_) {
+ ($host) = @_ # Override host with parameter.
+ }
+
my $socket;
- my $SocketName = GetLoncSocketPath();
+ my $SocketName = GetLoncSocketPath($host);
unlink($SocketName);
unless ($socket =IO::Socket::UNIX->new(Local => $SocketName,
- Listen => 10,
+ Listen => 250,
Type => SOCK_STREAM)) {
die "Failed to create a lonc listner socket";
}
- Event->io(cb => \&NewClient,
- poll => 'r',
- desc => 'Lonc listener Unix Socket',
- fd => $socket);
+ return $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
@@ -1419,6 +1500,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 {
my $event = shift;
my $watcher = $event->w;
@@ -1428,6 +1510,22 @@ sub ChildStatus {
my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt");
print $fh $$."\t".$RemoteHost."\t".$Status."\t".
$RecentLogEntry."\n";
+ #
+ # Write out information about each of the connections:
+ #
+ if ($DebugLevel > 2) {
+ print $fh "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 $fh "Connection $i State: $state\n";
+ print STDERR "---------------------- Connection $i \n";
+ $Socket->Dump(-1); # Ensure it gets dumped..
+ $i++;
+ }
+ }
$ConnectionRetriesLeft = $ConnectionRetries;
}
@@ -1473,6 +1571,9 @@ sub ToggleDebug {
=head2 ChildProcess
This sub implements a child process for a single lonc daemon.
+Optional parameter:
+ $socket - if provided, this is a socket already open for listen
+ on the client socket. Otherwise, a new listen is set up.
=cut
@@ -1481,7 +1582,7 @@ sub ChildProcess {
#
# Signals must be handled by the Event framework...
-#
+ #
Event->signal(signal => "QUIT",
cb => \&SignalledToDeath,
@@ -1492,13 +1593,22 @@ sub ChildProcess {
Event->signal(signal => "USR1",
cb => \&ChildStatus,
data => "USR1");
+ Event->signal(signal => "USR2",
+ cb => \&ToggleTransactionLogging);
Event->signal(signal => "INT",
cb => \&ToggleDebug,
data => "INT");
- SetupTimer();
- SetupLoncListener();
+ my ($socket) = @_;
+ if (!$socket) {
+
+ $socket = SetupLoncListener();
+ }
+ Event->io(cb => \&NewClient,
+ poll => 'r',
+ desc => 'Lonc Listener Unix Socket',
+ fd => $socket);
$Event::Debuglevel = $DebugLevel;
@@ -1506,7 +1616,7 @@ sub ChildProcess {
# Setup the initial server connection:
- # &MakeLondConnection(); // let first work requirest do� it.
+ # &MakeLondConnection(); // let first work requirest do it.
Debug(9,"Entering event loop");
@@ -1519,9 +1629,10 @@ sub ChildProcess {
# Create a new child for host passed in:
sub CreateChild {
+ my $host = shift;
+
my $sigset = POSIX::SigSet->new(SIGINT);
sigprocmask(SIG_BLOCK, $sigset);
- my $host = shift;
$RemoteHost = $host;
Log("CRITICAL", "Forking server for ".$host);
my $pid = fork;
@@ -1537,8 +1648,89 @@ sub CreateChild {
sigprocmask(SIG_UNBLOCK, $sigset);
ChildProcess; # Does not return.
}
+}
+# parent_client_connection:
+# Event handler that processes client connections for the parent process.
+# This sub is called when the parent is listening on a socket and
+# a connection request arrives. We must:
+# Start a child process to accept the connection request.
+# Kill our listen on the socket.
+# Setup an event to handle the child process exit. (SIGCHLD).
+# Parameter:
+# event - The event object that was created to monitor this socket.
+# event->w->fd is the socket.
+# Returns:
+# NONE
+#
+sub parent_client_connection {
+ die "DieWhenIdle processing not completely operational yet";
+
+}
+
+# parent_listen:
+# Opens a socket and starts a listen for the parent process on a client UNIX
+# domain socket.
+#
+# This involves:
+# Creating a socket for listen.
+# Removing any socket lock file
+# Adding an event handler for this socket becoming readable
+# To the parent's event dispatcher.
+# Parameters:
+# loncapa_host - LonCAPA cluster name of the host represented by the client
+# socket.
+# Returns:
+# NONE
+#
+sub parent_listen {
+ my ($loncapa_host) = @_;
+ Debug(5, "parent_listen: $loncapa_host");
+
+ my $socket = &SetupLoncListener($loncapa_host);
+ if (!$socket) {
+ die "Unable to create a listen socket for $loncapa_host";
+ }
+
+ my $lock_file = &GetLoncSocketPath().".lock";
+ unlink($lock_file); # No problem if it doesn't exist yet [startup e.g.]
+
+ Event->io(cb => &parent_client_connection,
+ poll => 'r',
+ desc => 'Parent listener unix socket',
+ fd => $socket);
+
+}
+
+
+# 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.
+#
+# Parameters:
+# NONE
+# Implicit Inputs:
+# The configuration file that has been read in by LondConnection.
+# 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();
+ }
}
+
#
# Parent process logic pass 1:
# For each entry in the hosts table, we will
@@ -1586,45 +1778,63 @@ ShowStatus("Forking node servers");
Log("CRITICAL", "--------------- Starting children ---------------");
+LondConnection::ReadConfig; # Read standard config files.
my $HostIterator = LondConnection::GetHostIterator;
-while (! $HostIterator->end()) {
- my $hostentryref = $HostIterator->get();
- CreateChild($hostentryref->[0]);
- $HostHash{$hostentryref->[0]} = $hostentryref->[4];
- $HostIterator->next();
+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 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) {
- 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);
+if ($DieWhenIdle) {
+ $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);
+ }
}
}
-
=pod
=head1 CheckKids
@@ -1774,7 +1984,7 @@ sub Restart {
Log("CRITICAL", "Restarting");
my $execdir = $perlvar{'lonDaemons'};
unlink("$execdir/logs/lonc.pid");
- exec("$execdir/lonc");
+ exec("$execdir/loncnew");
}
=pod
@@ -1791,17 +2001,33 @@ sub KillThemAll {
local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die.
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");
+ ShowStatus("Nicely Killing lonc for $serving pid = $pid");
+ Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid");
kill 'QUIT' => $pid;
- delete($ChildHash{$pid});
}
- my $execdir = $perlvar{'lonDaemons'};
- unlink("$execdir/logs/lonc.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
@@ -1811,7 +2037,15 @@ Terminate the system.
=cut
sub Terminate {
- KillThemAll;
+ &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;