[LON-CAPA-cvs] cvs: modules /gerd/maxima lonmaxima maximatestclient.pl
www
lon-capa-cvs@mail.lon-capa.org
Fri, 03 Mar 2006 22:35:12 -0000
This is a MIME encoded message
--www1141425312
Content-Type: text/plain
www Fri Mar 3 17:35:12 2006 EDT
Added files:
/modules/gerd/maxima maximatestclient.pl
Modified files:
/modules/gerd/maxima lonmaxima
Log:
Playing some more, having fun
--www1141425312
Content-Type: text/plain
Content-Disposition: attachment; filename="www-20060303173512.txt"
Index: modules/gerd/maxima/lonmaxima
diff -u modules/gerd/maxima/lonmaxima:1.1 modules/gerd/maxima/lonmaxima:1.2
--- modules/gerd/maxima/lonmaxima:1.1 Fri Mar 3 11:07:34 2006
+++ modules/gerd/maxima/lonmaxima Fri Mar 3 17:35:09 2006
@@ -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 @@
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 @@
}
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("<font color=red>CRITICAL: "
+ ."ABNORMAL EXIT. Child $$ died through "
+ ."\"$signal\"</font>");
+ 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(
+ "<font color=blue>WARNING: ".
+ "Can't make server socket ($st secs): .. exiting</font>");
+ 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("<font color='red'>CRITICAL: ---------- Starting ----------</font>");
+&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;
+ }
+}
Index: modules/gerd/maxima/maximatestclient.pl
+++ modules/gerd/maxima/maximatestclient.pl
use IO::Socket;
my $socket=IO::Socket::UNIX->new(Peer => '/home/httpd/sockets/maximasock',
Type => SOCK_STREAM,
Timeout => 10);
while ($in=<STDIN>) {
chomp($in);
print $socket &escape($cmd)."\n";
print &unescape(<$socket>);
}
close($socket);
# -------------------------------------------------------- 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;
}
--www1141425312--