--- loncom/lonmaxima 2006/03/03 22:35:09 1.2 +++ loncom/lonmaxima 2006/03/04 15:47:26 1.11 @@ -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.11 2006/03/04 15:47:26 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,43 +40,67 @@ use POSIX; use lib '/home/httpd/lib/perl/'; use LONCAPA::Configuration; -# Scary: cannot use strict!!! -##### use strict; +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 %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 +my $maximapid; # PID of Maxima process +use vars qw($PREFORK $MAX_CLIENTS_PER_CHILD %children $children $status + $pidfile $port %perlvar $lastlog $maximapid); sub maximareply { - my $cmd=shift; + my ($cmd) = @_; my $reply=''; my $error=''; 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); + $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); + 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)) { + if (ref($fh) + && ref($cmd_err) + && 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'; + if (ref($cmd_out)) { close($cmd_out); } + if (ref($cmd_err)) { close($cmd_err); } + &status("Command processed"); return ($reply,$error,$exitstatus); } @@ -91,13 +110,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 ----'); @@ -109,7 +128,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 +140,7 @@ sub logthis { # -------------------------------------------------------------- Status setting sub status { - my $what=shift; + my ($what)=@_; my $now=time; my $local=localtime($now); $status=$local.': '.$what; @@ -131,7 +150,7 @@ sub status { # -------------------------------------------------------- Escape Special Chars sub escape { - my $str=shift; + my ($str)=@_; $str =~ s/(\W)/"%".unpack('H2',$1)/eg; return $str; } @@ -139,7 +158,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,12 +169,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 @@ -167,18 +186,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 +203,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,75 +217,71 @@ $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( ); -} - + # Install signal handlers. $SIG{CHLD} = \&REAPER; $SIG{INT} = $SIG{TERM} = \&HUNTSMAN; +# Fork off our children. +for (1 .. $PREFORK) { + &make_new_child($server); +} + # 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 + &make_new_child($server); # top up the child pool } } sub make_new_child { - my $pid; - my $sigset; - + my ($server) = @_; + # 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"; + or die("Can't unblock SIGINT for fork: $!\n"); $children{$pid} = 1; $children++; return; @@ -277,18 +291,10 @@ sub make_new_child { # 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"; - } - } - + or die("Can't unblock SIGINT for fork: $!\n"); + + &process_requests($server); + # tidy up gracefully and finish # this exit is VERY important, otherwise the child will become @@ -297,3 +303,16 @@ sub make_new_child { exit; } } + +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"; + } + } +} 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.