version 1.33, 2007/08/31 23:19:54
|
version 1.43, 2018/10/29 02:57:30
|
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 143 my $wwwid=getpwnam('www');
|
Line 156 my $wwwid=getpwnam('www');
|
if ($wwwid!=$<) { |
if ($wwwid!=$<) { |
my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; |
my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; |
my $subj="LON: User ID mismatch"; |
my $subj="LON: User ID mismatch"; |
system("echo 'User ID mismatch. lonmaxima must be run as user www.' |\ |
system("echo 'User ID mismatch. lonmaxima must be run as user www.' |". |
mailto $emailto -s '$subj' > /dev/null"); |
" mailto -s '$subj' $emailto > /dev/null"); |
exit 1; |
exit 1; |
} |
} |
|
|
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 245 sub make_new_child {
|
Line 259 sub make_new_child {
|
|
|
&logthis('New process started'); |
&logthis('New process started'); |
|
|
my $command=Expect->spawn('maxima'); |
my $command = new Expect(); |
|
$command->log_stdout(0); |
|
#$command->log_file("$execdir/logs/lonmaxima.session.log"); |
|
$command->spawn('maxima'); |
|
&getmaximaoutput($command, 2); # wait for maxima to finish initialization |
# soft/hard_close can take awhile and we really |
# soft/hard_close can take awhile and we really |
# don't care we just want it gone |
# don't care we just want it gone |
$SIG{INT} = sub { |
$SIG{INT} = sub { |
Line 254 sub make_new_child {
|
Line 272 sub make_new_child {
|
exit; |
exit; |
}; |
}; |
|
|
$command->log_stdout(0); |
|
#$command->log_file("$execdir/logs/lonmaxima.session.log"); |
|
&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'); |
my $client = $server->accept() or last; |
my $client = $server->accept() or last; |
print $command ("display2d:false;kill(all);\n"); |
&sync($command); |
|
print $command ("display2d:false;simp:true;kill(all);\n"); |
&getmaximaoutput($command,2); |
&getmaximaoutput($command,2); |
&sync($command); |
&sync($command); |
my $syntaxerr = 0; |
my $syntaxerr = 0; |
Line 274 sub make_new_child {
|
Line 290 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 300 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 318 sub getmaximaoutput {
|
Line 337 sub getmaximaoutput {
|
if ($numcheck eq 2) { |
if ($numcheck eq 2) { |
# command was the killall so should get a full reset on |
# command was the killall so should get a full reset on |
# command numbers |
# command numbers |
$regexp = '(\(\%i(1)\)|Incorrect syntax\:)'; |
$regexp = '(\(\%i(1)\)|[Ii]ncorrect syntax\:)'; |
} elsif ($command->match() =~ /\(\%i(\d+)\)/) { |
} elsif ($command->match() =~ /\(\%i(\d+)\)/) { |
my $nextmatch = $1+1; |
my $nextmatch = $1+1; |
$regexp = '(\(\%i'.$nextmatch.'\)|Incorrect syntax\:)'; |
$regexp = '(\(\%i'.$nextmatch.'\)|[Ii]ncorrect syntax\:)'; |
} |
} |
} |
} |
my $timeout = 20; |
my $timeout = 20; |
my (undef,$error,$matched,$output) = |
my (undef,$error,$matched,$output) = |
$command->expect($timeout, -re => $regexp); |
$command->expect($timeout, -re => $regexp); |
|
|
if ($numcheck && $matched eq 'Incorrect syntax:') { |
if ($numcheck && lc($matched) eq 'incorrect syntax:') { |
$syntaxerr = 1; |
$syntaxerr = 1; |
if (wantarray) { |
if (wantarray) { |
return ($matched,$syntaxerr); |
return ($matched,$syntaxerr); |
Line 339 sub getmaximaoutput {
|
Line 358 sub getmaximaoutput {
|
if ($error) { |
if ($error) { |
return 'Error: '.$error; |
return 'Error: '.$error; |
} |
} |
$output =~ s/\r+//g; # Remove Windows-style linebreaks |
$output =~ s/\r+//gs; # Remove Windows-style linebreaks |
my $foundoutput=0; |
my $foundoutput=0; |
my $found_label=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=~/^[Ii]ncorrect syntax:/) { $syntaxerr = 1; next; } |
if ($line=~ /^(\(\%o\d+\))(.+)$/){ |
if ($line=~ /^(\(\%o\d+\))(.+)$/){ |
my $label = $1; |
my $label = $1; |
$line = $2; |
$line = $2; |