--- loncom/loncnew 2003/07/15 02:07:05 1.15
+++ loncom/loncnew 2011/01/20 11:19:37 1.94
@@ -2,13 +2,12 @@
# The LearningOnline Network with CAPA
# lonc maintains the connections to remote computers
#
-# $Id: loncnew,v 1.15 2003/07/15 02:07:05 foxr Exp $
+# $Id: loncnew,v 1.94 2011/01/20 11:19:37 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.
@@ -36,50 +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.
-#
-
-# Change log:
-# $Log: loncnew,v $
-# 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 6the 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.
-#
+# - 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;
@@ -95,18 +60,7 @@ use LONCAPA::Stack;
use LONCAPA::LondConnection;
use LONCAPA::LondTransaction;
use LONCAPA::Configuration;
-use LONCAPA::HashIterator;
-
-
-#
-# 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
@@ -118,20 +72,31 @@ my %perlvar = %{$perlvarref};
#
# parent and shared variables.
-my %ChildHash; # by pid -> host.
+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.
+my %parent_handlers; # Parent signal handlers...
my $MaxConnectionCount = 10; # Will get from config later.
my $ClientConnection = 0; # Uniquifier for client events.
my $DebugLevel = 0;
-my $IdleTimeout= 3600; # Wait an hour before pruning connections.
+my $NextDebugLevel= 2; # So Sigint can toggle this.
+my $IdleTimeout= 5*60; # Seconds to wait prior to pruning connections.
+
+my $LogTransactions = 0; # When True, all transactions/replies get logged.
+my $executable = $0; # Get the full path to me.
#
# 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 $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.
my %ActiveTransactions; # LondTransactions in flight.
@@ -143,6 +108,13 @@ my $Status = ""; # Current stat
my $RecentLogEntry = "";
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 $I_am_child = 0; # True if this is the child process.
#
# The hash below gives the HTML format for log messages
@@ -150,13 +122,27 @@ my $ConnectionRetriesLeft=5; # Number of
#
my %LogFormats;
-$LogFormats{"CRITICAL"} = "CRITICAL: %s";
-$LogFormats{"SUCCESS"} = "SUCCESS: %s";
-$LogFormats{"INFO"} = "INFO: %s";
-$LogFormats{"WARNING"} = "WARNING: %s";
+$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
@@ -165,12 +151,14 @@ $LogFormats{"DEFAULT"} = " %s ";
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";
}
@@ -196,9 +184,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";
}
@@ -210,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.
@@ -233,14 +221,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;
@@ -248,7 +238,6 @@ sub GetPeername {
return $peerfile;
}
}
-#----------------------------- Timer management ------------------------
=pod
=head2 Debug
@@ -258,18 +247,20 @@ 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.
}
}
@@ -281,6 +272,7 @@ sub SocketDump {
and as what we return in a SIGUSR1
=cut
+
sub ShowStatus {
my $state = shift;
my $now = time;
@@ -291,19 +283,68 @@ 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;
-
- KillSocket($Socket);
+ 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;
+ }
+
}
+#
+# This function should be called by the child in all cases where it must
+# 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
+# is via a die with this message.
+#
+sub child_exit {
+ my ($exit_code, $message) = @_;
+
+ # Regardless of how we exit, we may need to do the lock thing:
+
+ #
+ # 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);
+ } else {
+ exit($exit_code);
+ }
+}
+#----------------------------- Timer management ------------------------
+
=pod
=head2 Tick
@@ -314,8 +355,11 @@ Invoked each timer tick.
sub Tick {
+ my ($Event) = @_;
+ my $clock_watcher = $Event->w;
+
my $client;
- ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount);
+ UpdateStatus();
# Is it time to prune connection count:
@@ -324,8 +368,14 @@ 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);
+ $IdleSeconds = 0; # Otherwise all connections get trimmed to fast.
+ UpdateStatus();
+ if(($ConnectionCount == 0)) {
+ &child_exit(0);
+
+ }
}
} else {
$IdleSeconds = 0; # Reset idle count if not idle.
@@ -333,29 +383,44 @@ sub Tick {
#
# For each inflight transaction, tick down its timeout counter.
#
- foreach $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");
- for ($i =0; $i < $Connections; $i++) {
- MakeLondConnection();
+ 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 {
- Debug(1,"Work in queue, but gave up on connections..flushing\n");
+ $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
@@ -376,7 +441,8 @@ Trigger disconnections of idle sockets.
sub SetupTimer {
Debug(6, "SetupTimer");
- Event->timer(interval => 1, debug => 1, cb => \&Tick );
+ Event->timer(interval => 1, cb => \&Tick,
+ hard => 1);
}
=pod
@@ -396,21 +462,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(); # This is a LondTransaction
- unless($reqdata eq undef) {
- Debug(9, "Queue gave request data: ".$reqdata->getRequest());
+ 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");
+ &Debug(5, "No new work requests, server connection going idle");
$IdleConnections->push($Socket);
}
}
@@ -437,6 +504,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;
@@ -456,7 +526,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");
@@ -475,7 +545,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();
@@ -500,6 +570,7 @@ sub ClientWritable {
}
} else {
$Watcher->cancel(); # A delayed request...just cancel.
+ return;
}
}
@@ -527,20 +598,25 @@ 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");
- LogPerm("S:$Client:".$Transaction->getRequest());
- unlink $Transaction->getFile();
+ 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.
@@ -556,17 +632,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",
@@ -574,7 +649,9 @@ sub StartClientReply {
cb => \&ClientWritable,
data => $data);
}
+
=pod
+
=head2 FailTransaction
Finishes a transaction with failure because the associated lond socket
@@ -584,8 +661,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:
@@ -593,11 +669,19 @@ Parameters:
The LondTransaction we are failing.
+
=cut
sub FailTransaction {
my $transaction = shift;
- Debug(1, "Failing transaction: ".$transaction->getRequest());
+
+ # If the socket is dead, that's already logged.
+
+ if ($ConnectionRetriesLeft > 0) {
+ Log("WARNING", "Failing transaction "
+ .$transaction->getLoggableRequest());
+ }
+ 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());
@@ -607,13 +691,16 @@ 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()) {
my $request = $WorkQueue->dequeue(); # This is a transaction
FailTransaction($request);
@@ -627,12 +714,15 @@ sub EmptyQueue {
Close all connections open on lond prior to exit e.g.
=cut
+
sub CloseAllLondConnections {
- foreach $Socket (keys %ActiveConnections) {
- KillSocket($Socket);
+ foreach my $Socket (keys %ActiveConnections) {
+ if(exists($ActiveTransactions{$Socket})) {
+ FailTransaction($ActiveTransactions{$Socket});
+ }
+ KillSocket($Socket);
}
}
-=cut
=pod
@@ -654,11 +744,12 @@ Parameters:
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,
@@ -671,16 +762,19 @@ sub KillSocket {
delete ($ActiveTransactions{$Socket});
}
if(exists($ActiveConnections{$Socket})) {
+ $ActiveConnections{$Socket}->cancel;
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;
+ EmptyQueue();
+ CloseAllLondConnections; # Should all already be closed but...
}
+ UpdateStatus();
}
=pod
@@ -705,6 +799,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
@@ -748,25 +853,33 @@ 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
+ # 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});
+ } 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);
@@ -774,19 +887,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
@@ -798,11 +926,23 @@ 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
+ # 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 {
@@ -810,12 +950,16 @@ 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
# here inthe first place.
- Deubg(6, "SendingRequest state encountered in readable");
+ Debug(6, "SendingRequest state encountered in readable");
$Watcher->poll("w");
$Watcher->cb(\&LondWritable);
@@ -823,7 +967,7 @@ sub LondReadable {
} else {
- # Invalid state.
+ # Invalid state.
Debug(4, "Invalid state in LondReadable");
}
}
@@ -905,20 +1049,40 @@ sub LondWritable {
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") {
- 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");
- $Watcher->cancel();
- KillSocket($Socket);
- return;
- }
# "init" is being sent...
-
-
+
} elsif ($State eq "Initialized") {
# Now that init was sent, we switch
@@ -926,40 +1090,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:
@@ -968,20 +1135,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
@@ -1000,9 +1157,12 @@ sub LondWritable {
}
}
+
=pod
=cut
+
+
sub QueueDelayed {
Debug(3,"QueueDelayed called");
@@ -1010,20 +1170,19 @@ sub QueueDelayed {
Debug(4, "Delayed path: ".$path);
opendir(DIRHANDLE, $path);
-
- @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE;
- Debug(4, "Got ".$alldelayed." delayed files");
+
+ 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);
}
@@ -1047,34 +1206,39 @@ sub MakeLondConnection {
.GetServerPort());
my $Connection = LondConnection->new(&GetServerHost(),
- &GetServerPort());
+ &GetServerPort(),
+ &GetHostId());
- if($Connection == 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 {
- $ConnectionRetriesLeft = $ConnectionRetries; # success resets the count
+
+ $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
# exchange underway.
#
my $Socket = $Connection->GetSocket();
- if($Socket == undef) {
- die "did not get a socket from the connection";
+ if($Socket eq undef) {
+ &child_exit(-1, "did not get a socket from the connection");
} else {
&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,
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:
@@ -1113,8 +1277,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());
@@ -1124,7 +1288,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,
@@ -1163,11 +1327,23 @@ 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(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...");
@@ -1198,7 +1374,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);
@@ -1209,14 +1385,26 @@ 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 eq "close_connection_exit\n") {
+ if($data =~ /\n$/) { # Request entirely read.
+ 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) {
+ Log("SUCCESS", "Transaction: '$data'"); # Transaction has \n.
+ }
my $Transaction = LondTransaction->new($data);
$Transaction->SetClient($socket);
QueueTransaction($Transaction);
@@ -1225,6 +1413,40 @@ 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.
+# Parameters:
+# $socket - The listener socket.
+# Returns:
+# NONE
+# Side Effects:
+# An event is made to watch the accepted connection.
+# Active clients hash is updated to reflect the new connection.
+# The client connection count is incremented.
+#
+sub accept_client {
+ my ($socket) = @_;
+
+ Debug(8, "Entering accept for lonc UNIX socket\n");
+ my $connection = $socket->accept(); # Accept the client connection.
+ Debug(8,"Connection request accepted from "
+ .GetPeername($connection, AF_UNIX));
+
+
+ my $description = sprintf("Connection to lonc client %d",
+ $ClientConnection);
+ Debug(9, "Creating event named: ".$description);
+ Event->io(cb => \&ClientRequest,
+ poll => 'r',
+ desc => $description,
+ data => "",
+ fd => $connection);
+ $ActiveClients{$connection} = $ClientConnection;
+ $ClientConnection++;
+}
=pod
@@ -1243,21 +1465,8 @@ sub NewClient {
my $event = shift; # Get the event parameters.
my $watcher = $event->w;
my $socket = $watcher->fd; # Get the event' socket.
- my $connection = $socket->accept(); # Accept the client connection.
- Debug(8,"Connection request accepted from "
- .GetPeername($connection, AF_UNIX));
-
- my $description = sprintf("Connection to lonc client %d",
- $ClientConnection);
- Debug(9, "Creating event named: ".$description);
- Event->io(cb => \&ClientRequest,
- poll => 'r',
- desc => $description,
- data => "",
- fd => $connection);
- $ActiveClients{$connection} = $ClientConnection;
- $ClientConnection++;
+ &accept_client($socket);
}
=pod
@@ -1267,10 +1476,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
@@ -1287,6 +1506,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.
@@ -1307,22 +1538,49 @@ 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,$SocketName) = @_;
+ if (!$host) { $host = &GetServerHost(); }
+ if (!$SocketName) { $SocketName = &GetLoncSocketPath($host); }
+
- my $socket;
- my $SocketName = GetLoncSocketPath();
unlink($SocketName);
+
+ my $socket;
unless ($socket =IO::Socket::UNIX->new(Local => $SocketName,
- Listen => 10,
+ Listen => 250,
Type => SOCK_STREAM)) {
- die "Failed to create a lonc listner socket";
+ if($I_am_child) {
+ &child_exit(-1, "Failed to create a lonc listener socket");
+ } else {
+ 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
@@ -1332,16 +1590,42 @@ 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;
my $watcher = $event->w;
Debug(2, "Reporting child status because : ".$watcher->data);
my $docdir = $perlvar{'lonDocRoot'};
- my $fh = IO::File->new(">>$docdir/lon-status/loncstatus.txt");
- print $fh $$."\t".$RemoteHost."\t".$Status."\t".
+
+ 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;
+ UpdateStatus();
}
=pod
@@ -1358,34 +1642,81 @@ 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");
+ #LogPerm("F:lonc: $$ on $RemoteHost signalled to death: "
+# ."\"$signal\"");
exit 0;
}
+
+=pod
+
+=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");
+
+}
+
+=pod
+
=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
sub ChildProcess {
+ # 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.
+
+ my $host = GetServerHost();
+ foreach my $listener (keys %parent_dispatchers) {
+ my $watcher = $parent_dispatchers{$listener};
+ my $s = $watcher->fd;
+ if ($listener ne $host) { # Close everyone but me.
+ Debug(5, "Closing listen socket for $listener");
+ $s->close();
+ }
+ Debug(5, "Killing watcher for $listener");
+
+ $watcher->cancel();
+ delete($parent_dispatchers{$listener});
+
+ }
+
+ # kill off the parent's signal handlers too!
+ #
+
+ for my $handler (keys %parent_handlers) {
+ my $watcher = $parent_handlers{$handler};
+ $watcher->cancel();
+ delete($parent_handlers{$handler});
+ }
+
+ $I_am_child = 1; # Seems like in spite of it all I may still getting
+ # parent event dispatches.. flag I'm a child.
#
# 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,
@@ -1396,48 +1727,258 @@ 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();
+ # Block the pipe signal we'll get when the socket disconnects. We detect
+ # socket disconnection via send/receive failures. On disconnect, the
+ # socket becomes readable .. which will force the disconnect detection.
+
+ my $set = POSIX::SigSet->new(SIGPIPE);
+ sigprocmask(SIG_BLOCK, $set);
+
+ # Figure out if we got passed a socket or need to open one to listen for
+ # client requests.
+
+ my ($socket) = @_;
+ if (!$socket) {
+
+ $socket = SetupLoncListener();
+ }
+ # Establish an event to listen for client connection requests.
+
+
+ Event->io(cb => \&NewClient,
+ poll => 'r',
+ desc => 'Lonc Listener Unix Socket',
+ fd => $socket);
- $Event::Debuglevel = $DebugLevel;
+ $Event::DebugLevel = $DebugLevel;
Debug(9, "Making initial lond connection for ".$RemoteHost);
# Setup the initial server connection:
- # &MakeLondConnection(); // let first work requirest do it.
+ # &MakeLondConnection(); // let first work request do it.
+ # need to accept the connection since the event may not fire.
+
+ &accept_client($socket);
Debug(9,"Entering event loop");
my $ret = Event::loop(); # Start the main event loop.
- die "Main event loop exited!!!";
+ &child_exit (-1,"Main event loop exited!!!");
}
# Create a new child for host passed in:
sub CreateChild {
+ my ($host, $hostid) = @_;
+
my $sigset = POSIX::SigSet->new(SIGINT);
sigprocmask(SIG_BLOCK, $sigset);
- my $host = shift;
$RemoteHost = $host;
+ ShowStatus('Parent keeping the flock'); # Update time in status message.
Log("CRITICAL", "Forking server for ".$host);
- $pid = fork;
+ my $pid = fork;
if($pid) { # Parent
- $ChildHash{$pid} = $RemoteHost;
+ $RemoteHost = "Parent";
+ $ChildPid{$pid} = $host;
sigprocmask(SIG_UNBLOCK, $sigset);
-
+ undef(@all_host_ids);
} else { # child.
+ $RemoteHostId = $hostid;
ShowStatus("Connected to ".$RemoteHost);
- $SIG{INT} = DEFAULT;
+ $SIG{INT} = 'DEFAULT';
sigprocmask(SIG_UNBLOCK, $sigset);
- ChildProcess; # Does not return.
+ &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.
+# Parameter:
+# event - The event object that was created to monitor this socket.
+# event->w->fd is the socket.
+# Returns:
+# NONE
+#
+sub parent_client_connection {
+ if ($I_am_child) {
+ # Should not get here, but seem to anyway:
+ &Debug(5," Child caught parent client connection event!!");
+ my ($event) = @_;
+ my $watcher = $event->w;
+ $watcher->cancel(); # Try to kill it off again!!
+ } else {
+ &Debug(9, "parent_client_connection");
+ my ($event) = @_;
+ my $watcher = $event->w;
+ my $socket = $watcher->fd;
+ 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:
+# 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,$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 = $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)",
+ 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.]
+}
+
+
+
+# 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
+# Implicit Inputs:
+# The configuration file that has been read in by LondConnection.
+# Returns:
+# NONE
+#
+sub listen_on_common_socket {
+ Debug(5, "listen_on_common_socket");
+ &parent_listen();
+}
+
+# server_died is called whenever a child process exits.
+# Since this is dispatched via a signal, we must process all
+# dead children until there are no more left. The action
+# is to:
+# - Remove the child from the bookeeping hashes
+# - Re-establish a listen on the unix domain socket associated
+# with that host.
+# Parameters:
+# The event, but we don't actually care about it.
+sub server_died {
+ &Debug(9, "server_died called...");
+
+ while(1) { # Loop until waitpid nowait fails.
+ my $pid = waitpid(-1, WNOHANG);
+ if($pid <= 0) {
+ return; # Nothing left to wait for.
+ }
+ # need the host to restart:
+
+ my $host = $ChildPid{$pid};
+ if($host) { # It's for real...
+ &Debug(9, "Caught sigchild for $host");
+ delete($ChildPid{$pid});
+ delete($ChildHost{$host});
+ &parent_clean_up($host);
+
+ } else {
+ &Debug(5, "Caught sigchild for pid not in hosts hash: $pid");
+ }
+ }
+
+}
+
#
# Parent process logic pass 1:
# For each entry in the hosts table, we will
@@ -1469,11 +2010,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;
@@ -1483,41 +2026,50 @@ ShowStatus("Forking node servers");
Log("CRITICAL", "--------------- Starting children ---------------");
-my $HostIterator = LondConnection::GetHostIterator;
-while (! $HostIterator->end()) {
+LondConnection::ReadConfig; # Read standard config files.
+
+$RemoteHost = "[parent]";
+&listen_on_common_socket();
- $hostentryref = $HostIterator->get();
- CreateChild($hostentryref->[0]);
- $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;
-
-while(1) {
- $deadchild = wait();
- if(exists $ChildHash{$deadchild}) { # need to restart.
- $deadhost = $ChildHash{$deadchild};
- 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
@@ -1538,15 +2090,59 @@ sub CheckKids {
my $now=time;
my $local=localtime($now);
print $fh "LONC status $local - parent $$ \n\n";
- foreach $pid (keys %ChildHash) {
+ foreach my $host (keys %parent_dispatchers) {
+ print $fh "LONC Parent process listening for $host\n";
+ }
+ foreach my $pid (keys %ChildPid) {
Debug(2, "Sending USR1 -> $pid");
kill 'USR1' => $pid; # Tell Child to report status.
- sleep 1; # Wait so file doesn't intermix.
}
+
}
=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");
+
+ # I'm not sure what I was thinking in the first implementation.
+ # someone will have to work hard to convince me the effect is any
+ # different than Restart, especially now that we don't start up
+ # per host servers automatically, may as well just restart.
+ # The down side is transactions that are in flight will get timed out
+ # (lost unless they are critical).
+
+ &KillThemAll();
+}
+
+
+=pod
+
=head1 Restart
Signal handler for HUP... all children are killed and
@@ -1556,11 +2152,11 @@ 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");
- exec("$execdir/lonc");
+ exec("$executable");
}
=pod
@@ -1568,25 +2164,45 @@ 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) {
- 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});
+
+ #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.");
+}
+
+
+#
+# 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 %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($ChildPid{$pid});
+ my $execdir = $perlvar{'lonDaemons'};
+ unlink("$execdir/logs/lonc.pid");
}
- my $execdir = $perlvar{'lonDaemons'};
- unlink("$execdir/logs/lonc.pid");
- ShowStatus("Killing the master process");
- Log("CRITICAL", "Killing the master process.");
}
=pod
@@ -1598,10 +2214,27 @@ Terminate the system.
=cut
sub Terminate {
- KillThemAll;
- exit;
+ &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;
+
+}
+sub my_hostname {
+ use Sys::Hostname;
+ my $name = &hostname();
+ &Debug(9,"Name is $name");
+ return $name;
}
+
=pod
=head1 Theory
@@ -1643,3 +2276,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
+
+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:
+
+Can be enabled for debugging by setting LogTransactions to nonzero.
+Indicates a successful transaction with lond, 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 :
+
+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:
+
+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
+
+Only emitted if the global variable $LogTransactions was set to true.
+A client has requested a lond transaction is the contents of the request.
+
+=item SUCCESS Toggled transaction logging
+
+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 for died thorugh signal.
+
+QUIT signal received. lonc child process is exiting.
+
+=item SUCCESS New debugging level for now
+
+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 =
+
+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 =
+
+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