version 1.11, 2003/06/25 01:54:44
|
version 1.14, 2003/07/03 02:10:18
|
Line 46
|
Line 46
|
|
|
# Change log: |
# Change log: |
# $Log$ |
# $Log$ |
|
# 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 |
# Revision 1.11 2003/06/25 01:54:44 foxr |
# Fix more problems with transaction failure. |
# Fix more problems with transaction failure. |
# |
# |
Line 71 use lib "/home/httpd/lib/perl/";
|
Line 77 use lib "/home/httpd/lib/perl/";
|
use lib "/home/foxr/newloncapa/types"; |
use lib "/home/foxr/newloncapa/types"; |
use Event qw(:DEFAULT ); |
use Event qw(:DEFAULT ); |
use POSIX qw(:signal_h); |
use POSIX qw(:signal_h); |
|
use POSIX; |
use IO::Socket; |
use IO::Socket; |
use IO::Socket::INET; |
use IO::Socket::INET; |
use IO::Socket::UNIX; |
use IO::Socket::UNIX; |
Line 89 use LONCAPA::HashIterator;
|
Line 96 use LONCAPA::HashIterator;
|
# |
# |
# Disable all signals we might receive from outside for now. |
# Disable all signals we might receive from outside for now. |
# |
# |
$SIG{QUIT} = IGNORE; |
#$SIG{QUIT} = IGNORE; |
$SIG{HUP} = IGNORE; |
#$SIG{HUP} = IGNORE; |
$SIG{USR1} = IGNORE; |
#$SIG{USR1} = IGNORE; |
$SIG{INT} = IGNORE; |
#$SIG{INT} = IGNORE; |
$SIG{CHLD} = IGNORE; |
#$SIG{CHLD} = IGNORE; |
$SIG{__DIE__} = IGNORE; |
#$SIG{__DIE__} = IGNORE; |
|
|
|
|
# Read the httpd configuration file to get perl variables |
# Read the httpd configuration file to get perl variables |
Line 128 my $WorkQueue = Queue->new(); # Qu
|
Line 135 my $WorkQueue = Queue->new(); # Qu
|
my $ConnectionCount = 0; |
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 $ConnectionRetries=5; # Number of connection retries allowed. |
my $ConnectionRetries=5; # Number of connection retries allowed. |
my $ConnectionRetriesLeft=5; # Number of connection retries remaining. |
my $ConnectionRetriesLeft=5; # Number of connection retries remaining. |
|
|
Line 204 sub Log {
|
Line 212 sub Log {
|
my $execdir = $perlvar{'lonDaemons'}; |
my $execdir = $perlvar{'lonDaemons'}; |
my $fh = IO::File->new(">>$execdir/logs/lonc.log"); |
my $fh = IO::File->new(">>$execdir/logs/lonc.log"); |
my $msg = sprintf($finalformat, $message); |
my $msg = sprintf($finalformat, $message); |
|
$RecentLogEntry = $msg; |
print $fh $msg; |
print $fh $msg; |
|
|
|
|
Line 287 Invoked each timer tick.
|
Line 296 Invoked each timer tick.
|
sub Tick { |
sub Tick { |
my $client; |
my $client; |
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount); |
ShowStatus(GetServerHost()." Connection count: ".$ConnectionCount); |
Debug(10,"Tick"); |
|
Debug(10," Current connection count: ".$ConnectionCount); |
|
foreach $client (keys %ActiveClients) { |
|
Debug(10," Have client: with id: ".$ActiveClients{$client}); |
|
} |
|
# Is it time to prune connection count: |
# Is it time to prune connection count: |
|
|
|
|
Line 523 sub StartClientReply {
|
Line 528 sub StartClientReply {
|
my $Transaction = shift; |
my $Transaction = shift; |
my $data = shift; |
my $data = shift; |
|
|
|
|
my $Client = $Transaction->getClient(); |
my $Client = $Transaction->getClient(); |
|
|
&Debug(8," Reply was: ".$data); |
&Debug(8," Reply was: ".$data); |
Line 716 sub LondReadable {
|
Line 722 sub LondReadable {
|
my $State = $Socket->GetState(); # All action depends on the state. |
my $State = $Socket->GetState(); # All action depends on the state. |
|
|
SocketDump(6, $Socket); |
SocketDump(6, $Socket); |
|
my $status = $Socket->Readable(); |
|
&Debug(2, "Socket->Readable returned: $status"); |
|
|
if($Socket->Readable() != 0) { |
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. |
# The socket has become disconnected. We fail the transaction. |
|
|
Line 982 sub QueueDelayed {
|
Line 990 sub QueueDelayed {
|
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."\ny"; # 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($cmd); |
$Transaction->SetDeferred($reqfile); |
$Transaction->SetDeferred($reqfile); |
QueueTransaction($Transaction); |
QueueTransaction($Transaction); |
Line 1285 sub SetupLoncListener {
|
Line 1293 sub SetupLoncListener {
|
fd => $socket); |
fd => $socket); |
} |
} |
|
|
|
=pod |
|
|
|
=head2 ChildStatus |
|
|
|
Child USR1 signal handler to report the most recent status |
|
into the status file. |
|
|
|
=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". |
|
$RecentLogEntry."\n"; |
|
} |
|
|
=pod |
=pod |
|
|
=head2 SignalledToDeath |
=head2 SignalledToDeath |
Line 1293 Called in response to a signal that caus
|
Line 1320 Called in response to a signal that caus
|
|
|
=cut |
=cut |
|
|
=pod |
|
|
|
sub SignalledToDeath { |
sub SignalledToDeath { |
|
my $event = shift; |
|
my $watcher= $event->w; |
|
|
|
Debug(2,"Signalled to death! via ".$watcher->data); |
my ($signal) = @_; |
my ($signal) = @_; |
chomp($signal); |
chomp($signal); |
Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost " |
Log("CRITICAL", "Abnormal exit. Child $$ for $RemoteHost " |
Line 1303 sub SignalledToDeath {
|
Line 1333 sub SignalledToDeath {
|
LogPerm("F:lonc: $$ on $RemoteHost signalled to death: " |
LogPerm("F:lonc: $$ on $RemoteHost signalled to death: " |
."\"$signal\""); |
."\"$signal\""); |
die("Signal abnormal end"); |
die("Signal abnormal end"); |
|
exit 0; |
|
|
} |
} |
=head2 ChildProcess |
=head2 ChildProcess |
Line 1314 This sub implements a child process for
|
Line 1345 This sub implements a child process for
|
sub ChildProcess { |
sub ChildProcess { |
|
|
|
|
# For now turn off signals. |
# |
|
# Signals must be handled by the Event framework... |
$SIG{QUIT} = \&SignalledToDeath; |
# |
$SIG{HUP} = IGNORE; |
# $SIG{QUIT} = \&SignalledToDeath; |
$SIG{USR1} = IGNORE; |
# $SIG{HUP} = \&ChildStatus; |
$SIG{INT} = IGNORE; |
# $SIG{USR1} = IGNORE; |
$SIG{CHLD} = IGNORE; |
# $SIG{INT} = DEFAULT; |
$SIG{__DIE__} = \&SignalledToDeath; |
# $SIG{CHLD} = IGNORE; |
|
# $SIG{__DIE__} = \&SignalledToDeath; |
|
|
|
Event->signal(signal => "QUIT", |
|
cb => \&SignalledToDeath, |
|
data => "QUIT"); |
|
Event->signal(signal => "HUP", |
|
cb => \&ChildStatus, |
|
data => "HUP"); |
|
Event->signal(signal => "USR1", |
|
cb => \&ChildStatus, |
|
data => "USR1"); |
|
|
SetupTimer(); |
SetupTimer(); |
|
|
Line 1333 sub ChildProcess {
|
Line 1375 sub ChildProcess {
|
|
|
# Setup the initial server connection: |
# Setup the initial server connection: |
|
|
# &MakeLondConnection(); // let first work requirest do it. |
# &MakeLondConnection(); // let first work requirest do it. |
|
|
|
|
Debug(9,"Entering event loop"); |
Debug(9,"Entering event loop"); |
Line 1346 sub ChildProcess {
|
Line 1388 sub ChildProcess {
|
# Create a new child for host passed in: |
# Create a new child for host passed in: |
|
|
sub CreateChild { |
sub CreateChild { |
|
my $sigset = POSIX::SigSet->new(SIGINT); |
|
sigprocmask(SIG_BLOCK, $sigset); |
my $host = shift; |
my $host = shift; |
$RemoteHost = $host; |
$RemoteHost = $host; |
Log("CRITICAL", "Forking server for ".$host); |
Log("CRITICAL", "Forking server for ".$host); |
$pid = fork; |
$pid = fork; |
if($pid) { # Parent |
if($pid) { # Parent |
$ChildHash{$pid} = $RemoteHost; |
$ChildHash{$pid} = $RemoteHost; |
|
sigprocmask(SIG_UNBLOCK, $sigset); |
|
|
} else { # child. |
} else { # child. |
ShowStatus("Connected to ".$RemoteHost); |
ShowStatus("Connected to ".$RemoteHost); |
ChildProcess; |
$SIG{INT} = DEFAULT; |
|
sigprocmask(SIG_UNBLOCK, $sigset); |
|
ChildProcess; # Does not return. |
} |
} |
|
|
} |
} |
Line 1410 while (! $HostIterator->end()) {
|
Line 1458 while (! $HostIterator->end()) {
|
CreateChild($hostentryref->[0]); |
CreateChild($hostentryref->[0]); |
$HostIterator->next(); |
$HostIterator->next(); |
} |
} |
|
$RemoteHost = "Parent Server"; |
|
|
# Maintain the population: |
# Maintain the population: |
|
|
Line 1418 ShowStatus("Parent keeping the flock");
|
Line 1467 ShowStatus("Parent keeping the flock");
|
# |
# |
# Set up parent signals: |
# Set up parent signals: |
# |
# |
$SIG{INT} = &KillThemAll; |
|
$SIG{TERM} = &KillThemAll; |
$SIG{INT} = \&Terminate; |
|
$SIG{TERM} = \&Terminate; |
|
$SIG{HUP} = \&Restart; |
|
$SIG{USR1} = \&CheckKids; |
|
|
while(1) { |
while(1) { |
$deadchild = wait(); |
$deadchild = wait(); |
Line 1432 while(1) {
|
Line 1484 while(1) {
|
CreateChild($deadhost); |
CreateChild($deadhost); |
} |
} |
} |
} |
|
|
|
|
|
|
|
=pod |
|
|
|
=head1 CheckKids |
|
|
|
Since kids do not die as easily in this implementation |
|
as the previous one, there is no need to restart the |
|
dead ones (all dead kids get restarted when they die!!) |
|
The only thing this function does is to pass USR1 to the |
|
kids so that they report their status. |
|
|
|
=cut |
|
|
|
sub CheckKids { |
|
Debug(2, "Checking status of children"); |
|
my $docdir = $perlvar{'lonDocRoot'}; |
|
my $fh = IO::File->new(">$docdir/lon-status/loncstatus.txt"); |
|
my $now=time; |
|
my $local=localtime($now); |
|
print $fh "LONC status $local - parent $$ \n\n"; |
|
foreach $pid (keys %ChildHash) { |
|
Debug(2, "Sending USR1 -> $pid"); |
|
kill 'USR1' => $pid; # Tell Child to report status. |
|
sleep 1; # Wait so file doesn't intermix. |
|
} |
|
} |
|
|
|
=pod |
|
|
|
=head1 Restart |
|
|
|
Signal handler for HUP... all children are killed and |
|
we self restart. This is an el-cheapo way to re read |
|
the config file. |
|
|
|
=cut |
|
|
|
sub Restart { |
|
KillThemAll; # First kill all the children. |
|
Log("CRITICAL", "Restarting"); |
|
my $execdir = $perlvar{'lonDaemons'}; |
|
unlink("$execdir/logs/lonc.pid"); |
|
exec("$execdir/lonc"); |
|
} |
|
|
|
=pod |
|
|
|
=head1 KillThemAll |
|
|
|
Signal handler that kills all children by sending them a |
|
SIGINT. Responds to sigint and sigterm. |
|
|
|
=cut |
|
|
sub KillThemAll { |
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}); |
|
} |
|
my $execdir = $perlvar{'lonDaemons'}; |
|
unlink("$execdir/logs/lonc.pid"); |
|
ShowStatus("Killing the master process"); |
|
Log("CRITICAL", "Killing the master process."); |
} |
} |
|
|
|
=pod |
|
|
|
=head1 Terminate |
|
|
|
Terminate the system. |
|
|
|
=cut |
|
|
|
sub Terminate { |
|
KillThemAll; |
|
exit; |
|
|
|
} |
|
=pod |
|
|
=head1 Theory |
=head1 Theory |
|
|
The event class is used to build this as a single process with an |
The event class is used to build this as a single process with an |