--- loncom/lonmaxima 2006/03/03 23:41:38 1.5 +++ loncom/lonmaxima 2018/10/29 02:57:30 1.43 @@ -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.43 2018/10/29 02:57: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,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"); @@ -184,8 +156,8 @@ my $wwwid=getpwnam('www'); if ($wwwid!=$<) { my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; my $subj="LON: User ID mismatch"; - system("echo 'User ID mismatch. lonmaxima must be run as user www.' |\ - mailto $emailto -s '$subj' > /dev/null"); + system("echo 'User ID mismatch. lonmaxima must be run as user www.' |". + " mailto -s '$subj' $emailto > /dev/null"); exit 1; } @@ -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( - "WARNING: ". - "Can't make server socket ($st secs): .. exiting"); - 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("WARNING: ". + "Can't make server socket ($st secs): .. exiting"); + + 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("CRITICAL: ---------- Starting ----------"); &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,74 @@ 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 = new Expect(); + $command->log_stdout(0); + #$command->log_file("$execdir/logs/lonmaxima.session.log"); + $command->spawn('maxima'); + &getmaximaoutput($command, 2); # wait for maxima to finish initialization + # 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; + }; + + + 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 +313,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; + } }