version 1.14, 2006/03/08 14:22:14
|
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; |
use IO::File; |
use IO::File; |
use Symbol; |
use Symbol; |
use POSIX; |
use POSIX; |
use Fcntl; |
|
use Socket; |
|
use lib '/home/httpd/lib/perl/'; |
use lib '/home/httpd/lib/perl/'; |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
|
|
use strict; |
use strict; |
|
|
# global variables |
# global variables |
my $STARTPORT = 5664; # port for first child's server |
|
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 %usedmaximaports = (); # keys are the used maximaports |
|
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 $pidfile; # file containg parent process pid |
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 %usedmaximaports $status |
|
|
use vars qw($PREFORK $MAX_CLIENTS_PER_CHILD %children $children $status |
$pidfile $port %perlvar $lastlog); |
$pidfile $port %perlvar $lastlog); |
|
|
# ------------------------------------------------------------ Service routines |
# ------------------------------------------------------------ Service routines |
Line 65 sub REAPER { # ta
|
Line 62 sub REAPER { # ta
|
$SIG{CHLD} = \&REAPER; |
$SIG{CHLD} = \&REAPER; |
my $pid = wait; |
my $pid = wait; |
$children--; |
$children--; |
&logthis("Child $pid for port or process $children{$pid} died"); |
|
delete($usedmaximaports{$children{$pid}}); |
|
delete($children{$pid}); |
delete($children{$pid}); |
} |
} |
|
|
Line 131 sub catchexception {
|
Line 126 sub catchexception {
|
die("Signal abend"); |
die("Signal abend"); |
} |
} |
|
|
# -------------------------------------------------- make a socket non-blocking |
|
sub nonblock { |
|
my $socket = shift; |
|
my $flags; |
|
if (ref($socket)) { |
|
$flags = fcntl($socket, F_GETFL, 0) |
|
or die "Can't get flags for socket: $!\n"; |
|
fcntl($socket, F_SETFL, $flags | O_NONBLOCK) |
|
or die "Can't make socket nonblocking: $!\n"; |
|
} |
|
} |
|
|
|
# ---------------------------------------------------------------- Main program |
# ---------------------------------------------------------------- Main program |
# -------------------------------- Set signal handlers to record abnormal exits |
# -------------------------------- Set signal handlers to record abnormal exits |
Line 218 close(PIDSAVE);
|
Line 203 close(PIDSAVE);
|
# Install signal handlers. |
# Install signal handlers. |
$SIG{CHLD} = \&REAPER; |
$SIG{CHLD} = \&REAPER; |
$SIG{INT} = $SIG{TERM} = \&HUNTSMAN; |
$SIG{INT} = $SIG{TERM} = \&HUNTSMAN; |
|
|
my $maximaport=$STARTPORT; |
|
# Fork off our children. |
# Fork off our children. |
for (1 .. $PREFORK) { |
for (1 .. $PREFORK) { |
&make_new_child($server,$maximaport); |
&make_new_child($server); |
$maximaport++; |
|
} |
} |
|
|
# And maintain the population. |
# And maintain the population. |
Line 232 while (1) {
|
Line 215 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'); |
my $newport; |
&make_new_child($server); # top up the child pool |
&logthis("Current pool: ".join(', ',keys %usedmaximaports)); |
|
foreach my $testport ($STARTPORT .. $STARTPORT+$PREFORK-1) { |
|
if (!$usedmaximaports{$testport}) { $newport=$testport; } |
|
} |
|
if ($newport) { |
|
&make_new_child($server,$newport); # top up the child pool |
|
} |
|
} |
} |
} |
} |
|
|
sub make_new_child { |
sub make_new_child { |
my ($server,$maximaport) = @_; |
my ($server) = @_; |
|
|
# block signal for fork |
# block signal for fork |
my $sigset = POSIX::SigSet->new(SIGINT); |
my $sigset = POSIX::SigSet->new(SIGINT); |
Line 257 sub make_new_child {
|
Line 233 sub make_new_child {
|
# 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} = $maximaport; |
$children{$pid} = 1; |
$children++; |
$children++; |
$usedmaximaports{$maximaport}=1; |
|
return; |
return; |
} else { |
} else { |
&logthis("Starting child on port $maximaport"); |
|
# 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 |
$SIG{INT} = 'DEFAULT'; # make SIGINT kill us as it did before |
|
|
# 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"); |
|
|
# open the MAXIMA port |
&logthis('New process started'); |
my $maximaserver = IO::Socket::INET->new(LocalPort => $maximaport, |
|
Type => SOCK_STREAM, |
my $command=Expect->spawn('maxima'); |
Proto => 'tcp', |
$command->log_stdout(0); |
Reuse => 1, |
|
Listen => 10 ) |
&getmaximaoutput($command); |
or die "making socket: $@\n"; |
|
&nonblock($maximaserver); |
|
my $maximaselect=IO::Select->new($maximaserver); |
|
sleep(2); |
|
|
|
# open MAXIMA to talk to that port |
|
my ($cmd_in, $cmd_out, $cmd_err); |
|
my $maximapid = open3($cmd_in, $cmd_out, $cmd_err, "maxima -s $maximaport"); |
|
$children{$maximapid} = "Maxima $maximapid port $maximaport"; |
|
my $prompt=<$cmd_out>; |
|
&logthis("Maxima $maximapid: $prompt"); |
|
|
|
# hopefully, MAXIMA calls us back |
|
&status("Waiting $maximapid on $maximaport"); |
|
my $maximaclient=$maximaserver->accept(); |
|
$maximaselect->add($maximaclient); |
|
&nonblock($maximaclient); |
|
&status("$maximapid on $maximaport connected."); |
|
&logthis("Maxima $maximapid on port $maximaport connected."); |
|
&logthis('Initial reply: '.&maximareply($maximaselect)); |
|
# handle connections until we've reached $MAX_CLIENTS_PER_CHILD |
|
for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { |
for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { |
&status('Accepting connections for '.$maximapid.' on '.$maximaport); |
&status('Accepting connections'); |
my $client = $server->accept() or last; |
my $client = $server->accept() or last; |
while (my $cmd=<$client>) { |
print $command "kill(all);reset();\n"; |
&status('Processing command by '.$maximapid.' on '.$maximaport); |
&getmaximaoutput($command); |
print $maximaclient &unescape($cmd).";\n"; |
while (my $cmd=<$client>) { |
print $client &escape(&maximareply($maximaselect))."\n"; |
&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 |
|
|
if (ref($cmd_out)) { close($cmd_out); } |
$command->soft_close(); |
if (ref($cmd_err)) { close($cmd_err); } |
|
if (ref($cmd_in)) { close($cmd_in); } |
|
|
|
# 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 320 sub make_new_child {
|
Line 283 sub make_new_child {
|
} |
} |
} |
} |
|
|
sub maximareply { |
{ |
my ($maximaselect)=@_; |
my $counter; |
my $output=''; |
sub sync { |
foreach my $ready ($maximaselect->can_read(1)) { |
my ($command)=@_; |
my $data = ''; |
$counter++; |
my $rv = $ready->recv($data, POSIX::BUFSIZ, 0); |
my $expect=$counter.time; |
$output.=$data; |
print $command "$expect;\n"; |
} |
while (1) { |
return $output; |
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; |
|
} |