version 1.6, 2006/03/03 23:47:55
|
version 1.12, 2006/03/08 03:18:42
|
Line 43 use LONCAPA::Configuration;
|
Line 43 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 = 5; # 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); |
|
|
sub maximareply { |
sub maximareply { |
my ($cmd) = @_; |
my ($cmd,$maximaclient,$maximapid) = @_; |
my $reply=''; |
my $reply=''; |
my $error=''; |
while (my $line=<$maximaclient>) { |
my $exitstatus=''; |
$reply.=$line; |
|
} |
unless ($cmd=~/\;\n$/) { $cmd.=";\n"; } |
unless ($cmd=~/\;\n$/) { $cmd.=";\n"; } |
|
print $maximaclient $cmd; |
my ($cmd_in, $cmd_out, $cmd_err); |
&status("Command sent to $maximapid"); |
my $pid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima'); |
while (my $line=<$maximaclient>) { |
$children{$pid} = 1; |
$reply.=$line; |
|
|
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); |
&status("Command processed by $maximapid"); |
close($cmd_err); |
return $reply; |
&status("Command processed"); |
|
return ($reply,$error,$exitstatus); |
|
} |
} |
|
|
# ------------------------------------------------------------ Service routines |
# ------------------------------------------------------------ Service routines |
Line 102 sub REAPER { # ta
|
Line 79 sub REAPER { # ta
|
$SIG{CHLD} = \&REAPER; |
$SIG{CHLD} = \&REAPER; |
my $pid = wait; |
my $pid = wait; |
$children--; |
$children--; |
|
delete($usedmaximaports{$children{$pid}}); |
delete($children{$pid}); |
delete($children{$pid}); |
} |
} |
|
|
Line 240 close(PIDSAVE);
|
Line 218 close(PIDSAVE);
|
&status('Starting'); |
&status('Starting'); |
|
|
|
|
|
# Install signal handlers. |
|
$SIG{CHLD} = \&REAPER; |
|
$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); |
&make_new_child($server,$maximaport); |
|
$maximaport++; |
} |
} |
|
|
# 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'); |
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($server); # top up the child pool |
my $newport; |
|
foreach $newport ($STARTPORT .. $STARTPORT+$PREFORK-1) { |
|
if (!defined($usedmaximaports{$newport})) { last; } |
|
} |
|
&make_new_child($server,$newport); # top up the child pool |
} |
} |
} |
} |
|
|
sub make_new_child { |
sub make_new_child { |
my ($server) = @_; |
my ($server,$maximaport) = @_; |
|
|
# block signal for fork |
# block signal for fork |
my $sigset = POSIX::SigSet->new(SIGINT); |
my $sigset = POSIX::SigSet->new(SIGINT); |
Line 274 sub make_new_child {
|
Line 257 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} = 1; |
$children{$pid} = $maximaport; |
$children++; |
$children++; |
return; |
return; |
} else { |
} else { |
Line 284 sub make_new_child {
|
Line 267 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"); |
|
|
&process_requests($server); |
# open the MAXIMA port |
|
my $maximaserver = IO::Socket::INET->new(LocalPort => $maximaport, |
|
Type => SOCK_STREAM, |
|
Proto => 'tcp', |
|
Reuse => 1, |
|
Listen => 10 ) |
|
or die "making socket: $@\n"; |
|
|
|
# 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} = 1; |
|
|
|
my $prompt=<$cmd_out>; |
|
&logthis("Maxima $maximapid: $prompt"); |
|
|
|
&status("Waiting $maximapid on $maximaport"); |
|
# Hopefully, MAXIMA calls us back |
|
my $maximaclient=$maximaserver->accept(); |
|
&status("$maximapid on $maximaport connected."); |
|
&logthis("Maxima $maximapid on port $maximaport connected."); |
|
|
|
# Absorb initial prompts |
|
&logthis(&maximareply("0;\n",$maximaclient,$maximapid)); |
|
|
|
# Ready for action |
|
|
|
&process_requests($server,$maximaclient,$maximapid); |
|
|
# tidy up gracefully and finish |
# tidy up gracefully and finish |
|
|
|
if (ref($cmd_out)) { close($cmd_out); } |
|
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 |
# process death. |
# process death. |
Line 297 sub make_new_child {
|
Line 311 sub make_new_child {
|
} |
} |
|
|
sub process_requests { |
sub process_requests { |
my ($server) = @_; |
my ($server,$maximaclient,$maximapid) = @_; |
# handle connections until we've reached $MAX_CLIENTS_PER_CHILD |
# 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'); |
&status('Accepting connections for '.$maximapid.' on '.$maximaport); |
my $client = $server->accept() or last; |
my $client = $server->accept() or last; |
while (my $cmd=<$client>) { |
while (my $cmd=<$client>) { |
&status('Processing command'); |
&status('Processing command by '.$maximapid.' on '.$maximaport); |
print $client &escape((&maximareply(&unescape($cmd)))[0])."\n"; |
print $client &escape((&maximareply(&unescape($cmd),$maximaclient,$maximapid))[0])."\n"; |
} |
} |
} |
} |
} |
} |