--- loncom/lonmaxima 2006/03/03 22:35:09 1.2 +++ 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.2 2006/03/03 22:35:09 www Exp $ +# $Id: lonmaxima,v 1.15 2006/03/08 15:58:03 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -30,11 +30,6 @@ # 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; @@ -45,59 +40,37 @@ use POSIX; use lib '/home/httpd/lib/perl/'; use LONCAPA::Configuration; -# Scary: cannot use strict!!! -##### use strict; - -sub maximareply { - my $cmd=shift; - my $reply=''; - my $error=''; - my $exitstatus=''; - - unless ($cmd=~/\;\n$/) { $cmd.=";\n"; } - my $pid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima'); - $children{$pid} = 1; - - print $cmd_in $cmd; - close $cmd_in; - - &status("Command sent"); +use strict; - 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); -} +# 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 --; - delete $children{$pid}; + $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; + kill('INT' => keys(%children)); unlink($pidfile); unlink($port); &logthis('---- Shutdown ----'); @@ -109,7 +82,7 @@ sub HUNTSMAN { # si # --------------------------------------------------------------------- Logging sub logthis { - my $message=shift; + my ($message)=@_; my $execdir=$perlvar{'lonDaemons'}; my $fh=IO::File->new(">>$execdir/logs/lonmaxima.log"); my $now=time; @@ -121,7 +94,7 @@ sub logthis { # -------------------------------------------------------------- Status setting sub status { - my $what=shift; + my ($what)=@_; my $now=time; my $local=localtime($now); $status=$local.': '.$what; @@ -131,7 +104,7 @@ sub status { # -------------------------------------------------------- Escape Special Chars sub escape { - my $str=shift; + my ($str)=@_; $str =~ s/(\W)/"%".unpack('H2',$1)/eg; return $str; } @@ -139,7 +112,7 @@ sub escape { # ----------------------------------------------------- Un-Escape Special Chars sub unescape { - my $str=shift; + my ($str)=@_; $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; return $str; } @@ -150,13 +123,11 @@ sub catchexception { $SIG{QUIT}='DEFAULT'; $SIG{__DIE__}='DEFAULT'; chomp($signal); - &logthis("CRITICAL: " - ."ABNORMAL EXIT. Child $$ died through " - ."\"$signal\""); + &logthis("CRITICAL: " + ."ABNORMAL EXIT. Child $$ died through " + ."\"$signal\""); die("Signal abend"); } - - # ---------------------------------------------------------------- Main program # -------------------------------- Set signal handlers to record abnormal exits @@ -167,18 +138,16 @@ $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; +%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: $currenthostid User ID mismatch"; - system("echo 'User ID mismatch. lonmaxima must be run as user www.' |\ + 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; + exit 1; } # --------------------------------------------- Check if other instance running @@ -186,11 +155,12 @@ if ($wwwid!=$<) { $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 $lfh=IO::File->new("$pidfile"); + my $pide=<$lfh>; + chomp($pide); + if (kill(0 => $pide)) { die "already running"; } } + # ------------------------------------------------------- Listen to UNIX socket &status("Opening socket"); @@ -199,101 +169,164 @@ $port = "$perlvar{'lonSockDir'}/maximaso 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; - }; +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: $!"; # ------------------------------------------------------- Write our PID on disk my $execdir=$perlvar{'lonDaemons'}; -open (PIDSAVE,">$execdir/logs/lonmaxima.pid"); +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( ); + &make_new_child($server,$maximaport); + $maximaport++; } -# 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++) { + for (my $i = $children; $i < $PREFORK; $i++) { &status('Parent process, starting child'); - make_new_child( ); # top up the child pool + 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 + } } } sub make_new_child { - my $pid; - my $sigset; - + my ($server,$maximaport) = @_; + # block signal for fork - $sigset = POSIX::SigSet->new(SIGINT); + 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 ($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"; - $children{$pid} = 1; + 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"; - + 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 ($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"; - } + 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)); + } +} + +