--- loncom/lonmaxima 2006/03/03 23:31:06 1.4 +++ loncom/lonmaxima 2006/03/04 06:44:11 1.8 @@ -3,7 +3,7 @@ # The LearningOnline Network with CAPA # Connect to MAXIMA CAS # -# $Id: lonmaxima,v 1.4 2006/03/03 23:31:06 albertel Exp $ +# $Id: lonmaxima,v 1.8 2006/03/04 06:44:11 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -48,11 +48,12 @@ my $MAX_CLIENTS_PER_CHILD = 5; # my %children = (); # keys are current child process IDs 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 $status - $cmd_in $cmd_out $cmd_err $pidfile $port %perlvar $lastlog - $currenthostid $client $server $cmd - ); + $pidfile $port %perlvar $lastlog); sub maximareply { my ($cmd) = @_; @@ -61,33 +62,43 @@ sub maximareply { my $exitstatus=''; unless ($cmd=~/\;\n$/) { $cmd.=";\n"; } - my $pid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima'); - $children{$pid} = 1; + + my ($cmd_in, $cmd_out, $cmd_err); + my $maximapid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima'); + $children{$maximapid} = 1; print $cmd_in $cmd; - close $cmd_in; + close($cmd_in); &status("Command sent"); + $SIG{ALRM} = sub { kill 9 => $maximapid; }; + alarm(5); + no strict 'refs'; + my $selector = IO::Select->new(); + $selector->add($cmd_err, $cmd_out); - while (my @ready = $selector->can_read) { + 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>; + my $line = scalar(<$cmd_out>); if ($line=~/^(\(\%o|\s)/) { - $line=~s/^\(.*\)/ /; - $reply.=$line; - } + $line=~s/^\(.*\)/ /; + $reply.=$line; + } } $selector->remove($fh) if eof($fh); } } - close $cmd_out; - close $cmd_err; + alarm(0); + $SIG{ALRM} = 'DEFAULT'; + close($cmd_out); + close($cmd_err); + use strict 'refs'; &status("Command processed"); return ($reply,$error,$exitstatus); } @@ -97,13 +108,13 @@ sub REAPER { # ta # and MAXIMA processes $SIG{CHLD} = \&REAPER; my $pid = wait; - $children --; - delete $children{$pid}; + $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; + kill('INT' => keys(%children)); unlink($pidfile); unlink($port); &logthis('---- Shutdown ----'); @@ -156,12 +167,12 @@ 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 @@ -178,11 +189,11 @@ $SIG{__DIE__}=\&catchexception; # ----------------------------- 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 @@ -190,11 +201,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"); @@ -203,44 +215,41 @@ $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'); - - - - + # Fork off our children. for (1 .. $PREFORK) { - &make_new_child(); + &make_new_child($server); } # Install signal handlers. @@ -253,23 +262,24 @@ while (1) { sleep; # wait for a signal (i.e., child's death) for (my $i = $children; $i < $PREFORK; $i++) { &status('Parent process, starting child'); - &make_new_child(); # top up the child pool + &make_new_child($server); # top up the child pool } } sub make_new_child { + my ($server) = @_; # 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; @@ -279,9 +289,9 @@ sub make_new_child { # unblock signals sigprocmask(SIG_UNBLOCK, $sigset) - or die "Can't unblock SIGINT for fork: $!\n"; + or die("Can't unblock SIGINT for fork: $!\n"); - &process_requests(); + &process_requests($server); # tidy up gracefully and finish @@ -293,11 +303,12 @@ 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'); - $client = $server->accept( ) or last; - while ($cmd=<$client>) { + my $client = $server->accept() or last; + while (my $cmd=<$client>) { &status('Processing command'); print $client &escape((&maximareply(&unescape($cmd)))[0])."\n"; }