--- loncom/lonmaxima 2006/03/08 03:18:42 1.12 +++ loncom/lonmaxima 2006/05/10 02:21:19 1.21 @@ -3,7 +3,7 @@ # The LearningOnline Network with CAPA # Connect to MAXIMA CAS # -# $Id: lonmaxima,v 1.12 2006/03/08 03:18:42 www Exp $ +# $Id: lonmaxima,v 1.21 2006/05/10 02:21:19 www 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; @@ -43,43 +42,25 @@ use LONCAPA::Configuration; use strict; # global variables -my $STARTPORT = 5664; # port for first child's server 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 %usedmaximaports = (); # keys are the used maximaports my $children = 0; # current number of children my $status; # string for current status my $pidfile; # file containg parent process pid 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 %usedmaximaports $status + +use vars qw($PREFORK $MAX_CLIENTS_PER_CHILD %children $children $status $pidfile $port %perlvar $lastlog); -sub maximareply { - my ($cmd,$maximaclient,$maximapid) = @_; - my $reply=''; - while (my $line=<$maximaclient>) { - $reply.=$line; - } - unless ($cmd=~/\;\n$/) { $cmd.=";\n"; } - print $maximaclient $cmd; - &status("Command sent to $maximapid"); - while (my $line=<$maximaclient>) { - $reply.=$line; - } - &status("Command processed by $maximapid"); - return $reply; -} - # ------------------------------------------------------------ Service routines sub REAPER { # takes care of dead children # and MAXIMA processes $SIG{CHLD} = \&REAPER; my $pid = wait; $children--; - delete($usedmaximaports{$children{$pid}}); delete($children{$pid}); } @@ -221,12 +202,10 @@ close(PIDSAVE); # Install signal handlers. $SIG{CHLD} = \&REAPER; $SIG{INT} = $SIG{TERM} = \&HUNTSMAN; - -my $maximaport=$STARTPORT; + # Fork off our children. for (1 .. $PREFORK) { - &make_new_child($server,$maximaport); - $maximaport++; + &make_new_child($server); } # And maintain the population. @@ -235,16 +214,12 @@ while (1) { sleep; # wait for a signal (i.e., child's death) for (my $i = $children; $i < $PREFORK; $i++) { &status('Parent process, starting child'); - my $newport; - foreach $newport ($STARTPORT .. $STARTPORT+$PREFORK-1) { - if (!defined($usedmaximaports{$newport})) { last; } - } - &make_new_child($server,$newport); # top up the child pool + &make_new_child($server); # top up the child pool } } sub make_new_child { - my ($server,$maximaport) = @_; + my ($server) = @_; # block signal for fork my $sigset = POSIX::SigSet->new(SIGINT); @@ -257,7 +232,7 @@ sub make_new_child { # Parent records the child's birth and returns. sigprocmask(SIG_UNBLOCK, $sigset) or die("Can't unblock SIGINT for fork: $!\n"); - $children{$pid} = $maximaport; + $children{$pid} = 1; $children++; return; } else { @@ -267,41 +242,39 @@ sub make_new_child { # unblock signals sigprocmask(SIG_UNBLOCK, $sigset) or die("Can't unblock SIGINT for fork: $!\n"); - - # open the MAXIMA port - my $maximaserver = IO::Socket::INET->new(LocalPort => $maximaport, - Type => SOCK_STREAM, - Proto => 'tcp', - Reuse => 1, - Listen => 10 ) - or die "making socket: $@\n"; - - # open MAXIMA to talk to that port - my ($cmd_in, $cmd_out, $cmd_err); - my $maximapid = open3($cmd_in, $cmd_out, $cmd_err, "maxima -s $maximaport"); - $children{$maximapid} = 1; - - my $prompt=<$cmd_out>; - &logthis("Maxima $maximapid: $prompt"); - - &status("Waiting $maximapid on $maximaport"); - # Hopefully, MAXIMA calls us back - my $maximaclient=$maximaserver->accept(); - &status("$maximapid on $maximaport connected."); - &logthis("Maxima $maximapid on port $maximaport connected."); - - # Absorb initial prompts - &logthis(&maximareply("0;\n",$maximaclient,$maximapid)); - - # Ready for action - - &process_requests($server,$maximaclient,$maximapid); + + &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);reset();\n"; + &getmaximaoutput($command); + &sync($command); + while (my $cmd=<$client>) { + &status('Processing command'); + print $command &unescape($cmd); + my $reply=&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 - if (ref($cmd_out)) { close($cmd_out); } - if (ref($cmd_err)) { close($cmd_err); } - if (ref($cmd_in)) { close($cmd_in); } + $command->soft_close(); # this exit is VERY important, otherwise the child will become # a producer of more and more children, forking yourself into @@ -310,15 +283,39 @@ sub make_new_child { } } -sub process_requests { - my ($server,$maximaclient,$maximapid) = @_; - # handle connections until we've reached $MAX_CLIENTS_PER_CHILD - for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { - &status('Accepting connections for '.$maximapid.' on '.$maximaport); - my $client = $server->accept() or last; - while (my $cmd=<$client>) { - &status('Processing command by '.$maximapid.' on '.$maximaport); - print $client &escape((&maximareply(&unescape($cmd),$maximaclient,$maximapid))[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; + } + my $foundoutput=0; + my $realoutput=''; + foreach my $line (split(/\n/,$output)) { + if ($line=~/\;/) { $foundoutput=1; next; } + if (!$foundoutput) { next; } + my ($label)=($line=~s/^(\(\%o\d+\))//); + if ($label) { + $label=~s/\S/ /g; + $line=$label.$line; + } + $realoutput.=$line."\n"; + } + return $realoutput; }