loncom/lonmaxima - diff

Return to lonmaxima CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lonmaxima between versions 1.3 and 1.18

version 1.3, 2006/03/03 23:25:47	version 1.18, 2006/05/10 01:08:01
Line 30	Line 30
# http://www.lon-capa.org/	# http://www.lon-capa.org/
#	#

	use Expect;
use IPC::Open3;	use IPC::Open3;
use IO::Select;	use IO::Select;
use IO::Socket;	use IO::Socket;
Line 44 use strict;	Line 44 use strict;

# global variables	# global variables
my $PREFORK = 5; # number of children to maintain	my $PREFORK = 5; # number of children to maintain
my $MAX_CLIENTS_PER_CHILD = 5; # number of clients each child should process	my $MAX_CLIENTS_PER_CHILD = 50; # number of clients each child should process
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 {
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();
$selector->add($cmd_err, $cmd_out);

while (my @ready = $selector->can_read) {
foreach my $fh (@ready) {
if (fileno($fh) == fileno($cmd_err)) {
$error.=<$cmd_err>;
} else {
my $line = scalar <$cmd_out>;
if ($line=~/^(\(\%o\|\s)/) {
$line=~s/^$.*$/ /;
$reply.=$line;
}
}
$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};	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 79 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 91 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 101 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 109 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 120 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 142 $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 154 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 168 $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.
for (1 .. $PREFORK) {
make_new_child( );
}

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

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

# 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 (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 242 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	&logthis('New process started');

	my $command=Expect->spawn('maxima');
	$command->log_stdout(0);

	&getmaximaoutput($command);

for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {	for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
&status('Accepting connections');	&status('Accepting connections');
$client = $server->accept( ) or last;	my $client = $server->accept() or last;
while ($cmd=<$client>) {	print $command "kill(all);reset();\n";
&status('Processing command');	&getmaximaoutput($command);
print $client &escape((&maximareply(&unescape($cmd)))[0])."\n";	while (my $cmd=<$client>) {
}	&status('Processing command');
	&sync($command);
	print $command &unescape($cmd);
	my $reply=&getmaximaoutput($command);
	print $client &escape($reply)."\n";
	if ($reply=~/^Error\:/) {
	&logthis('Died through '.$reply);
	$client->close();
	$command->hard_close();
	exit;
	}
	&status('Waiting for commands');
	}
}	}

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

	$command->soft_close();

# 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;
}	}
}	}

	{
	my $counter;
	sub sync {
	my ($command)=@_;
	$counter++;
	my $expect=$counter.time;
	print $command "$expect;\n";
	while (1) {
	my $output=&getmaximaoutput($command);
	if (($output=~/\Q$expect\E/) \|\| ($output=~/^Error\:/)) {
	return;
	}
	}
	}
	}

	sub getmaximaoutput {
	my ($command)=@_;
	my (undef,$error,undef,$output)=$command->expect(20, -re => '$\%i\d+$');
	if ($error) {
	return 'Error: '.$error;
	}
	my $foundoutput=0;
	my $realoutput='';
	foreach my $line (split(/\n/,$output)) {
	if ($line=~/\;/) { $foundoutput=1; next; }
	if (!$foundoutput) { next; }
	my ($label)=($line=~s/^($\%o\d+$)//);
	if ($label) {
	$label=~s/\S/ /g;
	$line=$label.$line;
	}
	$realoutput.=$line."\n";
	}
	return $realoutput;
	}

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

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