loncom/lonmaxima - diff

Return to lonmaxima CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lonmaxima between versions 1.2 and 1.5

version 1.2, 2006/03/03 22:35:09	version 1.5, 2006/03/03 23:41:38
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;
	# global variables
	my $PREFORK = 5; # number of children to maintain
	my $MAX_CLIENTS_PER_CHILD = 5; # number of clients each child should process
	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
	$pidfile $port %perlvar $lastlog);

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 ($cmd_in, $cmd_out, $cmd_err);
my $pid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima');	my $pid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima');
$children{$pid} = 1;	$children{$pid} = 1;

print $cmd_in $cmd;	print $cmd_in $cmd;
close $cmd_in;	close($cmd_in);

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

Line 73 sub maximareply {	Line 83 sub maximareply {
} 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;	close($cmd_out);
close $cmd_err;	close($cmd_err);
&status("Command processed");	&status("Command processed");
return ($reply,$error,$exitstatus);	return ($reply,$error,$exitstatus);
}	}
Line 109 sub HUNTSMAN { # si	Line 119 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 131 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 141 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 149 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 160 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 167 $SIG{__DIE__}=\&catchexception;	Line 177 $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 194 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 208 $port = "$perlvar{'lonSockDir'}/maximaso
unlink($port);	unlink($port);


	my $server;
unless (	unless (
$server = IO::Socket::UNIX->new(Local => $port,	$server = IO::Socket::UNIX->new(Local => $port,
Type => SOCK_STREAM,	Type => SOCK_STREAM,
Line 224 POSIX::setsid() or die "Can't start new	Line 234 POSIX::setsid() or die "Can't start new
# ------------------------------------------------------- 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>");
Line 236 close(PIDSAVE);	Line 246 close(PIDSAVE);

# 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 247 $SIG{INT} = $SIG{TERM} = \&HUNTSMAN;	Line 257 $SIG{INT} = $SIG{TERM} = \&HUNTSMAN;
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	&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.
Line 278 sub make_new_child {	Line 287 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 ($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 297 sub make_new_child {	Line 298 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.2
changed lines
	Added in v.1.5