Fix compiler VM serial buffering woes

This commit is contained in:
Pragmatic Software 2017-12-02 11:37:51 -08:00
parent 161488c850
commit cd86aabd07
2 changed files with 75 additions and 9 deletions

View File

@ -53,13 +53,44 @@ sub run_server {
my $cmdline;
my $user_input;
print "Waiting for input...\n";
my $pid = fork;
die "Fork failed: $!" if not defined $pid;
if($pid == 0) {
while(my $line = <$input>) {
my $buffer = "";
my $length = 4096;
my $line;
my $total_read = 0;
while (1) {
print "Waiting for input...\n";
my $ret = sysread($input, my $buf, $length);
if (not defined $ret) {
print "Error reading: $!\n";
next;
}
$total_read += $ret;
if ($ret == 0) {
print "input ded?\n";
print "got buffer [$buffer]\n";
exit;
}
chomp $buf;
print "read $ret bytes [$total_read so far] [$buf]\n";
$buffer.= $buf;
if ($buffer =~ s/\s*:end:\s*$//m) {
$line = $buffer;
$buffer = "";
$total_read = 0;
} else {
next;
}
chomp $line;
print "-" x 40, "\n";
@ -89,9 +120,9 @@ sub run_server {
system("cp -R -p /root/factdata/$compile_in->{'persist-key'}/* /home/compiler/");
}
system("chmod -R 755 /home/compiler");
system("chown -R compiler /home/compiler/*");
system("chgrp -R compiler /home/compiler/*");
system("chmod -R 755 /home/compiler");
system("rm -rf /home/compiler/prog*");
$( = $gid;
@ -113,6 +144,7 @@ sub run_server {
system("id");
system("cp -R -p /home/compiler/* /root/factdata/$compile_in->{'persist-key'}/");
system("umount /root/factdata");
system ("rm -rf /home/compiler/*");
}
exit;
@ -121,6 +153,7 @@ sub run_server {
}
if(not defined $USE_LOCAL or $USE_LOCAL == 0) {
print "=" x 40, "\n";
print "input: ";
next;
} else {

View File

@ -44,8 +44,10 @@ sub new {
$self->{lang} =~ s/^\s+|\s+$//g if defined $self->{lang};
$self->{code} =~ s/^\s+|\s+$//g if defined $self->{code};
$self->{arguments} = quotemeta $self->{arguments};
$self->{arguments} =~ s/\\ / /g;
if (defined $self->{arguments}) {
$self->{arguments} = quotemeta $self->{arguments};
$self->{arguments} =~ s/\\ / /g;
}
$self->initialize(%conf);
@ -371,7 +373,6 @@ sub execute {
print FILE "------------------------------------------------------------------------\n";
print FILE localtime() . "\n";
print FILE "$cmdline\n$input\n$pretty_code\n";
close FILE;
my $compile_in = { lang => $self->{lang}, sourcefile => $self->{sourcefile}, execfile => $self->{execfile},
cmdline => $cmdline, input => $input, date => $date, arguments => $self->{arguments}, code => $pretty_code };
@ -380,10 +381,42 @@ sub execute {
$compile_in->{'persist-key'} = $self->{'persist-key'} if length $self->{'persist-key'};
my $compile_json = encode_json($compile_in);
$compile_json .= "\n:end:\n";
#print STDERR "Sending [$compile_json] to vm_server\n";
my $length = length $compile_json;
my $sent = 0;
my $chunk_max = 4096;
my $chunk_size = $length < $chunk_max ? $length : $chunk_max;
my $chunks_sent;
print $compiler "$compile_json\n";
#print FILE "Sending $length bytes [$compile_json] to vm_server\n";
$chunk_size -= 1; # account for newline in syswrite
while ($chunks_sent < $length) {
my $chunk = substr $compile_json, $chunks_sent, $chunk_size;
#print FILE "Sending chunk [$chunk]\n";
$chunks_sent += length $chunk;
my $ret = syswrite($compiler, "$chunk\n");
if (not defined $ret) {
print FILE "Error sending: $!\n";
last;
}
if ($ret == 0) {
print FILE "Sent 0 bytes. Sleep 1 sec and try again\n";
sleep 1;
next;
}
$sent += $ret;
print FILE "Sent $ret bytes, so far $sent ...\n";
}
#print FILE "Done sending!\n";
close FILE;
my $result = "";
my $got_result = 0;