loncom/lonmaxima - diff

Return to lonmaxima CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lonmaxima between versions 1.3 and 1.8

version 1.3, 2006/03/03 23:25:47	version 1.8, 2006/03/04 06:44:11
Line 48 my $MAX_CLIENTS_PER_CHILD = 5; #	Line 48 my $MAX_CLIENTS_PER_CHILD = 5; #
my %children = (); # keys are current child process IDs	my %children = (); # keys are current child process IDs
my $children = 0; # current number of children	my $children = 0; # current number of children
my $status; # string for current status	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	use vars qw($PREFORK $MAX_CLIENTS_PER_CHILD %children $children $status
$cmd_in $cmd_out $cmd_err $pidfile $port %perlvar $lastlog	$pidfile $port %perlvar $lastlog);
$currenthostid $client $server $cmd
);

sub maximareply {	sub maximareply {
my $cmd=shift;	my ($cmd) = @_;
my $reply='';	my $reply='';
my $error='';	my $error='';
my $exitstatus='';	my $exitstatus='';

unless ($cmd=~/\;\n$/) { $cmd.=";\n"; }	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;	print $cmd_in $cmd;
close $cmd_in;	close($cmd_in);

&status("Command sent");	&status("Command sent");

	$SIG{ALRM} = sub { kill 9 => $maximapid; };
	alarm(5);
	no strict 'refs';

my $selector = IO::Select->new();	my $selector = IO::Select->new();

$selector->add($cmd_err, $cmd_out);	$selector->add($cmd_err, $cmd_out);

while (my @ready = $selector->can_read) {	while (my @ready = $selector->can_read()) {
foreach my $fh (@ready) {	foreach my $fh (@ready) {
if (fileno($fh) == fileno($cmd_err)) {	if (fileno($fh) == fileno($cmd_err)) {
$error.=<$cmd_err>;	$error.=<$cmd_err>;
} else {	} else {
my $line = scalar <$cmd_out>;	my $line = scalar(<$cmd_out>);
if ($line=~/^(\(\%o\|\s)/) {	if ($line=~/^(\(\%o\|\s)/) {
$line=~s/^$.*$/ /;	$line=~s/^$.*$/ /;
$reply.=$line;	$reply.=$line;
}	}
}	}
$selector->remove($fh) if eof($fh);	$selector->remove($fh) if eof($fh);
}	}
}	}
close $cmd_out;	alarm(0);
close $cmd_err;	$SIG{ALRM} = 'DEFAULT';
	close($cmd_out);
	close($cmd_err);
	use strict 'refs';
&status("Command processed");	&status("Command processed");
return ($reply,$error,$exitstatus);	return ($reply,$error,$exitstatus);
}	}
Line 97 sub REAPER { # ta	Line 108 sub REAPER { # ta
# and MAXIMA processes	# and MAXIMA processes
$SIG{CHLD} = \&REAPER;	$SIG{CHLD} = \&REAPER;
my $pid = wait;	my $pid = wait;
$children --;	$children--;
delete $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 115 sub HUNTSMAN { # si	Line 126 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 127 sub logthis {	Line 138 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 137 sub status {	Line 148 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 145 sub escape {	Line 156 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 156 sub catchexception {	Line 167 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
Line 178 $SIG{__DIE__}=\&catchexception;	Line 189 $SIG{__DIE__}=\&catchexception;
# ----------------------------- 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 190 if ($wwwid!=$<) {	Line 201 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 203 $port = "$perlvar{'lonSockDir'}/maximaso	Line 215 $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');






# Fork off our children.	# Fork off our children.
for (1 .. $PREFORK) {	for (1 .. $PREFORK) {
make_new_child( );	&make_new_child($server);
}	}

# Install signal handlers.	# Install signal handlers.
Line 253 while (1) {	Line 262 while (1) {
sleep; # wait for a signal (i.e., child's death)	sleep; # wait for a signal (i.e., child's death)
for (my $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	&make_new_child($server); # top up the child pool
}	}
}	}

sub make_new_child {	sub make_new_child {
my $pid;	my ($server) = @_;
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} = 1;
$children++;	$children++;
return;	return;
Line 281 sub make_new_child {	Line 289 sub make_new_child {

# 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");

# handle connections until we've reached $MAX_CLIENTS_PER_CHILD	&process_requests($server);
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";
}
}

# tidy up gracefully and finish	# tidy up gracefully and finish

# this exit is VERY important, otherwise the child will become	# this exit is VERY important, otherwise the child will become
Line 301 sub make_new_child {	Line 301 sub make_new_child {
exit;	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";
	}
	}
	}

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

Removed from v.1.3
changed lines
	Added in v.1.8