--- loncom/lonmaxima 2007/04/19 17:29:11 1.26 +++ loncom/lonmaxima 2008/02/14 14:09:43 1.37 @@ -3,7 +3,7 @@ # The LearningOnline Network with CAPA # Connect to MAXIMA CAS # -# $Id: lonmaxima,v 1.26 2007/04/19 17:29:11 raeburn Exp $ +# $Id: lonmaxima,v 1.37 2008/02/14 14:09:43 bisitz 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"); @@ -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 } @@ -237,7 +250,8 @@ sub make_new_child { return; } else { # Child can *not* return from this subroutine. - $SIG{INT} = 'DEFAULT'; # make SIGINT kill us as it did before + + my $ppid = getppid(); # unblock signals sigprocmask(SIG_UNBLOCK, $sigset) @@ -246,15 +260,23 @@ sub make_new_child { &logthis('New process started'); my $command=Expect->spawn('maxima'); - $command->log_stdout(0); + # 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); + $command->log_stdout(0); + #$command->log_file("$execdir/logs/lonmaxima.session.log"); for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { &status('Accepting connections'); my $client = $server->accept() or last; - print $command "kill(all);\n"; - &getmaximaoutput($command); + &sync($command); + print $command ("display2d:false;kill(all);\n"); + &getmaximaoutput($command,2); &sync($command); my $syntaxerr = 0; while (my $cmd=<$client>) { @@ -266,6 +288,7 @@ sub make_new_child { last; } elsif ($reply=~/^Error\:/) { &logthis('Died through '.$reply); + kill('USR1' => $ppid); $client->close(); $command->hard_close(); exit; @@ -275,8 +298,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 @@ -307,43 +332,48 @@ sub getmaximaoutput { my $regexp = '\(\%i\d+\)'; my $syntaxerr=0; if ($numcheck) { - if ($command->match() =~ /\(\%i(\d+)\)/) { + if ($numcheck eq 2) { + # command was the killall so should get a full reset on + # command numbers + $regexp = '(\(\%i(1)\)|Incorrect syntax\:)'; + } elsif ($command->match() =~ /\(\%i(\d+)\)/) { my $nextmatch = $1+1; $regexp = '(\(\%i'.$nextmatch.'\)|Incorrect syntax\:)'; } } my $timeout = 20; - my (undef,$error,$matched,$output)=$command->expect($timeout, -re => $regexp); - if ($numcheck) { - if ($matched eq 'Incorrect syntax:') { - $syntaxerr = 1; - if (wantarray) { - return ($matched,$syntaxerr); - } else { - return $matched; - } - } + my (undef,$error,$matched,$output) = + $command->expect($timeout, -re => $regexp); + + if ($numcheck && $matched eq 'Incorrect syntax:') { + $syntaxerr = 1; + if (wantarray) { + return ($matched,$syntaxerr); + } else { + return $matched; + } } if ($error) { - if (wantarray) { - return ('Error: '.$error); - } else { - return 'Error: '.$error; - } + return 'Error: '.$error; } $output =~ s/\r+//g; # 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; } - (my $label, $line) = ($line=~ /^(\(\%o\d+\))(.+)$/); - if ($label) { - $label=~s/\S/ /g; + if ($line=~ /^(\(\%o\d+\))(.+)$/){ + my $label = $1; + $line = $2; + $label =~s/\S/ /g; $line=$label.$line; + $found_label=1; + } + if ($found_label) { + $realoutput.=$line."\n"; } - $realoutput.=$line."\n"; } if (wantarray) { return ($realoutput,$syntaxerr);