--- loncom/lonmaxima 2006/03/03 23:41:38 1.5
+++ loncom/lonmaxima 2012/02/16 19:54:06 1.41
@@ -3,7 +3,7 @@
# The LearningOnline Network with CAPA
# Connect to MAXIMA CAS
#
-# $Id: lonmaxima,v 1.5 2006/03/03 23:41:38 albertel Exp $
+# $Id: lonmaxima,v 1.41 2012/02/16 19:54:06 droeschl Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -30,8 +30,7 @@
# http://www.lon-capa.org/
#
-
-use IPC::Open3;
+use Expect;
use IO::Select;
use IO::Socket;
use IO::File;
@@ -44,7 +43,8 @@ use strict;
# global variables
my $PREFORK = 5; # number of children to maintain
-my $MAX_CLIENTS_PER_CHILD = 5; # 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 = 0; # current number of children
my $status; # string for current status
@@ -56,58 +56,23 @@ my $lastlog; #
use vars qw($PREFORK $MAX_CLIENTS_PER_CHILD %children $children $status
$pidfile $port %perlvar $lastlog);
-sub maximareply {
- my ($cmd) = @_;
- my $reply='';
- my $error='';
- my $exitstatus='';
-
- unless ($cmd=~/\;\n$/) { $cmd.=";\n"; }
-
- my ($cmd_in, $cmd_out, $cmd_err);
- my $pid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima');
- $children{$pid} = 1;
-
- print $cmd_in $cmd;
- close($cmd_in);
-
- &status("Command sent");
-
- my $selector = IO::Select->new();
- $selector->add($cmd_err, $cmd_out);
-
- while (my @ready = $selector->can_read) {
- foreach my $fh (@ready) {
- if (fileno($fh) == fileno($cmd_err)) {
- $error.=<$cmd_err>;
- } else {
- my $line = scalar <$cmd_out>;
- if ($line=~/^(\(\%o|\s)/) {
- $line=~s/^\(.*\)/ /;
- $reply.=$line;
- }
- }
- $selector->remove($fh) if eof($fh);
- }
- }
- close($cmd_out);
- close($cmd_err);
- &status("Command processed");
- return ($reply,$error,$exitstatus);
-}
-
# ------------------------------------------------------------ Service routines
sub REAPER { # takes care of dead children
# 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
local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children
- kill 'INT' => keys %children;
+ kill('INT' => keys(%children));
unlink($pidfile);
unlink($port);
&logthis('---- Shutdown ----');
@@ -167,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
@@ -174,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");
@@ -197,7 +169,7 @@ if (-e $pidfile) {
my $lfh=IO::File->new("$pidfile");
my $pide=<$lfh>;
chomp($pide);
- if (kill 0 => $pide) { die "already running"; }
+ if (kill(0 => $pide)) { die "already running"; }
}
# ------------------------------------------------------- Listen to UNIX socket
@@ -208,26 +180,25 @@ $port = "$perlvar{'lonSockDir'}/maximaso
unlink($port);
-my $server;
-unless (
- $server = IO::Socket::UNIX->new(Local => $port,
- Type => SOCK_STREAM,
- Listen => 10 )
- ) {
- my $st=120+int(rand(240));
- &logthis(
- "<font color=blue>WARNING: ".
- "Can't make server socket ($st secs): .. exiting</font>");
- sleep($st);
- exit;
- };
+my $server = IO::Socket::UNIX->new(Local => $port,
+ Type => SOCK_STREAM,
+ Listen => 10 );
+if (!$server) {
+ my $st=120+int(rand(240));
+
+ &logthis("<font color=blue>WARNING: ".
+ "Can't make server socket ($st secs): .. exiting</font>");
+
+ sleep($st);
+ exit;
+}
# ---------------------------------------------------- Fork once and dissociate
my $fpid=fork;
exit if $fpid;
-die "Couldn't fork: $!" unless defined ($fpid);
+die("Couldn't fork: $!") unless defined($fpid);
POSIX::setsid() or die "Can't start new session: $!";
@@ -239,25 +210,22 @@ print PIDSAVE "$$\n";
close(PIDSAVE);
&logthis("<font color='red'>CRITICAL: ---------- Starting ----------</font>");
&status('Starting');
-
-
-
-
+
+# Install signal handlers.
+$SIG{CHLD} = \&REAPER;
+$SIG{INT} = $SIG{TERM} = \&HUNTSMAN;
+
# Fork off our children.
for (1 .. $PREFORK) {
&make_new_child($server);
}
-# Install signal handlers.
-$SIG{CHLD} = \&REAPER;
-$SIG{INT} = $SIG{TERM} = \&HUNTSMAN;
-
# And maintain the population.
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
}
@@ -269,28 +237,72 @@ sub make_new_child {
# block signal for fork
my $sigset = POSIX::SigSet->new(SIGINT);
sigprocmask(SIG_BLOCK, $sigset)
- or die "Can't block SIGINT for fork: $!\n";
+ or die("Can't block SIGINT for fork: $!\n");
- die "fork: $!" unless defined (my $pid = fork);
+ die("fork: $!") unless defined(my $pid = fork);
if ($pid) {
# Parent records the child's birth and returns.
sigprocmask(SIG_UNBLOCK, $sigset)
- or die "Can't unblock SIGINT for fork: $!\n";
+ or die("Can't unblock SIGINT for fork: $!\n");
$children{$pid} = 1;
$children++;
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)
- or die "Can't unblock SIGINT for fork: $!\n";
+ or die("Can't unblock SIGINT for fork: $!\n");
+
+ &logthis('New process started');
- &process_requests($server);
+ my $command=Expect->spawn('maxima');
+ # 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;
+ };
+
+ $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;
+ &sync($command);
+ print $command ("display2d:false;simp:true;kill(all);\n");
+ &getmaximaoutput($command,2);
+ &sync($command);
+ my $syntaxerr = 0;
+ while (my $cmd=<$client>) {
+ &status('Processing command');
+ print $command &unescape($cmd);
+ my ($reply,$syntaxerr) = &getmaximaoutput($command,1);
+ print $client &escape($reply)."\n";
+ if ($syntaxerr) {
+ last;
+ } elsif ($reply=~/^Error\:/) {
+ &logthis('Died through '.$reply);
+ 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
+ sleep(15);
+ $command->soft_close();
# this exit is VERY important, otherwise the child will become
# a producer of more and more children, forking yourself into
@@ -299,15 +311,73 @@ sub make_new_child {
}
}
-sub process_requests {
- my ($server) = @_;
- # handle connections until we've reached $MAX_CLIENTS_PER_CHILD
- for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
- &status('Accepting connections');
- my $client = $server->accept() or last;
- while (my $cmd=<$client>) {
- &status('Processing command');
- print $client &escape((&maximareply(&unescape($cmd)))[0])."\n";
+{
+ my $counter;
+ sub sync {
+ my ($command)=@_;
+ $counter++;
+ my $expect=$counter.time;
+ print $command "$expect;\n";
+ while (1) {
+ my $output=&getmaximaoutput($command,1);
+ if (($output=~/\Q$expect\E/) || ($output=~/^Error\:/)) {
+ return;
+ }
}
- }
+ }
+}
+
+sub getmaximaoutput {
+ my ($command,$numcheck)=@_;
+ 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) {
+ return 'Error: '.$error;
+ }
+ $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=~/^[Ii]ncorrect syntax:/) { $syntaxerr = 1; next; }
+ 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";
+ }
+ }
+ if (wantarray) {
+ return ($realoutput,$syntaxerr);
+ } else {
+ return $realoutput;
+ }
}