version 1.30, 2007/06/12 23:48:45
|
version 1.36, 2007/11/09 18:54:46
|
Line 44 use strict;
|
Line 44 use strict;
|
# global variables |
# global variables |
my $PREFORK = 5; # number of children to maintain |
my $PREFORK = 5; # number of children to maintain |
my $MAX_CLIENTS_PER_CHILD = 50; # number of clients each child should process |
my $MAX_CLIENTS_PER_CHILD = 50; # number of clients each child should process |
|
my $extra_children = 0; |
my %children = (); # keys are current child process IDs |
my %children = (); # keys are current child process IDs |
my $children = 0; # current number of children |
my $children = 0; # current number of children |
my $status; # string for current status |
my $status; # string for current status |
Line 60 sub REAPER { # ta
|
Line 61 sub REAPER { # ta
|
# and MAXIMA processes |
# and MAXIMA processes |
$SIG{CHLD} = \&REAPER; |
$SIG{CHLD} = \&REAPER; |
my $pid = wait; |
my $pid = wait; |
$children--; |
if (exists($children{$pid})) { |
delete($children{$pid}); |
$children--; |
|
delete($children{$pid}); |
|
if ($extra_children) { |
|
$extra_children--; |
|
} |
|
} |
} |
} |
|
|
sub HUNTSMAN { # signal handler for SIGINT |
sub HUNTSMAN { # signal handler for SIGINT |
Line 126 sub catchexception {
|
Line 132 sub catchexception {
|
} |
} |
|
|
|
|
|
sub child_announce_death { |
|
$SIG{USR1} = \&child_announce_death; |
|
if ($extra_children < $PREFORK*10) { |
|
$extra_children++; |
|
} |
|
} |
|
|
# ---------------------------------------------------------------- Main program |
# ---------------------------------------------------------------- Main program |
# -------------------------------- Set signal handlers to record abnormal exits |
# -------------------------------- Set signal handlers to record abnormal exits |
Line 133 sub catchexception {
|
Line 145 sub catchexception {
|
|
|
$SIG{'QUIT'}=\&catchexception; |
$SIG{'QUIT'}=\&catchexception; |
$SIG{__DIE__}=\&catchexception; |
$SIG{__DIE__}=\&catchexception; |
|
$SIG{USR1} = \&child_announce_death; |
|
|
# ---------------------------------- Read loncapa_apache.conf and loncapa.conf |
# ---------------------------------- Read loncapa_apache.conf and loncapa.conf |
&status("Read loncapa.conf and loncapa_apache.conf"); |
&status("Read loncapa.conf and loncapa_apache.conf"); |
Line 212 for (1 .. $PREFORK) {
|
Line 225 for (1 .. $PREFORK) {
|
while (1) { |
while (1) { |
&status('Parent process, sleeping'); |
&status('Parent process, sleeping'); |
sleep; # wait for a signal (i.e., child's death) |
sleep; # wait for a signal (i.e., child's death) |
for (my $i = $children; $i < $PREFORK; $i++) { |
for (my $i = $children; $i < $PREFORK+$extra_children; $i++) { |
&status('Parent process, starting child'); |
&status('Parent process, starting child'); |
&make_new_child($server); # top up the child pool |
&make_new_child($server); # top up the child pool |
} |
} |
Line 238 sub make_new_child {
|
Line 251 sub make_new_child {
|
} else { |
} else { |
# Child can *not* return from this subroutine. |
# Child can *not* return from this subroutine. |
|
|
|
my $ppid = getppid(); |
|
|
# unblock signals |
# unblock signals |
sigprocmask(SIG_UNBLOCK, $sigset) |
sigprocmask(SIG_UNBLOCK, $sigset) |
Line 256 sub make_new_child {
|
Line 270 sub make_new_child {
|
|
|
$command->log_stdout(0); |
$command->log_stdout(0); |
#$command->log_file("$execdir/logs/lonmaxima.session.log"); |
#$command->log_file("$execdir/logs/lonmaxima.session.log"); |
&getmaximaoutput($command); |
&sync($command); |
|
|
for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { |
for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { |
&status('Accepting connections'); |
&status('Accepting connections'); |
Line 274 sub make_new_child {
|
Line 288 sub make_new_child {
|
last; |
last; |
} elsif ($reply=~/^Error\:/) { |
} elsif ($reply=~/^Error\:/) { |
&logthis('Died through '.$reply); |
&logthis('Died through '.$reply); |
|
kill('USR1' => $ppid); |
$client->close(); |
$client->close(); |
$command->hard_close(); |
$command->hard_close(); |
exit; |
exit; |
Line 283 sub make_new_child {
|
Line 298 sub make_new_child {
|
} |
} |
} |
} |
|
|
|
kill('USR1' => $ppid); |
|
print $command ("quit();\n"); |
# tidy up gracefully and finish |
# tidy up gracefully and finish |
|
sleep(15); |
$command->soft_close(); |
$command->soft_close(); |
|
|
# this exit is VERY important, otherwise the child will become |
# this exit is VERY important, otherwise the child will become |
Line 341 sub getmaximaoutput {
|
Line 358 sub getmaximaoutput {
|
} |
} |
$output =~ s/\r+//g; # Remove Windows-style linebreaks |
$output =~ s/\r+//g; # Remove Windows-style linebreaks |
my $foundoutput=0; |
my $foundoutput=0; |
|
my $found_label=0; |
my $realoutput=''; |
my $realoutput=''; |
foreach my $line (split(/\n/,$output)) { |
foreach my $line (split(/\n/,$output)) { |
if ($line=~/\;/) { $foundoutput=1; next; } |
if ($line=~/\;/) { $foundoutput=1; next; } |
if (!$foundoutput) { next; } |
if (!$foundoutput) { next; } |
if ($line=~/^Incorrect syntax:/) { $syntaxerr = 1; next; } |
if ($line=~/^Incorrect syntax:/) { $syntaxerr = 1; next; } |
(my $label, $line) = ($line=~ /^(\(\%o\d+\))(.+)$/); |
if ($line=~ /^(\(\%o\d+\))(.+)$/){ |
if ($label) { |
my $label = $1; |
$label=~s/\S/ /g; |
$line = $2; |
|
$label =~s/\S/ /g; |
$line=$label.$line; |
$line=$label.$line; |
|
$found_label=1; |
|
} |
|
if ($found_label) { |
|
$realoutput.=$line."\n"; |
} |
} |
$realoutput.=$line."\n"; |
|
} |
} |
if (wantarray) { |
if (wantarray) { |
return ($realoutput,$syntaxerr); |
return ($realoutput,$syntaxerr); |