version 1.16, 2006/03/08 22:30:11
|
version 1.24, 2007/02/08 06:28:30
|
Line 31
|
Line 31
|
# |
# |
|
|
use Expect; |
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 %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 |
Line 52 my $pidfile; #
|
Line 51 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); |
|
|
Line 243 sub make_new_child {
|
Line 243 sub make_new_child {
|
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"); |
|
|
|
&logthis('New process started'); |
|
|
my $command=Expect->spawn('maxima'); |
my $command=Expect->spawn('maxima'); |
$command->log_stdout(0); |
$command->log_stdout(0); |
|
|
Line 251 sub make_new_child {
|
Line 253 sub make_new_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'); |
my $client = $server->accept() or last; |
my $client = $server->accept() or last; |
|
print $command "kill(all);\n"; |
|
&getmaximaoutput($command); |
|
&sync($command); |
while (my $cmd=<$client>) { |
while (my $cmd=<$client>) { |
&status('Processing command'); |
&status('Processing command'); |
print $command &unescape($cmd).";\n"; |
print $command &unescape($cmd); |
print $client &escape(&getmaximaoutput($command))."\n"; |
my ($reply,$finished,$syntaxerr); |
|
while ((!$finished) && (!$syntaxerr) && ($reply !~ /^Error\:/)) { |
|
($reply,$finished,$syntaxerr) = &getmaximaoutput($command); |
|
} |
|
print $client &escape($reply)."\n"; |
|
if ($reply=~/^Error\:/) { |
|
&logthis('Died through '.$reply); |
|
$client->close(); |
|
$command->hard_close(); |
|
exit; |
|
} |
|
&sync($command); |
|
&status('Waiting for commands'); |
} |
} |
} |
} |
|
|
Line 269 sub make_new_child {
|
Line 286 sub make_new_child {
|
} |
} |
} |
} |
|
|
|
{ |
|
my $counter; |
|
sub sync { |
|
my ($command)=@_; |
|
$counter++; |
|
my $expect=$counter.time; |
|
print $command "$expect;\n"; |
|
while (1) { |
|
my $output=&getmaximaoutput($command); |
|
if (($output=~/\Q$expect\E/) || ($output=~/^Error\:/)) { |
|
return; |
|
} |
|
} |
|
} |
|
} |
|
|
sub getmaximaoutput { |
sub getmaximaoutput { |
my ($command)=@_; |
my ($command)=@_; |
my (undef,undef,undef,$output)=$command->expect(20, -re => '\(\%i\d+\)'); |
my (undef,$error,undef,$output)=$command->expect(20, -re => '^\(\%i\d+\)'); |
|
if ($error) { |
|
return 'Error: '.$error; |
|
} |
|
$output =~ s/\r+//g; # Remove Windows-style linebreaks |
|
my $hasoutput=0; |
my $foundoutput=0; |
my $foundoutput=0; |
|
my $syntaxerr=0; |
my $realoutput=''; |
my $realoutput=''; |
foreach my $line (split(/\n/,$output)) { |
foreach my $line (split(/\n/,$output)) { |
if ($line=~/\;/) { $foundoutput=1; next; } |
if ($line=~/\;/) { $foundoutput=1; next; } |
if (!$foundoutput) { next; } |
if (!$foundoutput) { next; } |
my ($label)=($line=~s/^(\(\%o\d+\))//); |
if ($line=~/^Incorrect syntax:/) { $syntaxerr = 1; next; } |
|
(my $label, $line) = ($line=~ /^(\(\%o\d+\))(.+)$/); |
if ($label) { |
if ($label) { |
$label=~s/\S/ /g; |
$label=~s/\S/ /g; |
$line=$label.$line; |
$line=$label.$line; |
|
$hasoutput = 1; |
} |
} |
$realoutput.=$line."\n"; |
$realoutput.=$line."\n"; |
} |
} |
return $realoutput; |
if (wantarray) { |
|
return ($realoutput,$hasoutput,$syntaxerr); |
|
} else { |
|
return $realoutput; |
|
} |
} |
} |