version 1.10, 2006/03/04 06:56:10
|
version 1.33, 2007/08/31 23:19:54
|
Line 30
|
Line 30
|
# http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
# |
# |
|
|
|
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); |
|
|
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 |
Line 286 sub make_new_child {
|
Line 237 sub make_new_child {
|
return; |
return; |
} else { |
} else { |
# 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 |
|
|
|
# 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); |
&logthis('New process started'); |
|
|
|
my $command=Expect->spawn('maxima'); |
|
# soft/hard_close can take awhile and we really |
|
# don't care we just want it gone |
|
$SIG{INT} = sub { |
|
my $pid = $command->pid(); |
|
kill('KILL'=>$pid); |
|
exit; |
|
}; |
|
|
|
$command->log_stdout(0); |
|
#$command->log_file("$execdir/logs/lonmaxima.session.log"); |
|
&sync($command); |
|
|
|
for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { |
|
&status('Accepting connections'); |
|
my $client = $server->accept() or last; |
|
print $command ("display2d:false;kill(all);\n"); |
|
&getmaximaoutput($command,2); |
|
&sync($command); |
|
my $syntaxerr = 0; |
|
while (my $cmd=<$client>) { |
|
&status('Processing command'); |
|
print $command &unescape($cmd); |
|
my ($reply,$syntaxerr) = &getmaximaoutput($command,1); |
|
print $client &escape($reply)."\n"; |
|
if ($syntaxerr) { |
|
last; |
|
} elsif ($reply=~/^Error\:/) { |
|
&logthis('Died through '.$reply); |
|
$client->close(); |
|
$command->hard_close(); |
|
exit; |
|
} |
|
&sync($command); |
|
&status('Waiting for commands'); |
|
} |
|
} |
|
|
# 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 303 sub make_new_child {
|
Line 294 sub make_new_child {
|
} |
} |
} |
} |
|
|
sub process_requests { |
{ |
my ($server) = @_; |
my $counter; |
# handle connections until we've reached $MAX_CLIENTS_PER_CHILD |
sub sync { |
for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { |
my ($command)=@_; |
&status('Accepting connections'); |
$counter++; |
my $client = $server->accept() or last; |
my $expect=$counter.time; |
while (my $cmd=<$client>) { |
print $command "$expect;\n"; |
&status('Processing command'); |
while (1) { |
print $client &escape((&maximareply(&unescape($cmd)))[0])."\n"; |
my $output=&getmaximaoutput($command,1); |
|
if (($output=~/\Q$expect\E/) || ($output=~/^Error\:/)) { |
|
return; |
|
} |
|
} |
|
} |
|
} |
|
|
|
sub getmaximaoutput { |
|
my ($command,$numcheck)=@_; |
|
my $regexp = '\(\%i\d+\)'; |
|
my $syntaxerr=0; |
|
if ($numcheck) { |
|
if ($numcheck eq 2) { |
|
# command was the killall so should get a full reset on |
|
# command numbers |
|
$regexp = '(\(\%i(1)\)|Incorrect syntax\:)'; |
|
} elsif ($command->match() =~ /\(\%i(\d+)\)/) { |
|
my $nextmatch = $1+1; |
|
$regexp = '(\(\%i'.$nextmatch.'\)|Incorrect syntax\:)'; |
|
} |
|
} |
|
my $timeout = 20; |
|
my (undef,$error,$matched,$output) = |
|
$command->expect($timeout, -re => $regexp); |
|
|
|
if ($numcheck && $matched eq 'Incorrect syntax:') { |
|
$syntaxerr = 1; |
|
if (wantarray) { |
|
return ($matched,$syntaxerr); |
|
} else { |
|
return $matched; |
} |
} |
} |
} |
|
if ($error) { |
|
return 'Error: '.$error; |
|
} |
|
$output =~ s/\r+//g; # Remove Windows-style linebreaks |
|
my $foundoutput=0; |
|
my $found_label=0; |
|
my $realoutput=''; |
|
foreach my $line (split(/\n/,$output)) { |
|
if ($line=~/\;/) { $foundoutput=1; next; } |
|
if (!$foundoutput) { next; } |
|
if ($line=~/^Incorrect syntax:/) { $syntaxerr = 1; next; } |
|
if ($line=~ /^(\(\%o\d+\))(.+)$/){ |
|
my $label = $1; |
|
$line = $2; |
|
$label =~s/\S/ /g; |
|
$line=$label.$line; |
|
$found_label=1; |
|
} |
|
if ($found_label) { |
|
$realoutput.=$line."\n"; |
|
} |
|
} |
|
if (wantarray) { |
|
return ($realoutput,$syntaxerr); |
|
} else { |
|
return $realoutput; |
|
} |
} |
} |