--- loncom/lonmaxima 2006/03/03 16:07:34 1.1 +++ loncom/lonmaxima 2006/03/08 15:58:03 1.15 @@ -3,7 +3,7 @@ # The LearningOnline Network with CAPA # Connect to MAXIMA CAS # -# $Id: lonmaxima,v 1.1 2006/03/03 16:07:34 www Exp $ +# $Id: lonmaxima,v 1.15 2006/03/08 15:58:03 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -29,49 +29,304 @@ # # http://www.lon-capa.org/ # + use IPC::Open3; use IO::Select; -# Scary: cannot use strict!!! -##### use strict; +use IO::Socket; +use IO::File; +use Symbol; +use POSIX; +use lib '/home/httpd/lib/perl/'; +use LONCAPA::Configuration; + +use strict; -sub maximareply { - my $cmd=shift; - my $reply=''; - my $error=''; - my $exitstatus=''; +# 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 %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 + $pidfile $port %perlvar $lastlog); + +# ------------------------------------------------------------ Service routines +sub REAPER { # takes care of dead children + # 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}); +} + +sub HUNTSMAN { # signal handler for SIGINT + local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children + kill('INT' => keys(%children)); + unlink($pidfile); + unlink($port); + &logthis('---- Shutdown ----'); + exit; # clean up with dignity +} - unless ($cmd=~/\;\n$/) { $cmd.=";\n"; } - my $pid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima'); - - $SIG{CHLD} = sub { - $exitstatus="$? on $pid\n" if waitpid($pid, 0) > 0; - }; - print $cmd_in $cmd; - close $cmd_in; + +# --------------------------------------------------------------------- Logging + +sub logthis { + my ($message)=@_; + my $execdir=$perlvar{'lonDaemons'}; + my $fh=IO::File->new(">>$execdir/logs/lonmaxima.log"); + my $now=time; + my $local=localtime($now); + $lastlog=$local.': '.$message; + print $fh "$local ($$): $message\n"; +} + +# -------------------------------------------------------------- Status setting + +sub status { + my ($what)=@_; + my $now=time; + my $local=localtime($now); + $status=$local.': '.$what; + $0='lonmaxima: '.$what.' '.$local; +} + +# -------------------------------------------------------- Escape Special Chars + +sub escape { + my ($str)=@_; + $str =~ s/(\W)/"%".unpack('H2',$1)/eg; + return $str; +} + +# ----------------------------------------------------- Un-Escape Special Chars + +sub unescape { + my ($str)=@_; + $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; + return $str; +} + +# ------------------------ grabs exception and records it to log before exiting +sub catchexception { + my ($signal)=@_; + $SIG{QUIT}='DEFAULT'; + $SIG{__DIE__}='DEFAULT'; + chomp($signal); + &logthis("CRITICAL: " + ."ABNORMAL EXIT. Child $$ died through " + ."\"$signal\""); + die("Signal abend"); +} + +# ---------------------------------------------------------------- Main program +# -------------------------------- Set signal handlers to record abnormal exits + + +$SIG{'QUIT'}=\&catchexception; +$SIG{__DIE__}=\&catchexception; + +# ---------------------------------- Read loncapa_apache.conf and loncapa.conf +&status("Read loncapa.conf and loncapa_apache.conf"); +%perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')}; + +# ----------------------------- Make sure this process is running from user=www +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"); + exit 1; +} + +# --------------------------------------------- Check if other instance running + +$pidfile="$perlvar{'lonDaemons'}/logs/lonmaxima.pid"; + +if (-e $pidfile) { + my $lfh=IO::File->new("$pidfile"); + my $pide=<$lfh>; + chomp($pide); + if (kill(0 => $pide)) { die "already running"; } +} - my $selector = IO::Select->new( ); - $selector->add($cmd_err, $cmd_out); +# ------------------------------------------------------- Listen to UNIX socket +&status("Opening socket"); + +$port = "$perlvar{'lonSockDir'}/maximasock"; + +unlink($port); + + +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; +} - 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); - } + +# ---------------------------------------------------- Fork once and dissociate + +my $fpid=fork; +exit if $fpid; +die("Couldn't fork: $!") unless defined($fpid); + +POSIX::setsid() or die "Can't start new session: $!"; + +# ------------------------------------------------------- Write our PID on disk + +my $execdir=$perlvar{'lonDaemons'}; +open(PIDSAVE,">$execdir/logs/lonmaxima.pid"); +print PIDSAVE "$$\n"; +close(PIDSAVE); +&logthis("CRITICAL: ---------- Starting ----------"); +&status('Starting'); + + +# 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++; +} + +# 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++) { + &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 + } } - close $cmd_out; - close $cmd_err; - return ($reply,$error,$exitstatus); } + +sub make_new_child { + my ($server,$maximaport) = @_; + + # block signal for fork + my $sigset = POSIX::SigSet->new(SIGINT); + sigprocmask(SIG_BLOCK, $sigset) + or die("Can't block SIGINT for fork: $!\n"); + + 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"); + $children{$pid} = $maximaport; + $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 + + # 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 + 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); + &maximawrite($maximaselect,&unescape($cmd).";\n"); + print $client &escape(&maximareply($maximaselect))."\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); } + + # this exit is VERY important, otherwise the child will become + # a producer of more and more children, forking yourself into + # process death. + exit; + } +} + +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)); + } +} + -print join("\n----\n",&maximareply('1234')); -print join("\n----\n",&maximareply('x0: 5;x1: 7;integrate (x^2, x, x0, x1);'));