--- loncom/lonmaxima 2006/03/04 06:44:11 1.8
+++ loncom/lonmaxima 2007/02/03 04:09:30 1.23
@@ -3,7 +3,7 @@
# The LearningOnline Network with CAPA
# Connect to MAXIMA CAS
#
-# $Id: lonmaxima,v 1.8 2006/03/04 06:44:11 albertel Exp $
+# $Id: lonmaxima,v 1.23 2007/02/03 04:09:30 raeburn 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,7 @@ 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 %children = (); # keys are current child process IDs
my $children = 0; # current number of children
my $status; # string for current status
@@ -52,57 +51,10 @@ my $pidfile; #
my $port; # path to UNIX socket file
my %perlvar; # configuration file info
my $lastlog; # last string that was logged
+
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 $maximapid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima');
- $children{$maximapid} = 1;
-
- print $cmd_in $cmd;
- close($cmd_in);
-
- &status("Command sent");
-
- $SIG{ALRM} = sub { kill 9 => $maximapid; };
- alarm(5);
- no strict 'refs';
-
- 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);
- }
- }
- alarm(0);
- $SIG{ALRM} = 'DEFAULT';
- close($cmd_out);
- close($cmd_err);
- use strict 'refs';
- &status("Command processed");
- return ($reply,$error,$exitstatus);
-}
-
# ------------------------------------------------------------ Service routines
sub REAPER { # takes care of dead children
# and MAXIMA processes
@@ -247,15 +199,15 @@ close(PIDSAVE);
&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');
@@ -291,10 +243,42 @@ sub make_new_child {
sigprocmask(SIG_UNBLOCK, $sigset)
or die("Can't unblock SIGINT for fork: $!\n");
- &process_requests($server);
+ &logthis('New process started');
+
+ my $command=Expect->spawn('maxima');
+ $command->log_stdout(0);
+
+ &getmaximaoutput($command);
+
+ 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);
+ while (my $cmd=<$client>) {
+ &status('Processing command');
+ print $command &unescape($cmd);
+ my ($reply,$finished,$syntaxerr) = &getmaximaoutput($command);
+ if ((!$finished) && (!$syntaxerr) && ($reply !~ /^Error\:/)) {
+ ($reply,$finished,$syntaxerr) = &getmaximaoutput($command);
+ }
+ print $client &escape($reply)."\n";
+ if ($reply=~/^Error\:/) {
+ &logthis('Died through '.$reply);
+ $client->close();
+ $command->hard_close();
+ exit;
+ }
+ &sync($command);
+ &status('Waiting for commands');
+ }
+ }
# tidy up gracefully and finish
+ $command->soft_close();
+
# this exit is VERY important, otherwise the child will become
# a producer of more and more children, forking yourself into
# process death.
@@ -302,15 +286,48 @@ 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);
+ if (($output=~/\Q$expect\E/) || ($output=~/^Error\:/)) {
+ return;
+ }
}
- }
+ }
+}
+
+sub getmaximaoutput {
+ my ($command)=@_;
+ my (undef,$error,undef,$output)=$command->expect(20, -re => '\(\%i\d+\)');
+ if ($error) {
+ return 'Error: '.$error;
+ }
+ $output =~ s/\r+//g; # Remove Windows-style linebreaks
+ my $hasoutput=0;
+ my $foundoutput=0;
+ my $syntaxerr=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;
+ $line=$label.$line;
+ $hasoutput = 1;
+ }
+ $realoutput.=$line."\n";
+ }
+ if (wantarray) {
+ return ($realoutput,$hasoutput,$syntaxerr);
+ } else {
+ return $realoutput;
+ }
}