--- loncom/lonmaxima 2006/03/03 23:25:47 1.3
+++ loncom/lonmaxima 2006/03/03 23:41:38 1.5
@@ -3,7 +3,7 @@
# The LearningOnline Network with CAPA
# Connect to MAXIMA CAS
#
-# $Id: lonmaxima,v 1.3 2006/03/03 23:25:47 albertel Exp $
+# $Id: lonmaxima,v 1.5 2006/03/03 23:41:38 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -48,24 +48,28 @@ 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=shift;
+ my ($cmd) = @_;
my $reply='';
my $error='';
my $exitstatus='';
unless ($cmd=~/\;\n$/) { $cmd.=";\n"; }
+
+ my ($cmd_in, $cmd_out, $cmd_err);
my $pid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima');
$children{$pid} = 1;
print $cmd_in $cmd;
- close $cmd_in;
+ close($cmd_in);
&status("Command sent");
@@ -79,15 +83,15 @@ sub maximareply {
} else {
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;
+ close($cmd_out);
+ close($cmd_err);
&status("Command processed");
return ($reply,$error,$exitstatus);
}
@@ -115,7 +119,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;
@@ -127,7 +131,7 @@ sub logthis {
# -------------------------------------------------------------- Status setting
sub status {
- my $what=shift;
+ my ($what)=@_;
my $now=time;
my $local=localtime($now);
$status=$local.': '.$what;
@@ -137,7 +141,7 @@ sub status {
# -------------------------------------------------------- Escape Special Chars
sub escape {
- my $str=shift;
+ my ($str)=@_;
$str =~ s/(\W)/"%".unpack('H2',$1)/eg;
return $str;
}
@@ -145,7 +149,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;
}
@@ -156,12 +160,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 +182,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 +194,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,6 +208,7 @@ $port = "$perlvar{'lonSockDir'}/maximaso
unlink($port);
+my $server;
unless (
$server = IO::Socket::UNIX->new(Local => $port,
Type => SOCK_STREAM,
@@ -228,7 +234,7 @@ POSIX::setsid() or die "Can't start new
# ------------------------------------------------------- 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 ----------");
@@ -240,7 +246,7 @@ close(PIDSAVE);
# Fork off our children.
for (1 .. $PREFORK) {
- make_new_child( );
+ &make_new_child($server);
}
# Install signal handlers.
@@ -253,20 +259,19 @@ 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 $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";
- die "fork: $!" unless defined ($pid = fork);
+ die "fork: $!" unless defined (my $pid = fork);
if ($pid) {
# Parent records the child's birth and returns.
@@ -282,17 +287,9 @@ 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 (my $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";
- }
- }
-
+
+ &process_requests($server);
+
# tidy up gracefully and finish
# this exit is VERY important, otherwise the child will become
@@ -301,3 +298,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";
+ }
+ }
+}