version 1.10, 2006/03/04 06:56:10
|
version 1.13, 2006/03/08 12:57:30
|
Line 37 use IO::Socket;
|
Line 37 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 = 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 $status |
use vars qw($PREFORK $MAX_CLIENTS_PER_CHILD %children $children %usedmaximaports $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 $maximapid = open3($cmd_in, $cmd_out, $cmd_err, 'maxima'); |
|
$children{$maximapid} = 1; |
|
|
|
print $cmd_in $cmd; |
|
close($cmd_in); |
|
|
|
&status("Command sent"); |
|
|
|
$SIG{ALRM} = sub { kill 9 => $maximapid; }; |
|
alarm(5); |
|
|
|
my $selector = IO::Select->new(); |
|
|
|
$selector->add($cmd_err, $cmd_out); |
|
|
|
while (my @ready = $selector->can_read()) { |
|
foreach my $fh (@ready) { |
|
if (ref($fh) |
|
&& ref($cmd_err) |
|
&& 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); |
|
} |
|
} |
|
alarm(0); |
|
$SIG{ALRM} = 'DEFAULT'; |
|
if (ref($cmd_out)) { close($cmd_out); } |
|
if (ref($cmd_err)) { 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($usedmaximaports{$children{$pid}}); |
delete($children{$pid}); |
delete($children{$pid}); |
} |
} |
|
|
Line 174 sub catchexception {
|
Line 130 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 251 close(PIDSAVE);
|
Line 217 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); |
&make_new_child($server,$maximaport); |
|
$maximaport++; |
} |
} |
|
|
# And maintain the population. |
# And maintain the population. |
Line 263 while (1) {
|
Line 231 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'); |
&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 281 sub make_new_child {
|
Line 253 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 291 sub make_new_child {
|
Line 263 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"; |
|
&nonblock($maximaserver); |
|
my $maximaselect=IO::Select->new($maximaserver); |
|
|
|
# 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"); |
|
|
|
# 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++) { |
|
&status('Accepting connections for '.$maximapid.' on '.$maximaport); |
|
my $client = $server->accept() or last; |
|
while (my $cmd=<$client>) { |
|
&status('Processing command by '.$maximapid.' on '.$maximaport); |
|
print $maximaclient &unescape($cmd).";\n"; |
|
print $client &escape(&maximareply($maximaselect))."\n"; |
|
} |
|
} |
|
|
# 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 303 sub make_new_child {
|
Line 313 sub make_new_child {
|
} |
} |
} |
} |
|
|
sub process_requests { |
sub maximareply { |
my ($server) = @_; |
my ($maximaselect)=@_; |
# handle connections until we've reached $MAX_CLIENTS_PER_CHILD |
my $output=''; |
for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { |
foreach my $ready ($maximaselect->can_read(1)) { |
&status('Accepting connections'); |
my $data = ''; |
my $client = $server->accept() or last; |
my $rv = $ready->recv($data, POSIX::BUFSIZ, 0); |
while (my $cmd=<$client>) { |
$output.=$data; |
&status('Processing command'); |
} |
print $client &escape((&maximareply(&unescape($cmd)))[0])."\n"; |
return $output; |
} |
|
} |
|
} |
} |
|
|