--- loncom/loncnew 2004/02/09 10:58:03 1.40
+++ loncom/loncnew 2004/09/22 10:46:06 1.59
@@ -2,7 +2,7 @@
# The LearningOnline Network with CAPA
# lonc maintains the connections to remote computers
#
-# $Id: loncnew,v 1.40 2004/02/09 10:58:03 foxr Exp $
+# $Id: loncnew,v 1.59 2004/09/22 10:46:06 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -82,7 +82,7 @@ my $ClientConnection = 0; # Uniquifier f
my $DebugLevel = 0;
my $NextDebugLevel= 2; # So Sigint can toggle this.
-my $IdleTimeout= 3600; # Wait an hour before pruning connections.
+my $IdleTimeout= 600; # Wait 10 minutes before pruning connections.
my $LogTransactions = 0; # When True, all transactions/replies get logged.
@@ -103,6 +103,10 @@ my $RecentLogEntry = "";
my $ConnectionRetries=2; # Number of connection retries allowed.
my $ConnectionRetriesLeft=2; # Number of connection retries remaining.
my $LondVersion = "unknown"; # Version of lond we talk with.
+my $KeyMode = ""; # e.g. ssl, local, insecure from last connect.
+my $LondConnecting = 0; # True when a connection is being built.
+
+my $DieWhenIdle = 0; # When true children die when trimmed -> 0.
#
# The hash below gives the HTML format for log messages
@@ -110,13 +114,27 @@ my $LondVersion = "unknown"; # Versi
#
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
@@ -156,9 +174,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";
}
@@ -193,8 +211,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;
@@ -217,18 +237,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.
}
}
@@ -260,11 +282,19 @@ sub ShowStatus {
sub SocketTimeout {
my $Socket = shift;
Log("WARNING", "A socket timeout was detected");
- Debug(0, " SocketTimeout called: ");
- $Socket->Dump();
+ 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 ------------------------
@@ -278,13 +308,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:
@@ -294,6 +323,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.
@@ -312,28 +357,32 @@ sub 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(5,"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(5,"Work but no connections, Make a new one");
+ my $success;
+ $success = &MakeLondConnection;
+ if($success == 0) { # All connections failed:
Debug(5,"Work in queue failed to make any connectiouns\n");
EmptyQueue(); # Fail pending transactions with con_lost.
+ CloseAllLondConnections(); # Should all be closed but....
}
} else {
+ $LondConnecting = 0;
ShowStatus(GetServerHost()." >>> DEAD!!! <<<");
Debug(5,"Work in queue, but gave up on connections..flushing\n");
EmptyQueue(); # Connections can't be established.
+ CloseAllLondConnections(); # Should all already be closed but...
}
}
+ if ($ConnectionCount == 0) {
+ $KeyMode = "";
+ $clock_watcher->cancel();
+ }
}
=pod
@@ -374,6 +423,7 @@ 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(5, "Server to idle");
@@ -453,7 +503,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();
@@ -506,8 +556,8 @@ The transaction that is being completed.
sub CompleteTransaction {
&Debug(5,"Complete transaction");
- my $Socket = shift;
- my $Transaction = shift;
+
+ my ($Socket, $Transaction) = @_;
if (!$Transaction->isDeferred()) { # Normal transaction
my $data = $Socket->GetReply(); # Data to send.
@@ -521,7 +571,9 @@ sub CompleteTransaction {
unlink $Transaction->getFile();
}
}
+
=pod
+
=head1 StartClientReply
Initiates a reply to a client where the reply data is a parameter.
@@ -537,10 +589,10 @@ 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();
@@ -554,7 +606,9 @@ sub StartClientReply {
cb => \&ClientWritable,
data => $data);
}
+
=pod
+
=head2 FailTransaction
Finishes a transaction with failure because the associated lond socket
@@ -564,8 +618,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:
@@ -573,20 +626,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());
- }
}
@@ -614,7 +671,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
@@ -666,6 +726,7 @@ sub KillSocket {
#
if($ConnectionCount == 0) {
EmptyQueue();
+ CloseAllLondConnections; # Should all already be closed but...
}
}
@@ -740,119 +801,128 @@ transaction is in progress, the socket a
sub LondReadable {
- my $Event = shift;
- my $Watcher = $Event->w;
- my $Socket = $Watcher->data;
- my $client = undef;
+ my $Event = shift;
+ my $Watcher = $Event->w;
+ my $Socket = $Watcher->data;
+ my $client = undef;
- &Debug(6,"LondReadable called state = ".$Socket->GetState());
+ &Debug(6,"LondReadable called state = ".$Socket->GetState());
- my $State = $Socket->GetState(); # All action depends on the state.
+ my $State = $Socket->GetState(); # All action depends on the state.
- SocketDump(6, $Socket);
- my $status = $Socket->Readable();
+ SocketDump(6, $Socket);
+ my $status = $Socket->Readable();
- &Debug(2, "Socket->Readable returned: $status");
+ &Debug(2, "Socket->Readable returned: $status");
- if($status != 0) {
- # bad return from socket read. Currently this means that
- # The socket has become disconnected. We fail the transaction.
+ if($status != 0) {
+ # bad return from socket read. Currently this means that
+ # The socket has become disconnected. We fail the transaction.
- Log("WARNING",
- "Lond connection lost.");
- if(exists($ActiveTransactions{$Socket})) {
- FailTransaction($ActiveTransactions{$Socket});
- }
- $Watcher->cancel();
- KillSocket($Socket);
- $ConnectionRetriesLeft--; # Counts as connection failure
- return;
- }
- SocketDump(6,$Socket);
+ Log("WARNING",
+ "Lond connection lost.");
+ if(exists($ActiveTransactions{$Socket})) {
+ FailTransaction($ActiveTransactions{$Socket});
+ } else {
+ # Socket is connecting and failed... need to mark
+ # no longer connecting.
+
+ $LondConnecting = 0;
+ }
+ $Watcher->cancel();
+ KillSocket($Socket);
+ $ConnectionRetriesLeft--; # Counts as connection failure
+ return;
+ }
+ SocketDump(6,$Socket);
- $State = $Socket->GetState(); # Update in case of transition.
- &Debug(6, "After read, state is ".$State);
+ $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") {
+ } 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");
- $Watcher->cb(\&LondWritable);
- $Watcher->poll("w");
+ } elsif ($State eq "ChallengeReplied") {
- } elsif ($State eq "ChallengeReplied") {
+ } elsif ($State eq "RequestingVersion") {
+ # Need to ask for the version... that is writiability:
- } 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") {
+ $Watcher->cb(\&LondWritable);
+ $Watcher->poll("w");
+
+ } elsif ($State eq "ReadingVersionString") {
+ # Read the rest of the version string...
+ } elsif ($State eq "SetHost") {
+ # Need to request the actual domain get set...
+
+ $Watcher->cb(\&LondWritable);
+ $Watcher->poll("w");
+ } elsif ($State eq "HostSet") {
+ # Reading the 'ok' from the peer.
+
+ } elsif ($State eq "RequestingKey") {
# The ok was received. Now we need to request the key
# That requires us to be writable:
- $Watcher->cb(\&LondWritable);
- $Watcher->poll("w");
+ $Watcher->cb(\&LondWritable);
+ $Watcher->poll("w");
- } elsif ($State eq "ReceivingKey") {
+ } elsif ($State eq "ReceivingKey") {
- } elsif ($State eq "Idle") {
+ } elsif ($State eq "Idle") {
- # This is as good a spot as any to get the peer version
- # string:
+ # 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($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(5,"Completing transaction!!");
- CompleteTransaction($Socket,
- $ActiveTransactions{$Socket});
- } else {
- Log("SUCCESS", "Connection ".$ConnectionCount." to "
- .$RemoteHost." now ready for action");
- }
- ServerToIdle($Socket); # Next work unit or idle.
+ $ConnectionRetriesLeft = $ConnectionRetries; # success resets the count
+ $Watcher->cancel();
+ if(exists($ActiveTransactions{$Socket})) {
+ Debug(5,"Completing transaction!!");
+ CompleteTransaction($Socket,
+ $ActiveTransactions{$Socket});
+ } else {
+ Log("SUCCESS", "Connection ".$ConnectionCount." to "
+ .$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") {
+ } 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");
- $Watcher->poll("w");
- $Watcher->cb(\&LondWritable);
+ Deubg(6, "SendingRequest state encountered in readable");
+ $Watcher->poll("w");
+ $Watcher->cb(\&LondWritable);
- } elsif ($State eq "ReceivingReply") {
+ } elsif ($State eq "ReceivingReply") {
- } else {
- # Invalid state.
- Debug(4, "Invalid state in LondReadable");
- }
+ } else {
+ # Invalid state.
+ Debug(4, "Invalid state in LondReadable");
+ }
}
=pod
@@ -932,131 +1002,112 @@ sub LondWritable {
SocketDump(6,$Socket);
- if ($State eq "Connected") {
+ # 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 ($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");
- FailTransaction($ActiveTransactions{$Socket});
- $Watcher->cancel();
- KillSocket($Socket);
- return;
- }
-
- # "init" is being sent...
-
- } elsif ($State eq "Initialized") {
- # Now that init was sent, we switch
- # to watching for readability:
+ if ($State eq "Connected") {
- $Watcher->cb(\&LondReadable);
- $Watcher->poll("r");
+ # "init" is being sent...
+
+ } elsif ($State eq "Initialized") {
- } 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) {
+ # Now that init was sent, we switch
+ # to watching for readability:
- $Watcher->cancel();
- KillSocket($Socket);
- return;
- }
+ $Watcher->cb(\&LondReadable);
+ $Watcher->poll("r");
- } 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...
-
- if($Socket->Writable() != 0) {
- $Watcher->cancel();
- KillSocket($Socket);
- return;
- }
- } 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 "ChallengeReceived") {
+ # We received the challenge, now we
+ # are echoing it back. This is a no-op,
+ # we're waiting for the state to change
+
+ } 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:
- } elsif ($State eq "SetHost") {
- # Setting the remote domain...
+ $Watcher->cb(\&LondReadable);
+ $Watcher->poll("r");
- if($Socket->Writable() != 0) {
- $Watcher->cancel();
- KillSocket($Socket);
- return;
- }
- } elsif ($State eq "HostSet") {
- # Back to readable to get the ok.
+ } 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");
+ $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 "RequestingKey") {
+ # At this time we're requesting the key.
+ # again, this is essentially a no-op.
+
+ } elsif ($State eq "ReceivingKey") {
+ # Now we need to wait for the key
+ # to come back from the peer:
- }
- } elsif ($State eq "ReceivingKey") {
- # Now we need to wait for the key
- # to come back from the peer:
-
- $Watcher->cb(\&LondReadable);
- $Watcher->poll("r");
+ $Watcher->cb(\&LondReadable);
+ $Watcher->poll("r");
- } elsif ($State eq "SendingRequest") {
+ } elsif ($State eq "SendingRequest") {
- # At this time we are sending a request to the
+ # 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
+ # data to come in for a reply.
+ Debug(8,"Writable sent request/receiving reply");
+ $Watcher->cb(\&LondReadable);
+ $Watcher->poll("r");
- } elsif ($State eq "ReceivingReply") {
- # The send has completed. Wait for the
- # data to come in for a reply.
- Debug(8,"Writable sent request/receiving reply");
- $Watcher->cb(\&LondReadable);
- $Watcher->poll("r");
-
- } else {
- # Control only passes here on an error:
- # the socket state does not match any
- # of the known states... so an error
- # must be logged.
+ } else {
+ # Control only passes here on an error:
+ # the socket state does not match any
+ # of the known states... so an error
+ # must be logged.
- &Debug(4, "Invalid socket state ".$State."\n");
- }
+ &Debug(4, "Invalid socket state ".$State."\n");
+ }
}
=pod
@@ -1133,7 +1184,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:
@@ -1141,6 +1194,7 @@ sub MakeLondConnection {
}
Log("SUCESS", "Created connection ".$ConnectionCount
." to host ".GetServerHost());
+ $LondConnecting = 1; # Connection in progress.
return 1; # Return success.
}
@@ -1172,8 +1226,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());
@@ -1224,15 +1278,20 @@ sub QueueTransaction {
if(!defined $LondSocket) { # Need to queue request.
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(5,"Starting additional lond connection");
- if(MakeLondConnection() == 0) {
+ 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:
@@ -1275,7 +1334,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");
@@ -1336,10 +1395,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
@@ -1376,22 +1445,28 @@ 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;
}
#
@@ -1422,6 +1497,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;
@@ -1434,16 +1510,18 @@ sub ChildStatus {
#
# Write out information about each of the connections:
#
- 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();
- $i++;
+ 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;
}
@@ -1515,9 +1593,12 @@ sub ChildProcess {
cb => \&ToggleDebug,
data => "INT");
- SetupTimer();
- SetupLoncListener();
+ my $socket = SetupLoncListener();
+ Event->io(cb => \&NewClient,
+ poll => 'r',
+ desc => 'Lonc Listener Unix Socket',
+ fd => $socket);
$Event::Debuglevel = $DebugLevel;
@@ -1538,9 +1619,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;
@@ -1811,17 +1893,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
@@ -1831,7 +1929,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;