--- loncom/lonmaxima 2007/08/03 18:18:05 1.32
+++ loncom/lonmaxima 2024/06/22 14:29:36 1.45
@@ -3,7 +3,7 @@
# The LearningOnline Network with CAPA
# Connect to MAXIMA CAS
#
-# $Id: lonmaxima,v 1.32 2007/08/03 18:18:05 albertel Exp $
+# $Id: lonmaxima,v 1.45 2024/06/22 14:29:36 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -44,6 +44,7 @@ use strict;
# global variables
my $PREFORK = 5; # number of children to maintain
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 = 0; # current number of children
my $status; # string for current status
@@ -60,8 +61,13 @@ sub REAPER { # ta
# and MAXIMA processes
$SIG{CHLD} = \&REAPER;
my $pid = wait;
- $children--;
- delete($children{$pid});
+ if (exists($children{$pid})) {
+ $children--;
+ delete($children{$pid});
+ if ($extra_children) {
+ $extra_children--;
+ }
+ }
}
sub HUNTSMAN { # signal handler for SIGINT
@@ -126,6 +132,12 @@ sub catchexception {
}
+sub child_announce_death {
+ $SIG{USR1} = \&child_announce_death;
+ if ($extra_children < $PREFORK*10) {
+ $extra_children++;
+ }
+}
# ---------------------------------------------------------------- Main program
# -------------------------------- Set signal handlers to record abnormal exits
@@ -133,6 +145,7 @@ sub catchexception {
$SIG{'QUIT'}=\&catchexception;
$SIG{__DIE__}=\&catchexception;
+$SIG{USR1} = \&child_announce_death;
# ---------------------------------- Read loncapa_apache.conf and loncapa.conf
&status("Read loncapa.conf and loncapa_apache.conf");
@@ -141,10 +154,10 @@ $SIG{__DIE__}=\&catchexception;
# ----------------------------- Make sure this process is running from user=www
my $wwwid=getpwnam('www');
if ($wwwid!=$<) {
- my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
+ my $emailto="$perlvar{'lonAdmEMail'} $perlvar{'lonSysEMail'}";
my $subj="LON: User ID mismatch";
- system("echo 'User ID mismatch. lonmaxima must be run as user www.' |\
- mailto $emailto -s '$subj' > /dev/null");
+ system("echo 'User ID mismatch. lonmaxima must be run as user www.' |".
+ " mail -s '$subj' $emailto > /dev/null");
exit 1;
}
@@ -212,7 +225,7 @@ for (1 .. $PREFORK) {
while (1) {
&status('Parent process, sleeping');
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');
&make_new_child($server); # top up the child pool
}
@@ -238,6 +251,7 @@ sub make_new_child {
} else {
# Child can *not* return from this subroutine.
+ my $ppid = getppid();
# unblock signals
sigprocmask(SIG_UNBLOCK, $sigset)
@@ -245,7 +259,11 @@ sub make_new_child {
&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
# don't care we just want it gone
$SIG{INT} = sub {
@@ -254,14 +272,12 @@ sub make_new_child {
exit;
};
- $command->log_stdout(0);
- #$command->log_file("$execdir/logs/lonmaxima.session.log");
- &getmaximaoutput($command);
for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
&status('Accepting connections');
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);
&sync($command);
my $syntaxerr = 0;
@@ -274,6 +290,7 @@ sub make_new_child {
last;
} elsif ($reply=~/^Error\:/) {
&logthis('Died through '.$reply);
+ kill('USR1' => $ppid);
$client->close();
$command->hard_close();
exit;
@@ -283,8 +300,10 @@ sub make_new_child {
}
}
+ kill('USR1' => $ppid);
+ print $command ("quit();\n");
# tidy up gracefully and finish
-
+ sleep(15);
$command->soft_close();
# this exit is VERY important, otherwise the child will become
@@ -318,17 +337,17 @@ sub getmaximaoutput {
if ($numcheck eq 2) {
# command was the killall so should get a full reset on
# command numbers
- $regexp = '(\(\%i(1)\)|Incorrect syntax\:)';
+ $regexp = '(\(\%i(1)\)|[Ii]ncorrect syntax\:)';
} elsif ($command->match() =~ /\(\%i(\d+)\)/) {
my $nextmatch = $1+1;
- $regexp = '(\(\%i'.$nextmatch.'\)|Incorrect syntax\:)';
+ $regexp = '(\(\%i'.$nextmatch.'\)|[Ii]ncorrect syntax\:)';
}
}
my $timeout = 20;
my (undef,$error,$matched,$output) =
$command->expect($timeout, -re => $regexp);
- if ($numcheck && $matched eq 'Incorrect syntax:') {
+ if ($numcheck && lc($matched) eq 'incorrect syntax:') {
$syntaxerr = 1;
if (wantarray) {
return ($matched,$syntaxerr);
@@ -339,14 +358,14 @@ sub getmaximaoutput {
if ($error) {
return 'Error: '.$error;
}
- $output =~ s/\r+//g; # Remove Windows-style linebreaks
+ $output =~ s/\r+//gs; # Remove Windows-style linebreaks
my $foundoutput=0;
my $found_label=0;
my $realoutput='';
foreach my $line (split(/\n/,$output)) {
if ($line=~/\;/) { $foundoutput=1; next; }
if (!$foundoutput) { next; }
- if ($line=~/^Incorrect syntax:/) { $syntaxerr = 1; next; }
+ if ($line=~/^[Ii]ncorrect syntax:/) { $syntaxerr = 1; next; }
if ($line=~ /^(\(\%o\d+\))(.+)$/){
my $label = $1;
$line = $2;