loncom/lonmaxima - diff

Return to lonmaxima CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lonmaxima between versions 1.2 and 1.15

version 1.2, 2006/03/03 22:35:09	version 1.15, 2006/03/08 15:58:03
Line 30	Line 30
# http://www.lon-capa.org/	# 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 IPC::Open3;
use IO::Select;	use IO::Select;
Line 45 use POSIX;	Line 40 use POSIX;
use lib '/home/httpd/lib/perl/';	use lib '/home/httpd/lib/perl/';
use LONCAPA::Configuration;	use LONCAPA::Configuration;

# Scary: cannot use strict!!!	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");

my $selector = IO::Select->new();	# global variables
$selector->add($cmd_err, $cmd_out);	my $STARTPORT = 5664; # port for first child's server
	my $PREFORK = 5; # number of children to maintain
while (my @ready = $selector->can_read) {	my $MAX_CLIENTS_PER_CHILD = 5; # number of clients each child should process
foreach my $fh (@ready) {	my %children = (); # keys are current child process IDs
if (fileno($fh) == fileno($cmd_err)) {	my %usedmaximaports = (); # keys are the used maximaports
$error.=<$cmd_err>;	my $children = 0; # current number of children
} else {	my $status; # string for current status
my $line = scalar <$cmd_out>;	my $pidfile; # file containg parent process pid
if ($line=~/^(\(\%o\|\s)/) {	my $port; # path to UNIX socket file
$line=~s/^$.*$/ /;	my %perlvar; # configuration file info
$reply.=$line;	my $lastlog; # last string that was logged
}	use vars qw($PREFORK $MAX_CLIENTS_PER_CHILD %children $children %usedmaximaports $status
}	$pidfile $port %perlvar $lastlog);
$selector->remove($fh) if eof($fh);
}
}
close $cmd_out;
close $cmd_err;
&status("Command processed");
return ($reply,$error,$exitstatus);
}

# ------------------------------------------------------------ Service routines	# ------------------------------------------------------------ Service routines
sub REAPER { # takes care of dead children	sub REAPER { # takes care of dead children
# and MAXIMA processes	# and MAXIMA processes
$SIG{CHLD} = \&REAPER;	$SIG{CHLD} = \&REAPER;
my $pid = wait;	my $pid = wait;
$children --;	$children--;
delete $children{$pid};	&logthis("Child $pid for port or process $children{$pid} died");
	delete($usedmaximaports{$children{$pid}});
	delete($children{$pid});
}	}

