version 1.18, 2006/05/10 01:08:01
|
version 1.44, 2018/12/05 23:02:38
|
Line 31
|
Line 31
|
# |
# |
|
|
use Expect; |
use Expect; |
use IPC::Open3; |
|
use IO::Select; |
use IO::Select; |
use IO::Socket; |
use IO::Socket; |
use IO::File; |
use IO::File; |
Line 45 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 61 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 127 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 134 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 144 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"); |
" mail -s '$subj' $emailto > /dev/null"); |
exit 1; |
exit 1; |
} |
} |
|
|
Line 213 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 250 sub make_new_child {
|
return; |
return; |
} else { |
} else { |
# Child can *not* return from this subroutine. |
# Child can *not* return from this subroutine. |
$SIG{INT} = 'DEFAULT'; # make SIGINT kill us as it did before |
|
|
my $ppid = getppid(); |
|
|
# unblock signals |
# unblock signals |
sigprocmask(SIG_UNBLOCK, $sigset) |
sigprocmask(SIG_UNBLOCK, $sigset) |
Line 246 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_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 |
|
# don't care we just want it gone |
|
$SIG{INT} = sub { |
|
my $pid = $command->pid(); |
|
kill('KILL'=>$pid); |
|
exit; |
|
}; |
|
|
&getmaximaoutput($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 "kill(all);reset();\n"; |
&sync($command); |
&getmaximaoutput($command); |
print $command ("display2d:false;simp:true;kill(all);\n"); |
while (my $cmd=<$client>) { |
&getmaximaoutput($command,2); |
&status('Processing command'); |
&sync($command); |
&sync($command); |
my $syntaxerr = 0; |
print $command &unescape($cmd); |
while (my $cmd=<$client>) { |
my $reply=&getmaximaoutput($command); |
&status('Processing command'); |
print $client &escape($reply)."\n"; |
print $command &unescape($cmd); |
if ($reply=~/^Error\:/) { |
my ($reply,$syntaxerr) = &getmaximaoutput($command,1); |
&logthis('Died through '.$reply); |
print $client &escape($reply)."\n"; |
$client->close(); |
if ($syntaxerr) { |
$command->hard_close(); |
last; |
exit; |
} elsif ($reply=~/^Error\:/) { |
} |
&logthis('Died through '.$reply); |
&status('Waiting for commands'); |
kill('USR1' => $ppid); |
} |
$client->close(); |
|
$command->hard_close(); |
|
exit; |
|
} |
|
&sync($command); |
|
&status('Waiting for commands'); |
|
} |
} |
} |
|
|
|
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 291 sub make_new_child {
|
Line 321 sub make_new_child {
|
my $expect=$counter.time; |
my $expect=$counter.time; |
print $command "$expect;\n"; |
print $command "$expect;\n"; |
while (1) { |
while (1) { |
my $output=&getmaximaoutput($command); |
my $output=&getmaximaoutput($command,1); |
if (($output=~/\Q$expect\E/) || ($output=~/^Error\:/)) { |
if (($output=~/\Q$expect\E/) || ($output=~/^Error\:/)) { |
return; |
return; |
} |
} |
Line 300 sub make_new_child {
|
Line 330 sub make_new_child {
|
} |
} |
|
|
sub getmaximaoutput { |
sub getmaximaoutput { |
my ($command)=@_; |
my ($command,$numcheck)=@_; |
my (undef,$error,undef,$output)=$command->expect(20, -re => '\(\%i\d+\)'); |
my $regexp = '\(\%i\d+\)'; |
|
my $syntaxerr=0; |
|
if ($numcheck) { |
|
if ($numcheck eq 2) { |
|
# command was the killall so should get a full reset on |
|
# command numbers |
|
$regexp = '(\(\%i(1)\)|[Ii]ncorrect syntax\:)'; |
|
} elsif ($command->match() =~ /\(\%i(\d+)\)/) { |
|
my $nextmatch = $1+1; |
|
$regexp = '(\(\%i'.$nextmatch.'\)|[Ii]ncorrect syntax\:)'; |
|
} |
|
} |
|
my $timeout = 20; |
|
my (undef,$error,$matched,$output) = |
|
$command->expect($timeout, -re => $regexp); |
|
|
|
if ($numcheck && lc($matched) eq 'incorrect syntax:') { |
|
$syntaxerr = 1; |
|
if (wantarray) { |
|
return ($matched,$syntaxerr); |
|
} else { |
|
return $matched; |
|
} |
|
} |
if ($error) { |
if ($error) { |
return 'Error: '.$error; |
return 'Error: '.$error; |
} |
} |
|
$output =~ s/\r+//gs; # 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; } |
my ($label)=($line=~s/^(\(\%o\d+\))//); |
if ($line=~/^[Ii]ncorrect syntax:/) { $syntaxerr = 1; next; } |
if ($label) { |
if ($line=~ /^(\(\%o\d+\))(.+)$/){ |
$label=~s/\S/ /g; |
my $label = $1; |
$line=$label.$line; |
$line = $2; |
|
$label =~s/\S/ /g; |
|
$line=$label.$line; |
|
$found_label=1; |
|
} |
|
if ($found_label) { |
|
$realoutput.=$line."\n"; |
} |
} |
$realoutput.=$line."\n"; |
|
} |
} |
return $realoutput; |
if (wantarray) { |
|
return ($realoutput,$syntaxerr); |
|
} else { |
|
return $realoutput; |
|
} |
} |
} |