--- loncom/lonmaxima 2006/03/03 16:07:34 1.1 +++ loncom/lonmaxima 2006/03/03 22:35:09 1.2 @@ -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.2 2006/03/03 22:35:09 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -29,12 +29,25 @@ # # http://www.lon-capa.org/ # + +# global variables +$PREFORK = 5; # number of children to maintain +$MAX_CLIENTS_PER_CHILD = 5; # number of clients each child should process +%children = (); # keys are current child process IDs +$children = 0; # current number of children use IPC::Open3; use IO::Select; +use IO::Socket; +use IO::File; +use Symbol; +use POSIX; +use lib '/home/httpd/lib/perl/'; +use LONCAPA::Configuration; + # Scary: cannot use strict!!! ##### use strict; - + sub maximareply { my $cmd=shift; my $reply=''; @@ -43,15 +56,14 @@ sub maximareply { unless ($cmd=~/\;\n$/) { $cmd.=";\n"; } my $pid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima'); + $children{$pid} = 1; - $SIG{CHLD} = sub { - $exitstatus="$? on $pid\n" if waitpid($pid, 0) > 0; - }; - print $cmd_in $cmd; close $cmd_in; - my $selector = IO::Select->new( ); + &status("Command sent"); + + my $selector = IO::Select->new(); $selector->add($cmd_err, $cmd_out); while (my @ready = $selector->can_read) { @@ -70,8 +82,218 @@ sub maximareply { } 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}; +} + +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 +} + + + +# --------------------------------------------------------------------- Logging + +sub logthis { + my $message=shift; + 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=shift; + my $now=time; + my $local=localtime($now); + $status=$local.': '.$what; + $0='lonmaxima: '.$what.' '.$local; +} + +# -------------------------------------------------------- Escape Special Chars + +sub escape { + my $str=shift; + $str =~ s/(\W)/"%".unpack('H2',$1)/eg; + return $str; +} + +# ----------------------------------------------------- Un-Escape Special Chars + +sub unescape { + my $str=shift; + $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"); +my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); +%perlvar=%{$perlvarref}; +undef $perlvarref; + +# ----------------------------- Make sure this process is running from user=www +my $wwwid=getpwnam('www'); +if ($wwwid!=$<) { + my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; + my $subj="LON: $currenthostid 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"; } +} +# ------------------------------------------------------- Listen to UNIX socket +&status("Opening socket"); + +$port = "$perlvar{'lonSockDir'}/maximasock"; + +unlink($port); + + +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; + }; + + +# ---------------------------------------------------- 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'); + + + + + +# Fork off our children. +for (1 .. $PREFORK) { + make_new_child( ); +} + +# 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 ($i = $children; $i < $PREFORK; $i++) { + &status('Parent process, starting child'); + make_new_child( ); # top up the child pool + } +} + +sub make_new_child { + my $pid; + my $sigset; + + # block signal for fork + $sigset = POSIX::SigSet->new(SIGINT); + sigprocmask(SIG_BLOCK, $sigset) + or die "Can't block SIGINT for fork: $!\n"; + + die "fork: $!" unless defined ($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} = 1; + $children++; + return; + } else { + # 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"; + + # handle connections until we've reached $MAX_CLIENTS_PER_CHILD + for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { + &status('Accepting connections'); + $client = $server->accept( ) or last; + while ($cmd=<$client>) { + &status('Processing command'); + print $client &escape((&maximareply(&unescape($cmd)))[0])."\n"; + } + } + + # tidy up gracefully and finish -print join("\n----\n",&maximareply('1234')); -print join("\n----\n",&maximareply('x0: 5;x1: 7;integrate (x^2, x, x0, x1);')); + # this exit is VERY important, otherwise the child will become + # a producer of more and more children, forking yourself into + # process death. + exit; + } +}