version 1.49, 2004/06/17 22:37:06
|
version 1.77, 2007/03/27 19:38:36
|
Line 61 use LONCAPA::LondConnection;
|
Line 61 use LONCAPA::LondConnection;
|
use LONCAPA::LondTransaction; |
use LONCAPA::LondTransaction; |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
use LONCAPA::HashIterator; |
use LONCAPA::HashIterator; |
|
use Fcntl qw(:flock); |
|
|
|
|
# Read the httpd configuration file to get perl variables |
# Read the httpd configuration file to get perl variables |
Line 75 my %perlvar = %{$perlvarref};
|
Line 76 my %perlvar = %{$perlvarref};
|
my %ChildHash; # by pid -> host. |
my %ChildHash; # by pid -> host. |
my %HostToPid; # By host -> pid. |
my %HostToPid; # By host -> pid. |
my %HostHash; # by loncapaname -> IP. |
my %HostHash; # by loncapaname -> IP. |
|
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 $MaxConnectionCount = 10; # Will get from config later. |
my $ClientConnection = 0; # Uniquifier for client events. |
my $ClientConnection = 0; # Uniquifier for client events. |
|
|
my $DebugLevel = 0; |
my $DebugLevel = 0; |
my $NextDebugLevel= 2; # So Sigint can toggle this. |
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. |
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. |
# The variables below are only used by the child processes. |
Line 100 my $ConnectionCount = 0;
|
Line 106 my $ConnectionCount = 0;
|
my $IdleSeconds = 0; # Number of seconds idle. |
my $IdleSeconds = 0; # Number of seconds idle. |
my $Status = ""; # Current status string. |
my $Status = ""; # Current status string. |
my $RecentLogEntry = ""; |
my $RecentLogEntry = ""; |
my $ConnectionRetries=2; # Number of connection retries allowed. |
my $ConnectionRetries=5; # Number of connection retries allowed. |
my $ConnectionRetriesLeft=2; # Number of connection retries remaining. |
my $ConnectionRetriesLeft=5; # Number of connection retries remaining. |
my $LondVersion = "unknown"; # Version of lond we talk with. |
my $LondVersion = "unknown"; # Version of lond we talk with. |
my $KeyMode = ""; # e.g. ssl, local, insecure from last connect. |
my $KeyMode = ""; # e.g. ssl, local, insecure from last connect. |
|
my $LondConnecting = 0; # True when a connection is being built. |
|
|
|
|
|
|
|
my $DieWhenIdle = 1; # When true children die when trimmed -> 0. |
|
my $hosts_tab = 1; # True if we are using a static hosts.tab |
|
my $I_am_child = 0; # True if this is the child process. |
|
|
# |
# |
# The hash below gives the HTML format for log messages |
# The hash below gives the HTML format for log messages |
Line 118 $LogFormats{"WARNING"} = "<font color='
|
Line 131 $LogFormats{"WARNING"} = "<font color='
|
$LogFormats{"DEFAULT"} = " %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 |
=pod |
|
|
Line 126 $LogFormats{"DEFAULT"} = " %s ";
|
Line 153 $LogFormats{"DEFAULT"} = " %s ";
|
Makes an entry into the permanent log file. |
Makes an entry into the permanent log file. |
|
|
=cut |
=cut |
|
|
sub LogPerm { |
sub LogPerm { |
my $message=shift; |
my $message=shift; |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
Line 171 sub Log {
|
Line 199 sub Log {
|
my $now = time; |
my $now = time; |
my $local = localtime($now); |
my $local = localtime($now); |
my $finalformat = "$local ($$) [$RemoteHost] [$Status] "; |
my $finalformat = "$local ($$) [$RemoteHost] [$Status] "; |
my $finalformat = $finalformat.$format."\n"; |
$finalformat = $finalformat.$format."\n"; |
|
|
# open the file and put the result. |
# open the file and put the result. |
|
|
Line 245 sub SocketDump {
|
Line 273 sub SocketDump {
|
and as what we return in a SIGUSR1 |
and as what we return in a SIGUSR1 |
|
|
=cut |
=cut |
|
|
sub ShowStatus { |
sub ShowStatus { |
my $state = shift; |
my $state = shift; |
my $now = time; |
my $now = time; |
Line 255 sub ShowStatus {
|
Line 284 sub ShowStatus {
|
|
|
=pod |
=pod |
|
|
=head 2 SocketTimeout |
=head2 SocketTimeout |
|
|
Called when an action on the socket times out. The socket is |
Called when an action on the socket times out. The socket is |
destroyed and any active transaction is failed. |
destroyed and any active transaction is failed. |
|
|
|
|
=cut |
=cut |
|
|
sub SocketTimeout { |
sub SocketTimeout { |
my $Socket = shift; |
my $Socket = shift; |
Log("WARNING", "A socket timeout was detected"); |
Log("WARNING", "A socket timeout was detected"); |
Debug(0, " SocketTimeout called: "); |
Debug(5, " SocketTimeout called: "); |
$Socket->Dump(0); |
$Socket->Dump(0); |
if(exists($ActiveTransactions{$Socket})) { |
if(exists($ActiveTransactions{$Socket})) { |
FailTransaction($ActiveTransactions{$Socket}); |
FailTransaction($ActiveTransactions{$Socket}); |
Line 274 sub SocketTimeout {
|
Line 304 sub SocketTimeout {
|
# a connection failure: |
# a connection failure: |
$ConnectionRetriesLeft--; |
$ConnectionRetriesLeft--; |
if($ConnectionRetriesLeft <= 0) { |
if($ConnectionRetriesLeft <= 0) { |
Log("CRITICAL", "Host marked dead: ".GetServerHost()); |
Log("CRITICAL", "Host marked DEAD: ".GetServerHost()); |
|
$LondConnecting = 0; |
} |
} |
|
|
} |
} |
|
# |
|
# This function should be called by the child in all cases where it must |
|
# exit. If the child process is running with the DieWhenIdle turned on |
|
# it must create a lock file for the AF_UNIX socket in order to prevent |
|
# connection requests from lonnet in the time between process exit |
|
# and the parent picking up the listen again. |
|
# 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: |
|
|
|
if($DieWhenIdle) { |
|
# |
|
# Create a lock file since there will be a time window |
|
# between our exit and the parent's picking up the listen |
|
# during which no listens will be done on the |
|
# lonnet client socket. |
|
# |
|
my $lock_file = &GetLoncSocketPath().".lock"; |
|
open(LOCK,">$lock_file"); |
|
print LOCK "Contents not important"; |
|
close(LOCK); |
|
if ($hosts_tab) { |
|
unlink(&GetLoncSocketPath()); |
|
} |
|
exit(0); |
|
} |
|
# Now figure out how we exit: |
|
|
|
if($message) { |
|
die $message; |
|
} else { |
|
exit($exit_code); |
|
} |
|
} |
#----------------------------- Timer management ------------------------ |
#----------------------------- Timer management ------------------------ |
|
|
=pod |
=pod |
Line 290 Invoked each timer tick.
|
Line 361 Invoked each timer tick.
|
|
|
|
|
sub Tick { |
sub Tick { |
|
my ($Event) = @_; |
|
my $clock_watcher = $Event->w; |
|
|
my $client; |
my $client; |
if($ConnectionRetriesLeft > 0) { |
UpdateStatus(); |
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount |
|
." Retries remaining: ".$ConnectionRetriesLeft |
|
." ($KeyMode)"); |
|
} else { |
|
ShowStatus(GetServerHost()." >> DEAD <<"); |
|
} |
|
# Is it time to prune connection count: |
# Is it time to prune connection count: |
|
|
|
|
Line 307 sub Tick {
|
Line 376 sub Tick {
|
if($IdleSeconds > $IdleTimeout) { # Prune a connection... |
if($IdleSeconds > $IdleTimeout) { # Prune a connection... |
my $Socket = $IdleConnections->pop(); |
my $Socket = $IdleConnections->pop(); |
KillSocket($Socket); |
KillSocket($Socket); |
|
$IdleSeconds = 0; # Otherwise all connections get trimmed to fast. |
|
UpdateStatus(); |
|
if(($ConnectionCount == 0) && $DieWhenIdle) { |
|
&child_exit(0); |
|
|
|
} |
} |
} |
} else { |
} else { |
$IdleSeconds = 0; # Reset idle count if not idle. |
$IdleSeconds = 0; # Reset idle count if not idle. |
Line 325 sub Tick {
|
Line 400 sub Tick {
|
# Do we have work in the queue, but no connections to service them? |
# 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. |
# If so, try to make some new connections to get things going again. |
# |
# |
|
# Note this code is dead now... |
|
# |
my $Requests = $WorkQueue->Count(); |
my $Requests = $WorkQueue->Count(); |
if (($ConnectionCount == 0) && ($Requests > 0)) { |
if (($ConnectionCount == 0) && ($Requests > 0) && (!$LondConnecting)) { |
if ($ConnectionRetriesLeft > 0) { |
if ($ConnectionRetriesLeft > 0) { |
my $Connections = ($Requests <= $MaxConnectionCount) ? |
Debug(5,"Work but no connections, Make a new one"); |
$Requests : $MaxConnectionCount; |
my $success; |
Debug(5,"Work but no connections, start ".$Connections." of them"); |
$success = &MakeLondConnection; |
my $successCount = 0; |
if($success == 0) { # All connections failed: |
for (my $i =0; $i < $Connections; $i++) { |
|
$successCount += MakeLondConnection(); |
|
} |
|
if($successCount == 0) { # All connections failed: |
|
Debug(5,"Work in queue failed to make any connectiouns\n"); |
Debug(5,"Work in queue failed to make any connectiouns\n"); |
EmptyQueue(); # Fail pending transactions with con_lost. |
EmptyQueue(); # Fail pending transactions with con_lost. |
CloseAllLondConnections(); # Should all be closed but.... |
CloseAllLondConnections(); # Should all be closed but.... |
} |
} |
} else { |
} else { |
|
$LondConnecting = 0; |
ShowStatus(GetServerHost()." >>> DEAD!!! <<<"); |
ShowStatus(GetServerHost()." >>> DEAD!!! <<<"); |
Debug(5,"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. |
EmptyQueue(); # Connections can't be established. |
Line 351 sub Tick {
|
Line 424 sub Tick {
|
} |
} |
if ($ConnectionCount == 0) { |
if ($ConnectionCount == 0) { |
$KeyMode = ""; |
$KeyMode = ""; |
|
$clock_watcher->cancel(); |
} |
} |
|
&UpdateStatus(); |
} |
} |
|
|
=pod |
=pod |
Line 472 sub ClientWritable {
|
Line 547 sub ClientWritable {
|
} else { # Partial string sent. |
} else { # Partial string sent. |
$Watcher->data(substr($Data, $result)); |
$Watcher->data(substr($Data, $result)); |
if($result == 0) { # client hung up on us!! |
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; |
$Watcher->cancel; |
$Socket->shutdown(2); |
$Socket->shutdown(2); |
$Socket->close(); |
$Socket->close(); |
Line 600 Parameters:
|
Line 675 Parameters:
|
|
|
sub FailTransaction { |
sub FailTransaction { |
my $transaction = shift; |
my $transaction = shift; |
Log("WARNING", "Failing transaction ".$transaction->getRequest()); |
|
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. |
if (!$transaction->isDeferred()) { # If the transaction is deferred we'll get to it. |
my $client = $transaction->getClient(); |
my $client = $transaction->getClient(); |
Debug(1," Replying con_lost to ".$transaction->getRequest()); |
Debug(1," Replying con_lost to ".$transaction->getRequest()); |
Line 611 sub FailTransaction {
|
Line 692 sub FailTransaction {
|
} |
} |
|
|
=pod |
=pod |
|
|
=head1 EmptyQueue |
=head1 EmptyQueue |
|
|
Fails all items in the work queue with con_lost. |
Fails all items in the work queue with con_lost. |
Note that each item in the work queue is a transaction. |
Note that each item in the work queue is a transaction. |
|
|
=cut |
=cut |
|
|
sub EmptyQueue { |
sub EmptyQueue { |
$ConnectionRetriesLeft--; # Counts as connection failure too. |
$ConnectionRetriesLeft--; # Counts as connection failure too. |
while($WorkQueue->Count()) { |
while($WorkQueue->Count()) { |
Line 632 sub EmptyQueue {
|
Line 715 sub EmptyQueue {
|
Close all connections open on lond prior to exit e.g. |
Close all connections open on lond prior to exit e.g. |
|
|
=cut |
=cut |
|
|
sub CloseAllLondConnections { |
sub CloseAllLondConnections { |
foreach my $Socket (keys %ActiveConnections) { |
foreach my $Socket (keys %ActiveConnections) { |
if(exists($ActiveTransactions{$Socket})) { |
if(exists($ActiveTransactions{$Socket})) { |
Line 640 sub CloseAllLondConnections {
|
Line 724 sub CloseAllLondConnections {
|
KillSocket($Socket); |
KillSocket($Socket); |
} |
} |
} |
} |
=cut |
|
|
|
=pod |
=pod |
|
|
Line 662 Parameters:
|
Line 745 Parameters:
|
|
|
nonzero if we are allowed to create a new connection. |
nonzero if we are allowed to create a new connection. |
|
|
|
|
=cut |
=cut |
|
|
sub KillSocket { |
sub KillSocket { |
my $Socket = shift; |
my $Socket = shift; |
|
|
Line 787 sub LondReadable {
|
Line 870 sub LondReadable {
|
"Lond connection lost."); |
"Lond connection lost."); |
if(exists($ActiveTransactions{$Socket})) { |
if(exists($ActiveTransactions{$Socket})) { |
FailTransaction($ActiveTransactions{$Socket}); |
FailTransaction($ActiveTransactions{$Socket}); |
|
} else { |
|
# Socket is connecting and failed... need to mark |
|
# no longer connecting. |
|
|
|
$LondConnecting = 0; |
} |
} |
$Watcher->cancel(); |
$Watcher->cancel(); |
KillSocket($Socket); |
KillSocket($Socket); |
Line 861 sub LondReadable {
|
Line 949 sub LondReadable {
|
.$RemoteHost." now ready for action"); |
.$RemoteHost." now ready for action"); |
} |
} |
ServerToIdle($Socket); # Next work unit or idle. |
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 |
# We need to be writable for this and probably don't belong |
# here inthe first place. |
# here inthe first place. |
|
|
Deubg(6, "SendingRequest state encountered in readable"); |
Debug(6, "SendingRequest state encountered in readable"); |
$Watcher->poll("w"); |
$Watcher->poll("w"); |
$Watcher->cb(\&LondWritable); |
$Watcher->cb(\&LondWritable); |
|
|
Line 974 sub LondWritable {
|
Line 1066 sub LondWritable {
|
" has been disconnected"); |
" has been disconnected"); |
if(exists($ActiveTransactions{$Socket})) { |
if(exists($ActiveTransactions{$Socket})) { |
FailTransaction($ActiveTransactions{$Socket}); |
FailTransaction($ActiveTransactions{$Socket}); |
|
} else { |
|
# In the process of conneting, so need to turn that off. |
|
|
|
$LondConnecting = 0; |
} |
} |
$Watcher->cancel(); |
$Watcher->cancel(); |
KillSocket($Socket); |
KillSocket($Socket); |
Line 1063 sub LondWritable {
|
Line 1159 sub LondWritable {
|
=pod |
=pod |
|
|
=cut |
=cut |
|
|
sub QueueDelayed { |
sub QueueDelayed { |
Debug(3,"QueueDelayed called"); |
Debug(3,"QueueDelayed called"); |
|
|
Line 1070 sub QueueDelayed {
|
Line 1167 sub QueueDelayed {
|
|
|
Debug(4, "Delayed path: ".$path); |
Debug(4, "Delayed path: ".$path); |
opendir(DIRHANDLE, $path); |
opendir(DIRHANDLE, $path); |
|
|
my @alldelayed = grep /\.$RemoteHost$/, readdir DIRHANDLE; |
my @all_host_ids; |
|
my $host_iterator = &LondConnection::GetHostIterator(); |
|
while (!$host_iterator->end()) { |
|
my ($host_id,$host_name) = @{$host_iterator->get()}[0,3]; |
|
if ($host_name eq $RemoteHost) { |
|
push(@all_host_ids, $host_id); |
|
} |
|
$host_iterator->next(); |
|
} |
|
my $host_id_re = '(?:'.join('|',@all_host_ids).')'; |
|
my @alldelayed = grep(/\.$host_id_re$/, readdir(DIRHANDLE)); |
closedir(DIRHANDLE); |
closedir(DIRHANDLE); |
my $dfname; |
foreach my $dfname (sort(@alldelayed)) { |
my $reqfile; |
my $reqfile = "$path/$dfname"; |
foreach $dfname (sort @alldelayed) { |
my ($host_id) = ($dfname =~ /\.([^.]*)$/); |
$reqfile = "$path/$dfname"; |
Debug(4, "queueing ".$reqfile." for $host_id"); |
Debug(4, "queueing ".$reqfile); |
|
my $Handle = IO::File->new($reqfile); |
my $Handle = IO::File->new($reqfile); |
my $cmd = <$Handle>; |
my $cmd = <$Handle>; |
chomp $cmd; # There may or may not be a newline... |
chomp $cmd; # There may or may not be a newline... |
$cmd = $cmd."\n"; # now for sure there's exactly one 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); |
$Transaction->SetDeferred($reqfile); |
QueueTransaction($Transaction); |
QueueTransaction($Transaction); |
} |
} |
Line 1121 sub MakeLondConnection {
|
Line 1227 sub MakeLondConnection {
|
# |
# |
my $Socket = $Connection->GetSocket(); |
my $Socket = $Connection->GetSocket(); |
if($Socket eq undef) { |
if($Socket eq undef) { |
die "did not get a socket from the connection"; |
&child_exit(-1, "did not get a socket from the connection"); |
} else { |
} else { |
&Debug(9,"MakeLondConnection got socket: ".$Socket); |
&Debug(9,"MakeLondConnection got socket: ".$Socket); |
} |
} |
Line 1134 sub MakeLondConnection {
|
Line 1240 sub MakeLondConnection {
|
data => $Connection, |
data => $Connection, |
desc => 'Connection to lond server'); |
desc => 'Connection to lond server'); |
$ActiveConnections{$Connection} = $event; |
$ActiveConnections{$Connection} = $event; |
|
if ($ConnectionCount == 0) { |
|
&SetupTimer; # Need to handle timeouts with connections... |
|
} |
$ConnectionCount++; |
$ConnectionCount++; |
Debug(4, "Connection count = ".$ConnectionCount); |
Debug(4, "Connection count = ".$ConnectionCount); |
if($ConnectionCount == 1) { # First Connection: |
if($ConnectionCount == 1) { # First Connection: |
Line 1142 sub MakeLondConnection {
|
Line 1250 sub MakeLondConnection {
|
} |
} |
Log("SUCESS", "Created connection ".$ConnectionCount |
Log("SUCESS", "Created connection ".$ConnectionCount |
." to host ".GetServerHost()); |
." to host ".GetServerHost()); |
|
$LondConnecting = 1; # Connection in progress. |
return 1; # Return success. |
return 1; # Return success. |
} |
} |
|
|
Line 1225 sub QueueTransaction {
|
Line 1334 sub QueueTransaction {
|
if(!defined $LondSocket) { # Need to queue request. |
if(!defined $LondSocket) { # Need to queue request. |
Debug(5,"Must queue..."); |
Debug(5,"Must queue..."); |
$WorkQueue->enqueue($requestData); |
$WorkQueue->enqueue($requestData); |
if($ConnectionCount < $MaxConnectionCount) { |
Debug(5, "Queue Transaction startnew $ConnectionCount $LondConnecting"); |
|
if(($ConnectionCount < $MaxConnectionCount) && (! $LondConnecting)) { |
|
|
if($ConnectionRetriesLeft > 0) { |
if($ConnectionRetriesLeft > 0) { |
Debug(5,"Starting additional lond connection"); |
Debug(5,"Starting additional lond connection"); |
if(MakeLondConnection() == 0) { |
if(&MakeLondConnection() == 0) { |
EmptyQueue(); # Fail transactions, can't make connection. |
EmptyQueue(); # Fail transactions, can't make connection. |
CloseAllLondConnections; # Should all be closed but... |
CloseAllLondConnections; # Should all be closed but... |
} |
} |
} else { |
} else { |
ShowStatus(GetServerHost()." >>> DEAD !!!! <<<"); |
ShowStatus(GetServerHost()." >>> DEAD !!!! <<<"); |
|
$LondConnecting = 0; |
EmptyQueue(); # It's worse than that ... he's dead Jim. |
EmptyQueue(); # It's worse than that ... he's dead Jim. |
CloseAllLondConnections; # Should all be closed but.. |
CloseAllLondConnections; # Should all be closed but.. |
} |
} |
Line 1297 sub ClientRequest {
|
Line 1409 sub ClientRequest {
|
|
|
} |
} |
|
|
|
# |
|
# Accept a connection request for a client (lonc child) and |
|
# start up an event watcher to keep an eye on input from that |
|
# Event. This can be called both from NewClient and from |
|
# ChildProcess if we are started in DieWhenIdle mode. |
|
# 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 |
=pod |
|
|
Line 1315 sub NewClient {
|
Line 1461 sub NewClient {
|
my $event = shift; # Get the event parameters. |
my $event = shift; # Get the event parameters. |
my $watcher = $event->w; |
my $watcher = $event->w; |
my $socket = $watcher->fd; # Get the event' socket. |
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)); |
|
|
|
|
&accept_client($socket); |
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 |
=pod |
Line 1339 sub NewClient {
|
Line 1472 sub NewClient {
|
Returns the name of the UNIX socket on which to listen for client |
Returns the name of the UNIX socket on which to listen for client |
connections. |
connections. |
|
|
|
=head2 Parameters: |
|
|
|
host (optional) - Name of the host socket to return.. defaults to |
|
the return from GetServerHost(). |
|
|
=cut |
=cut |
|
|
sub GetLoncSocketPath { |
sub GetLoncSocketPath { |
return $UnixSocketDir."/".GetServerHost(); |
|
|
my $host = GetServerHost(); # Default host. |
|
if (@_) { |
|
($host) = @_; # Override if supplied. |
|
} |
|
return $UnixSocketDir."/".$host; |
} |
} |
|
|
=pod |
=pod |
Line 1379 connection. The event handler establish
|
Line 1522 connection. The event handler establish
|
(creating a communcations channel), that int turn will establish |
(creating a communcations channel), that int turn will establish |
another event handler to subess requests. |
another event handler to subess requests. |
|
|
|
=head2 Parameters: |
|
|
|
host (optional) Name of the host to set up a unix socket to. |
|
|
=cut |
=cut |
|
|
sub SetupLoncListener { |
sub SetupLoncListener { |
|
|
|
my $host = GetServerHost(); # Default host. |
|
if (@_) { |
|
($host) = @_ # Override host with parameter. |
|
} |
|
|
my $socket; |
my $socket; |
my $SocketName = GetLoncSocketPath(); |
my $SocketName = GetLoncSocketPath($host); |
unlink($SocketName); |
unlink($SocketName); |
unless ($socket =IO::Socket::UNIX->new(Local => $SocketName, |
unless ($socket =IO::Socket::UNIX->new(Local => $SocketName, |
Listen => 10, |
Listen => 250, |
Type => SOCK_STREAM)) { |
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, |
return $socket; |
poll => 'r', |
|
desc => 'Lonc listener Unix Socket', |
|
fd => $socket); |
|
} |
} |
|
|
# |
# |
Line 1424 into the status file.
|
Line 1577 into the status file.
|
|
|
We also use this to reset the retries count in order to allow the |
We also use this to reset the retries count in order to allow the |
client to retry connections with a previously dead server. |
client to retry connections with a previously dead server. |
|
|
=cut |
=cut |
|
|
sub ChildStatus { |
sub ChildStatus { |
Line 1432 sub ChildStatus {
|
Line 1586 sub ChildStatus {
|
|
|
Debug(2, "Reporting child status because : ".$watcher->data); |
Debug(2, "Reporting child status because : ".$watcher->data); |
my $docdir = $perlvar{'lonDocRoot'}; |
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"; |
$RecentLogEntry."\n"; |
# |
# |
# Write out information about each of the connections: |
# Write out information about each of the connections: |
# |
# |
if ($DebugLevel > 2) { |
if ($DebugLevel > 2) { |
print $fh "Active connection statuses: \n"; |
print LOG "Active connection statuses: \n"; |
my $i = 1; |
my $i = 1; |
print STDERR "================================= Socket Status Dump:\n"; |
print STDERR "================================= Socket Status Dump:\n"; |
foreach my $item (keys %ActiveConnections) { |
foreach my $item (keys %ActiveConnections) { |
my $Socket = $ActiveConnections{$item}->data; |
my $Socket = $ActiveConnections{$item}->data; |
my $state = $Socket->GetState(); |
my $state = $Socket->GetState(); |
print $fh "Connection $i State: $state\n"; |
print LOG "Connection $i State: $state\n"; |
print STDERR "---------------------- Connection $i \n"; |
print STDERR "---------------------- Connection $i \n"; |
$Socket->Dump(-1); # Ensure it gets dumped.. |
$Socket->Dump(-1); # Ensure it gets dumped.. |
$i++; |
$i++; |
} |
} |
} |
} |
|
flock(LOG,LOCK_UN); |
|
close(LOG); |
$ConnectionRetriesLeft = $ConnectionRetries; |
$ConnectionRetriesLeft = $ConnectionRetries; |
|
UpdateStatus(); |
} |
} |
|
|
=pod |
=pod |
Line 1472 sub SignalledToDeath {
|
Line 1631 sub SignalledToDeath {
|
chomp($signal); |
chomp($signal); |
Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost " |
Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost " |
."died through "."\"$signal\""); |
."died through "."\"$signal\""); |
LogPerm("F:lonc: $$ on $RemoteHost signalled to death: " |
#LogPerm("F:lonc: $$ on $RemoteHost signalled to death: " |
."\"$signal\""); |
# ."\"$signal\""); |
exit 0; |
exit 0; |
|
|
} |
} |
|
|
|
=pod |
|
|
=head2 ToggleDebug |
=head2 ToggleDebug |
|
|
This sub toggles trace debugging on and off. |
This sub toggles trace debugging on and off. |
Line 1493 sub ToggleDebug {
|
Line 1654 sub ToggleDebug {
|
|
|
} |
} |
|
|
|
=pod |
|
|
=head2 ChildProcess |
=head2 ChildProcess |
|
|
This sub implements a child process for a single lonc daemon. |
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 |
=cut |
|
|
sub ChildProcess { |
sub ChildProcess { |
|
# If we are in DieWhenIdle mode, 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... |
# Signals must be handled by the Event framework... |
# |
# |
|
|
Event->signal(signal => "QUIT", |
Event->signal(signal => "QUIT", |
cb => \&SignalledToDeath, |
cb => \&SignalledToDeath, |
Line 1521 sub ChildProcess {
|
Line 1718 sub ChildProcess {
|
cb => \&ToggleDebug, |
cb => \&ToggleDebug, |
data => "INT"); |
data => "INT"); |
|
|
SetupTimer(); |
# Figure out if we got passed a socket or need to open one to listen for |
|
# client requests. |
SetupLoncListener(); |
|
|
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); |
Debug(9, "Making initial lond connection for ".$RemoteHost); |
|
|
# Setup the initial server connection: |
# Setup the initial server connection: |
|
|
# &MakeLondConnection(); // let first work requirest do it. |
# &MakeLondConnection(); // let first work request do it. |
|
|
|
# If We are in diwhenidle, need to accept the connection since the |
|
# event may not fire. |
|
|
|
if ($DieWhenIdle) { |
|
&accept_client($socket); |
|
} |
|
|
Debug(9,"Entering event loop"); |
Debug(9,"Entering event loop"); |
my $ret = Event::loop(); # Start the main 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: |
# Create a new child for host passed in: |
|
|
sub CreateChild { |
sub CreateChild { |
|
my ($host, $socket) = @_; |
|
|
my $sigset = POSIX::SigSet->new(SIGINT); |
my $sigset = POSIX::SigSet->new(SIGINT); |
sigprocmask(SIG_BLOCK, $sigset); |
sigprocmask(SIG_BLOCK, $sigset); |
my $host = shift; |
|
$RemoteHost = $host; |
$RemoteHost = $host; |
Log("CRITICAL", "Forking server for ".$host); |
Log("CRITICAL", "Forking server for ".$host); |
my $pid = fork; |
my $pid = fork; |
Line 1560 sub CreateChild {
|
Line 1776 sub CreateChild {
|
ShowStatus("Connected to ".$RemoteHost); |
ShowStatus("Connected to ".$RemoteHost); |
$SIG{INT} = 'DEFAULT'; |
$SIG{INT} = 'DEFAULT'; |
sigprocmask(SIG_UNBLOCK, $sigset); |
sigprocmask(SIG_UNBLOCK, $sigset); |
ChildProcess; # Does not return. |
if(defined $socket) { |
|
&ChildProcess($socket); |
|
} else { |
|
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; |
|
if ($hosts_tab) { |
|
|
|
# Lookup the host associated with this socket: |
|
|
|
my $host = $listening_to{$socket}; |
|
|
|
# Start the child: |
|
|
|
|
|
|
|
&Debug(9,"Creating child for $host (parent_client_connection)"); |
|
&CreateChild($host, $socket); |
|
|
|
# Clean up the listen since now the child takes over until it exits. |
|
|
|
$watcher->cancel(); # Nolonger listening to this event |
|
delete($listening_to{$socket}); |
|
delete($parent_dispatchers{$host}); |
|
$socket->close(); |
|
|
|
} else { |
|
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, 1, 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)"); |
|
&CreateChild($data); |
|
|
|
# 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 = &SetupLoncListener($loncapa_host); |
|
$listening_to{$socket} = $loncapa_host; |
|
if (!$socket) { |
|
die "Unable to create a listen socket for $loncapa_host"; |
|
} |
|
|
|
my $lock_file = &GetLoncSocketPath($loncapa_host).".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(5, "parent_clean_up: $loncapa_host"); |
|
|
|
my $socket_file = &GetLoncSocketPath($loncapa_host); |
|
unlink($socket_file); # No problem if it doesn't exist yet [startup e.g.] |
|
my $lock_file = $socket_file.".lock"; |
|
unlink($lock_file); # No problem if it doesn't exist yet [startup e.g.] |
|
} |
|
|
|
|
|
# listen_on_all_unix_sockets: |
|
# This sub initiates a listen on all unix domain lonc client sockets. |
|
# This will be called in the case where we are trimming idle processes. |
|
# When idle processes are trimmed, loncnew starts up with no children, |
|
# and only spawns off children when a connection request occurs on the |
|
# client unix socket. The spawned child continues to run until it has |
|
# been idle a while at which point it eventually exits and once more |
|
# the parent picks up the listen. |
|
# |
|
# 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->[3]; |
|
Debug(9, "Listen for $host_name"); |
|
&parent_listen($host_name); |
|
$host_iterator->next(); |
|
} |
|
} |
|
|
|
sub listen_on_common_socket { |
|
Debug(5, "listen_on_common_socket"); |
|
&parent_listen('common'); |
|
} |
|
|
|
# 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 = $ChildHash{$pid}; |
|
if($host) { # It's for real... |
|
&Debug(9, "Caught sigchild for $host"); |
|
delete($ChildHash{$pid}); |
|
delete($HostToPid{$host}); |
|
if ($hosts_tab) { |
|
&parent_listen($host); |
|
} else { |
|
&parent_clean_up($host); |
|
} |
|
|
|
} else { |
|
&Debug(5, "Caught sigchild for pid not in hosts hash: $pid"); |
|
} |
} |
} |
|
|
} |
} |
|
|
# |
# |
# Parent process logic pass 1: |
# Parent process logic pass 1: |
# For each entry in the hosts table, we will |
# For each entry in the hosts table, we will |
Line 1613 Log("CRITICAL", "--------------- Startin
|
Line 2039 Log("CRITICAL", "--------------- Startin
|
|
|
LondConnection::ReadConfig; # Read standard config files. |
LondConnection::ReadConfig; # Read standard config files. |
my $HostIterator = LondConnection::GetHostIterator; |
my $HostIterator = LondConnection::GetHostIterator; |
while (! $HostIterator->end()) { |
|
|
|
my $hostentryref = $HostIterator->get(); |
if ($DieWhenIdle) { |
CreateChild($hostentryref->[0]); |
$RemoteHost = "[parent]"; |
$HostHash{$hostentryref->[0]} = $hostentryref->[4]; |
if ($hosts_tab) { |
$HostIterator->next(); |
&listen_on_all_unix_sockets(); |
|
} else { |
|
&listen_on_common_socket(); |
|
} |
|
} else { |
|
|
|
while (! $HostIterator->end()) { |
|
|
|
my $hostentryref = $HostIterator->get(); |
|
CreateChild($hostentryref->[0]); |
|
$HostHash{$hostentryref->[0]} = $hostentryref->[4]; |
|
$HostIterator->next(); |
|
} |
} |
} |
|
|
$RemoteHost = "Parent Server"; |
$RemoteHost = "Parent Server"; |
|
|
# Maintain the population: |
# Maintain the population: |
|
|
ShowStatus("Parent keeping the flock"); |
ShowStatus("Parent keeping the flock"); |
|
|
# |
|
# Set up parent signals: |
|
# |
|
|
|
$SIG{INT} = \&Terminate; |
if ($DieWhenIdle) { |
$SIG{TERM} = \&Terminate; |
# We need to setup a SIGChild event to handle the exit (natural or otherwise) |
$SIG{HUP} = \&Restart; |
# of the children. |
$SIG{USR1} = \&CheckKids; |
|
$SIG{USR2} = \&UpdateKids; # LonManage update request. |
Event->signal(cb => \&server_died, |
|
desc => "Child exit handler", |
while(1) { |
signal => "CHLD"); |
my $deadchild = wait(); |
|
if(exists $ChildHash{$deadchild}) { # need to restart. |
|
my $deadhost = $ChildHash{$deadchild}; |
# Set up all the other signals we set up. We'll vector them off to the |
delete($HostToPid{$deadhost}); |
# same subs as we would for DieWhenIdle false and, if necessary, conditionalize |
delete($ChildHash{$deadchild}); |
# the code there. |
Log("WARNING","Lost child pid= ".$deadchild. |
|
"Connected to host ".$deadhost); |
$parent_handlers{INT} = Event->signal(cb => \&Terminate, |
Log("INFO", "Restarting child procesing ".$deadhost); |
desc => "Parent INT handler", |
CreateChild($deadhost); |
signal => "INT"); |
|
$parent_handlers{TERM} = Event->signal(cb => \&Terminate, |
|
desc => "Parent TERM handler", |
|
signal => "TERM"); |
|
if ($hosts_tab) { |
|
$parent_handlers{HUP} = Event->signal(cb => \&Restart, |
|
desc => "Parent HUP handler.", |
|
signal => "HUP"); |
|
} else { |
|
$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"; |
|
|
|
|
|
} else { |
|
# |
|
# Set up parent signals: |
|
# |
|
|
|
$SIG{INT} = \&Terminate; |
|
$SIG{TERM} = \&Terminate; |
|
if ($hosts_tab) { |
|
$SIG{HUP} = \&Restart; |
|
} else { |
|
$SIG{HUP} = \&KillThemAll; |
|
} |
|
$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 |
=pod |
|
|
=head1 CheckKids |
=head1 CheckKids |
Line 1670 sub CheckKids {
|
Line 2157 sub CheckKids {
|
my $now=time; |
my $now=time; |
my $local=localtime($now); |
my $local=localtime($now); |
print $fh "LONC status $local - parent $$ \n\n"; |
print $fh "LONC status $local - parent $$ \n\n"; |
|
foreach my $host (keys %parent_dispatchers) { |
|
print $fh "LONC Parent process listening for $host\n"; |
|
} |
foreach my $pid (keys %ChildHash) { |
foreach my $pid (keys %ChildHash) { |
Debug(2, "Sending USR1 -> $pid"); |
Debug(2, "Sending USR1 -> $pid"); |
kill 'USR1' => $pid; # Tell Child to report status. |
kill 'USR1' => $pid; # Tell Child to report status. |
sleep 1; # Wait so file doesn't intermix. |
|
} |
} |
|
|
} |
} |
|
|
=pod |
=pod |
Line 1707 sub UpdateKids {
|
Line 2197 sub UpdateKids {
|
|
|
Log("INFO", "Updating connections via SIGUSR2"); |
Log("INFO", "Updating connections via SIGUSR2"); |
|
|
# Just in case we need to kill our own lonc, we wait a few seconds to |
# I'm not sure what I was thinking in the first implementation. |
# give it a chance to receive and relay lond's response to the |
# someone will have to work hard to convince me the effect is any |
# re-init command. |
# 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 |
sleep(2); # Wait a couple of seconds. |
# (lost unless they are critical). |
|
|
my %hosts; # Indexed by loncapa hostname, value=ip. |
if ($hosts_tab) { |
|
&Restart(); |
# Need to re-read the host table: |
} else { |
|
&KillThemAll(); |
|
|
LondConnection::ReadConfig(); |
|
my $I = LondConnection::GetHostIterator; |
|
while (! $I->end()) { |
|
my $item = $I->get(); |
|
$hosts{$item->[0]} = $item->[4]; |
|
$I->next(); |
|
} |
|
|
|
# The logic below is written for clarity not for efficiency. |
|
# Since I anticipate that this function is only rarely called, that's |
|
# appropriate. There are certainly ways to combine the loops below, |
|
# and anyone wishing to obscure the logic is welcome to go for it. |
|
# Note that we don't re-direct sigchild. Instead we do what's needed |
|
# to the data structures that keep track of children to ensure that |
|
# when sigchild is honored, no new child is born. |
|
# |
|
|
|
# For each existing child; if it's host doesn't exist, kill the child. |
|
|
|
foreach my $child (keys %ChildHash) { |
|
my $oldhost = $ChildHash{$child}; |
|
if (!(exists $hosts{$oldhost})) { |
|
Log("CRITICAL", "Killing child for $oldhost host no longer exists"); |
|
delete $ChildHash{$child}; |
|
delete $HostToPid{$oldhost}; |
|
kill 'QUIT' => $child; |
|
} |
|
} |
|
# For each remaining existing child; if it's host's ip has changed, |
|
# Restart the child on the new IP. |
|
|
|
foreach my $child (keys %ChildHash) { |
|
my $oldhost = $ChildHash{$child}; |
|
my $oldip = $HostHash{$oldhost}; |
|
if ($hosts{$oldhost} ne $oldip) { |
|
|
|
# kill the old child. |
|
|
|
Log("CRITICAL", "Killing child for $oldhost host ip has changed..."); |
|
delete $ChildHash{$child}; |
|
delete $HostToPid{$oldhost}; |
|
kill 'QUIT' => $child; |
|
|
|
# Do the book-keeping needed to start a new child on the |
|
# new ip. |
|
|
|
$HostHash{$oldhost} = $hosts{$oldhost}; |
|
CreateChild($oldhost); |
|
} |
|
} |
|
# Finally, for each new host, not in the host hash, create a |
|
# enter the host and create a new child. |
|
# Force a status display of any existing process. |
|
|
|
foreach my $host (keys %hosts) { |
|
if(!(exists $HostHash{$host})) { |
|
Log("INFO", "New host $host discovered in hosts.tab..."); |
|
$HostHash{$host} = $hosts{$host}; |
|
CreateChild($host); |
|
} else { |
|
kill 'HUP' => $HostToPid{$host}; # status display. |
|
} |
|
} |
} |
} |
} |
|
|
Line 1800 sub Restart {
|
Line 2227 sub Restart {
|
Log("CRITICAL", "Restarting"); |
Log("CRITICAL", "Restarting"); |
my $execdir = $perlvar{'lonDaemons'}; |
my $execdir = $perlvar{'lonDaemons'}; |
unlink("$execdir/logs/lonc.pid"); |
unlink("$execdir/logs/lonc.pid"); |
exec("$execdir/loncnew"); |
exec("$executable"); |
} |
} |
|
|
=pod |
=pod |
Line 1817 sub KillThemAll {
|
Line 2244 sub KillThemAll {
|
local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die. |
local($SIG{CHLD}) = 'IGNORE'; # Our children >will< die. |
foreach my $pid (keys %ChildHash) { |
foreach my $pid (keys %ChildHash) { |
my $serving = $ChildHash{$pid}; |
my $serving = $ChildHash{$pid}; |
Debug(2, "Killing lonc for $serving pid = $pid"); |
ShowStatus("Nicely Killing lonc for $serving pid = $pid"); |
ShowStatus("Killing lonc for $serving pid = $pid"); |
Log("CRITICAL", "Nicely Killing lonc for $serving pid = $pid"); |
Log("CRITICAL", "Killing lonc for $serving pid = $pid"); |
|
kill 'QUIT' => $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 |
=pod |
Line 1837 Terminate the system.
|
Line 2279 Terminate the system.
|
=cut |
=cut |
|
|
sub Terminate { |
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"); |
Log("CRITICAL","Master process exiting"); |
exit 0; |
exit 0; |
|
|