version 1.4, 2006/03/03 23:31:06
|
version 1.43, 2018/10/29 02:57:30
|
Line 30
|
Line 30
|
# http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
# |
# |
|
|
|
use Expect; |
use IPC::Open3; |
|
use IO::Select; |
use IO::Select; |
use IO::Socket; |
use IO::Socket; |
use IO::File; |
use IO::File; |
Line 44 use strict;
|
Line 43 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 $extra_children = 0; |
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) = @_; |
|
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 --; |
if (exists($children{$pid})) { |
delete $children{$pid}; |
$children--; |
|
delete($children{$pid}); |
|
if ($extra_children) { |
|
$extra_children--; |
|
} |
|
} |
} |
} |
|
|
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 156 sub catchexception {
|
Line 125 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"); |
} |
} |
|
|
|
|
|
|
|
sub child_announce_death { |
|
$SIG{USR1} = \&child_announce_death; |
|
if ($extra_children < $PREFORK*10) { |
|
$extra_children++; |
|
} |
|
} |
|
|
# ---------------------------------------------------------------- Main program |
# ---------------------------------------------------------------- Main program |
# -------------------------------- Set signal handlers to record abnormal exits |
# -------------------------------- Set signal handlers to record abnormal exits |
|
|
|
|
$SIG{'QUIT'}=\&catchexception; |
$SIG{'QUIT'}=\&catchexception; |
$SIG{__DIE__}=\&catchexception; |
$SIG{__DIE__}=\&catchexception; |
|
$SIG{USR1} = \&child_announce_death; |
|
|
# ---------------------------------- 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"); |
Line 178 $SIG{__DIE__}=\&catchexception;
|
Line 154 $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 -s '$subj' $emailto > /dev/null"); |
exit 1; |
exit 1; |
} |
} |
|
|
# --------------------------------------------- Check if other instance running |
# --------------------------------------------- Check if other instance running |
Line 190 if ($wwwid!=$<) {
|
Line 166 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 180 $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+$extra_children; $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 ($server) = @_; |
|
|
# block signal for fork |
# block signal for fork |
my $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 (my $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; |
} else { |
} else { |
# 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 |
|
|
my $ppid = getppid(); |
|
|
# 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"); |
|
|
&process_requests(); |
&logthis('New process started'); |
|
|
|
my $command = new Expect(); |
|
$command->log_stdout(0); |
|
#$command->log_file("$execdir/logs/lonmaxima.session.log"); |
|
$command->spawn('maxima'); |
|
&getmaximaoutput($command, 2); # wait for maxima to finish initialization |
|
# soft/hard_close can take awhile and we really |
|
# don't care we just want it gone |
|
$SIG{INT} = sub { |
|
my $pid = $command->pid(); |
|
kill('KILL'=>$pid); |
|
exit; |
|
}; |
|
|
|
|
|
for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { |
|
&status('Accepting connections'); |
|
my $client = $server->accept() or last; |
|
&sync($command); |
|
print $command ("display2d:false;simp:true;kill(all);\n"); |
|
&getmaximaoutput($command,2); |
|
&sync($command); |
|
my $syntaxerr = 0; |
|
while (my $cmd=<$client>) { |
|
&status('Processing command'); |
|
print $command &unescape($cmd); |
|
my ($reply,$syntaxerr) = &getmaximaoutput($command,1); |
|
print $client &escape($reply)."\n"; |
|
if ($syntaxerr) { |
|
last; |
|
} elsif ($reply=~/^Error\:/) { |
|
&logthis('Died through '.$reply); |
|
kill('USR1' => $ppid); |
|
$client->close(); |
|
$command->hard_close(); |
|
exit; |
|
} |
|
&sync($command); |
|
&status('Waiting for commands'); |
|
} |
|
} |
|
|
|
kill('USR1' => $ppid); |
|
print $command ("quit();\n"); |
# tidy up gracefully and finish |
# tidy up gracefully and finish |
|
sleep(15); |
|
$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 |
Line 292 sub make_new_child {
|
Line 313 sub make_new_child {
|
} |
} |
} |
} |
|
|
sub process_requests { |
{ |
# handle connections until we've reached $MAX_CLIENTS_PER_CHILD |
my $counter; |
for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { |
sub sync { |
&status('Accepting connections'); |
my ($command)=@_; |
$client = $server->accept( ) or last; |
$counter++; |
while ($cmd=<$client>) { |
my $expect=$counter.time; |
&status('Processing command'); |
print $command "$expect;\n"; |
print $client &escape((&maximareply(&unescape($cmd)))[0])."\n"; |
while (1) { |
|
my $output=&getmaximaoutput($command,1); |
|
if (($output=~/\Q$expect\E/) || ($output=~/^Error\:/)) { |
|
return; |
|
} |
|
} |
|
} |
|
} |
|
|
|
sub getmaximaoutput { |
|
my ($command,$numcheck)=@_; |
|
my $regexp = '\(\%i\d+\)'; |
|
my $syntaxerr=0; |
|
if ($numcheck) { |
|
if ($numcheck eq 2) { |
|
# command was the killall so should get a full reset on |
|
# command numbers |
|
$regexp = '(\(\%i(1)\)|[Ii]ncorrect syntax\:)'; |
|
} elsif ($command->match() =~ /\(\%i(\d+)\)/) { |
|
my $nextmatch = $1+1; |
|
$regexp = '(\(\%i'.$nextmatch.'\)|[Ii]ncorrect syntax\:)'; |
|
} |
|
} |
|
my $timeout = 20; |
|
my (undef,$error,$matched,$output) = |
|
$command->expect($timeout, -re => $regexp); |
|
|
|
if ($numcheck && lc($matched) eq 'incorrect syntax:') { |
|
$syntaxerr = 1; |
|
if (wantarray) { |
|
return ($matched,$syntaxerr); |
|
} else { |
|
return $matched; |
} |
} |
} |
} |
|
if ($error) { |
|
return 'Error: '.$error; |
|
} |
|
$output =~ s/\r+//gs; # Remove Windows-style linebreaks |
|
my $foundoutput=0; |
|
my $found_label=0; |
|
my $realoutput=''; |
|
foreach my $line (split(/\n/,$output)) { |
|
if ($line=~/\;/) { $foundoutput=1; next; } |
|
if (!$foundoutput) { next; } |
|
if ($line=~/^[Ii]ncorrect syntax:/) { $syntaxerr = 1; next; } |
|
if ($line=~ /^(\(\%o\d+\))(.+)$/){ |
|
my $label = $1; |
|
$line = $2; |
|
$label =~s/\S/ /g; |
|
$line=$label.$line; |
|
$found_label=1; |
|
} |
|
if ($found_label) { |
|
$realoutput.=$line."\n"; |
|
} |
|
} |
|
if (wantarray) { |
|
return ($realoutput,$syntaxerr); |
|
} else { |
|
return $realoutput; |
|
} |
} |
} |