--- loncom/lonmaxima 2006/03/08 15:58:03 1.15 +++ loncom/lonmaxima 2007/11/09 18:51:10 1.35 @@ -3,7 +3,7 @@ # The LearningOnline Network with CAPA # Connect to MAXIMA CAS # -# $Id: lonmaxima,v 1.15 2006/03/08 15:58:03 www Exp $ +# $Id: lonmaxima,v 1.35 2007/11/09 18:51:10 albertel 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,18 +42,18 @@ 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 $extra_children = 0; 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); # ------------------------------------------------------------ Service routines @@ -62,10 +61,13 @@ sub REAPER { # ta # and MAXIMA processes $SIG{CHLD} = \&REAPER; my $pid = wait; - $children--; - &logthis("Child $pid for port or process $children{$pid} died"); - delete($usedmaximaports{$children{$pid}}); - delete($children{$pid}); + if (exists($children{$pid})) { + $children--; + delete($children{$pid}); + if ($extra_children) { + $extra_children--; + } + } } sub HUNTSMAN { # signal handler for SIGINT @@ -129,12 +131,19 @@ sub catchexception { die("Signal abend"); } + +sub child_announce_death { + $SIG{USR1} = \&child_announce_death; + $extra_children++; +} + # ---------------------------------------------------------------- Main program # -------------------------------- Set signal handlers to record abnormal exits $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"); @@ -204,33 +213,24 @@ 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. 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'); - my $newport; - &logthis("Current pool: ".join(', ',keys %usedmaximaports)); - foreach my $testport ($STARTPORT .. $STARTPORT+$PREFORK-1) { - if (!$usedmaximaports{$testport}) { $newport=$testport; } - } - if ($newport) { - &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); @@ -243,62 +243,64 @@ 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++; - $usedmaximaports{$maximaport}=1; return; } else { - &logthis("Starting child on port $maximaport"); # 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"); - - # 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"; - my $maximaselect=IO::Select->new($maximaserver); - sleep(1); - - # 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} = "Maxima $maximapid port $maximaport"; - my $prompt=<$cmd_out>; - &logthis("Maxima $maximapid: $prompt"); - - # hopefully, MAXIMA calls us back - &status("Waiting $maximapid on $maximaport"); - my $maximaclient=$maximaserver->accept(); - $maximaclient->blocking(0); - $maximaselect->add($maximaclient); - &status("$maximapid on $maximaport connected."); - &logthis("Maxima $maximapid on port $maximaport connected."); - sleep(2); - &logthis('Initial reply: '.&maximareply($maximaselect)); - # handle connections until we've reached $MAX_CLIENTS_PER_CHILD + &logthis('New process started'); + + 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"); + &sync($command); + for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { - &status('Accepting connections for '.$maximapid.' on '.$maximaport); + &status('Accepting connections'); my $client = $server->accept() or last; + print $command ("display2d:false;kill(all);\n"); + &getmaximaoutput($command,2); + &sync($command); + my $syntaxerr = 0; while (my $cmd=<$client>) { - &status('Processing command by '.$maximapid.' on '.$maximaport); - &maximawrite($maximaselect,&unescape($cmd).";\n"); - print $client &escape(&maximareply($maximaselect))."\n"; + &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 - 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 @@ -307,26 +309,73 @@ sub make_new_child { } } -sub maximareply { - my ($maximaselect)=@_; - my $output=''; - - foreach my $ready ($maximaselect->can_read(1)) { - my $data = ''; - my $rv = $ready->recv($data, POSIX::BUFSIZ, 0); - $output.=$data; - } - return $output; -} - -sub maximawrite { - my ($maximaselect,$cmd)=@_; - my $ready=($maximaselect->can_write(1)); - if (ref($ready)) { - print $ready $cmd; - } else { - &logthis("Cannot write: ".&maximareply($maximaselect)); - } +{ + 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)\)|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 && $matched eq 'Incorrect syntax:') { + $syntaxerr = 1; + if (wantarray) { + return ($matched,$syntaxerr); + } else { + return $matched; + } + } + if ($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; } + 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; + } +}