version 1.5, 2006/03/03 23:41:38
|
version 1.16, 2006/03/08 22:30:11
|
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 52 my $pidfile; #
|
Line 52 my $pidfile; #
|
my $port; # path to UNIX socket file |
my $port; # path to UNIX socket file |
my %perlvar; # configuration file info |
my %perlvar; # configuration file info |
my $lastlog; # last string that was logged |
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 |
$pidfile $port %perlvar $lastlog); |
$pidfile $port %perlvar $lastlog); |
|
|
sub maximareply { |
|
my ($cmd) = @_; |
|
my $reply=''; |
|
my $error=''; |
|
my $exitstatus=''; |
|
|
|
unless ($cmd=~/\;\n$/) { $cmd.=";\n"; } |
|
|
|
my ($cmd_in, $cmd_out, $cmd_err); |
|
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 197 if (-e $pidfile) {
|
Line 156 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 |
Line 208 $port = "$perlvar{'lonSockDir'}/maximaso
|
Line 167 $port = "$perlvar{'lonSockDir'}/maximaso
|
unlink($port); |
unlink($port); |
|
|
|
|
my $server; |
my $server = IO::Socket::UNIX->new(Local => $port, |
unless ( |
Type => SOCK_STREAM, |
$server = IO::Socket::UNIX->new(Local => $port, |
Listen => 10 ); |
Type => SOCK_STREAM, |
if (!$server) { |
Listen => 10 ) |
my $st=120+int(rand(240)); |
) { |
|
my $st=120+int(rand(240)); |
&logthis("<font color=blue>WARNING: ". |
&logthis( |
"Can't make server socket ($st secs): .. exiting</font>"); |
"<font color=blue>WARNING: ". |
|
"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: $!"; |
|
|
Line 239 print PIDSAVE "$$\n";
|
Line 197 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; |
|
|
# Fork off our children. |
# Fork off our children. |
for (1 .. $PREFORK) { |
for (1 .. $PREFORK) { |
&make_new_child($server); |
&make_new_child($server); |
} |
} |
|
|
# 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'); |
Line 269 sub make_new_child {
|
Line 224 sub make_new_child {
|
# 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; |
Line 286 sub make_new_child {
|
Line 241 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"); |
|
|
|
my $command=Expect->spawn('maxima'); |
|
$command->log_stdout(0); |
|
|
|
&getmaximaoutput($command); |
|
|
&process_requests($server); |
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 $command &unescape($cmd).";\n"; |
|
print $client &escape(&getmaximaoutput($command))."\n"; |
|
} |
|
} |
|
|
# 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. |
Line 299 sub make_new_child {
|
Line 269 sub make_new_child {
|
} |
} |
} |
} |
|
|
sub process_requests { |
sub getmaximaoutput { |
my ($server) = @_; |
my ($command)=@_; |
# handle connections until we've reached $MAX_CLIENTS_PER_CHILD |
my (undef,undef,undef,$output)=$command->expect(20, -re => '\(\%i\d+\)'); |
for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { |
my $foundoutput=0; |
&status('Accepting connections'); |
my $realoutput=''; |
my $client = $server->accept() or last; |
foreach my $line (split(/\n/,$output)) { |
while (my $cmd=<$client>) { |
if ($line=~/\;/) { $foundoutput=1; next; } |
&status('Processing command'); |
if (!$foundoutput) { next; } |
print $client &escape((&maximareply(&unescape($cmd)))[0])."\n"; |
my ($label)=($line=~s/^(\(\%o\d+\))//); |
} |
if ($label) { |
} |
$label=~s/\S/ /g; |
|
$line=$label.$line; |
|
} |
|
$realoutput.=$line."\n"; |
|
} |
|
return $realoutput; |
} |
} |