sub HUNTSMAN { # signal handler for SIGINT	sub HUNTSMAN { # signal handler for SIGINT
local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children	local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children
kill 'INT' => keys %children;	kill('INT' => keys(%children));
unlink($pidfile);	unlink($pidfile);
unlink($port);	unlink($port);
&logthis('---- Shutdown ----');	&logthis('---- Shutdown ----');
Line 109 sub HUNTSMAN { # si	Line 82 sub HUNTSMAN { # si
# --------------------------------------------------------------------- Logging	# --------------------------------------------------------------------- Logging

sub logthis {	sub logthis {
my $message=shift;	my ($message)=@_;
my $execdir=$perlvar{'lonDaemons'};	my $execdir=$perlvar{'lonDaemons'};
my $fh=IO::File->new(">>$execdir/logs/lonmaxima.log");	my $fh=IO::File->new(">>$execdir/logs/lonmaxima.log");
my $now=time;	my $now=time;
Line 121 sub logthis {	Line 94 sub logthis {
# -------------------------------------------------------------- Status setting	# -------------------------------------------------------------- Status setting

sub status {	sub status {
my $what=shift;	my ($what)=@_;
my $now=time;	my $now=time;
my $local=localtime($now);	my $local=localtime($now);
$status=$local.': '.$what;	$status=$local.': '.$what;
Line 131 sub status {	Line 104 sub status {
# -------------------------------------------------------- Escape Special Chars	# -------------------------------------------------------- Escape Special Chars

sub escape {	sub escape {
my $str=shift;	my ($str)=@_;
$str =~ s/(\W)/"%".unpack('H2',$1)/eg;	$str =~ s/(\W)/"%".unpack('H2',$1)/eg;
return $str;	return $str;
}	}
Line 139 sub escape {	Line 112 sub escape {
# ----------------------------------------------------- Un-Escape Special Chars	# ----------------------------------------------------- Un-Escape Special Chars

sub unescape {	sub unescape {
my $str=shift;	my ($str)=@_;
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;	$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
return $str;	return $str;
}	}
Line 150 sub catchexception {	Line 123 sub catchexception {
$SIG{QUIT}='DEFAULT';	$SIG{QUIT}='DEFAULT';
$SIG{__DIE__}='DEFAULT';	$SIG{__DIE__}='DEFAULT';
chomp($signal);	chomp($signal);
&logthis("<font color=red>CRITICAL: "	&logthis("<font color=\"red\">CRITICAL: "
."ABNORMAL EXIT. Child $$ died through "	."ABNORMAL EXIT. Child $$ died through "
."\"$signal\"</font>");	."\"$signal\"</font>");
die("Signal abend");	die("Signal abend");
}	}



# ---------------------------------------------------------------- Main program	# ---------------------------------------------------------------- Main program
# -------------------------------- Set signal handlers to record abnormal exits	# -------------------------------- Set signal handlers to record abnormal exits
Line 167 $SIG{__DIE__}=\&catchexception;	Line 138 $SIG{__DIE__}=\&catchexception;

# ---------------------------------- Read loncapa_apache.conf and loncapa.conf	# ---------------------------------- Read loncapa_apache.conf and loncapa.conf
&status("Read loncapa.conf and loncapa_apache.conf");	&status("Read loncapa.conf and loncapa_apache.conf");
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');	%perlvar=%{&LONCAPA::Configuration::read_conf('loncapa.conf')};
%perlvar=%{$perlvarref};
undef $perlvarref;

# ----------------------------- Make sure this process is running from user=www	# ----------------------------- Make sure this process is running from user=www
my $wwwid=getpwnam('www');	my $wwwid=getpwnam('www');
if ($wwwid!=$<) {	if ($wwwid!=$<) {
my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";	my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
my $subj="LON: $currenthostid User ID mismatch";	my $subj="LON: User ID mismatch";
system("echo 'User ID mismatch. lonmaxima must be run as user www.' \|\	system("echo 'User ID mismatch. lonmaxima must be run as user www.' \|\
mailto $emailto -s '$subj' > /dev/null");	mailto $emailto -s '$subj' > /dev/null");
exit 1;	exit 1;
}	}

# --------------------------------------------- Check if other instance running	# --------------------------------------------- Check if other instance running
Line 186 if ($wwwid!=$<) {	Line 155 if ($wwwid!=$<) {
$pidfile="$perlvar{'lonDaemons'}/logs/lonmaxima.pid";	$pidfile="$perlvar{'lonDaemons'}/logs/lonmaxima.pid";

if (-e $pidfile) {	if (-e $pidfile) {
my $lfh=IO::File->new("$pidfile");	my $lfh=IO::File->new("$pidfile");
my $pide=<$lfh>;	my $pide=<$lfh>;
chomp($pide);	chomp($pide);
if (kill 0 => $pide) { die "already running"; }	if (kill(0 => $pide)) { die "already running"; }
}	}

# ------------------------------------------------------- Listen to UNIX socket	# ------------------------------------------------------- Listen to UNIX socket
&status("Opening socket");	&status("Opening socket");

Line 199 $port = "$perlvar{'lonSockDir'}/maximaso	Line 169 $port = "$perlvar{'lonSockDir'}/maximaso
unlink($port);	unlink($port);


unless (	my $server = IO::Socket::UNIX->new(Local => $port,
$server = IO::Socket::UNIX->new(Local => $port,	Type => SOCK_STREAM,
Type => SOCK_STREAM,	Listen => 10 );
Listen => 10 )	if (!$server) {
) {	my $st=120+int(rand(240));
my $st=120+int(rand(240));
&logthis(	&logthis("<font color=blue>WARNING: ".
"<font color=blue>WARNING: ".	"Can't make server socket ($st secs): .. exiting</font>");
"Can't make server socket ($st secs): .. exiting</font>");
sleep($st);	sleep($st);
exit;	exit;
};	}


# ---------------------------------------------------- Fork once and dissociate	# ---------------------------------------------------- Fork once and dissociate

my $fpid=fork;	my $fpid=fork;
exit if $fpid;	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: $!";	POSIX::setsid() or die "Can't start new session: $!";

# ------------------------------------------------------- Write our PID on disk	# ------------------------------------------------------- Write our PID on disk

my $execdir=$perlvar{'lonDaemons'};	my $execdir=$perlvar{'lonDaemons'};
open (PIDSAVE,">$execdir/logs/lonmaxima.pid");	open(PIDSAVE,">$execdir/logs/lonmaxima.pid");
print PIDSAVE "$$\n";	print PIDSAVE "$$\n";
close(PIDSAVE);	close(PIDSAVE);
&logthis("<font color='red'>CRITICAL: ---------- Starting ----------</font>");	&logthis("<font color='red'>CRITICAL: ---------- Starting ----------</font>");
&status('Starting');	&status('Starting');



	# Install signal handlers.
	$SIG{CHLD} = \&REAPER;
	$SIG{INT} = $SIG{TERM} = \&HUNTSMAN;

	my $maximaport=$STARTPORT;
# Fork off our children.	# Fork off our children.
for (1 .. $PREFORK) {	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.	# And maintain the population.
while (1) {	while (1) {
&status('Parent process, sleeping');	&status('Parent process, sleeping');
sleep; # wait for a signal (i.e., child's death)	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');	&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 {	sub make_new_child {
my $pid;	my ($server,$maximaport) = @_;
my $sigset;

# block signal for fork	# block signal for fork
$sigset = POSIX::SigSet->new(SIGINT);	my $sigset = POSIX::SigSet->new(SIGINT);
sigprocmask(SIG_BLOCK, $sigset)	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) {	if ($pid) {
# Parent records the child's birth and returns.	# Parent records the child's birth and returns.
sigprocmask(SIG_UNBLOCK, $sigset)	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{$pid} = $maximaport;
$children++;	$children++;
	$usedmaximaports{$maximaport}=1;
return;	return;
} else {	} else {
	&logthis("Starting child on port $maximaport");
# Child can not return from this subroutine.	# Child can not return from this subroutine.
$SIG{INT} = 'DEFAULT'; # make SIGINT kill us as it did before	$SIG{INT} = 'DEFAULT'; # make SIGINT kill us as it did before

# unblock signals	# unblock signals
sigprocmask(SIG_UNBLOCK, $sigset)	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	# handle connections until we've reached $MAX_CLIENTS_PER_CHILD
for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {	for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
&status('Accepting connections');	&status('Accepting connections for '.$maximapid.' on '.$maximaport);
$client = $server->accept( ) or last;	my $client = $server->accept() or last;
while ($cmd=<$client>) {	while (my $cmd=<$client>) {
&status('Processing command');	&status('Processing command by '.$maximapid.' on '.$maximaport);
print $client &escape((&maximareply(&unescape($cmd)))[0])."\n";	&maximawrite($maximaselect,&unescape($cmd).";\n");
}	print $client &escape(&maximareply($maximaselect))."\n";
	}
}	}

# tidy up gracefully and finish	# 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	# this exit is VERY important, otherwise the child will become
# a producer of more and more children, forking yourself into	# a producer of more and more children, forking yourself into
# process death.	# process death.
exit;	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));
	}
	}

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.2
changed lines
	Added in v.1.15