3
0
mirror of https://github.com/pragma-/pbot.git synced 2024-12-23 11:12:42 +01:00

compiler_vm updates

- make compiler_output_merger.pl more resistant to being killed
  - support gcc 4.9.0's -fdiagnostics-show-caret 
    (disable in channel, enable in paste)
  - force a newline to be added to program output to prevent output
    from being buffered by output merger
This commit is contained in:
Pragmatic Software 2014-02-27 16:31:31 +00:00
parent aa00540c8d
commit 7a99175bd7
6 changed files with 125 additions and 20 deletions

View File

@ -13,8 +13,8 @@ use warnings;
# These are set automatically by the build/commit script
use constant {
BUILD_NAME => "PBot",
BUILD_REVISION => 489,
BUILD_DATE => "2014-02-25",
BUILD_REVISION => 490,
BUILD_DATE => "2014-02-27",
};
1;

View File

@ -5,6 +5,8 @@ use strict;
use IPC::Open2;
use Fcntl qw/:flock/;
use POSIX ":sys_wait_h";
use Linux::Pid qw/getppid/;
my $outfile = '.output';
@ -20,31 +22,72 @@ sub write_output {
close $fh;
}
sub merge {
my ($file) = @_;
sub merge_file {
my ($file, $pid) = @_;
# create empty file
open my $fh, '>', $file;
close $fh;
my ($out, $in);
open2 $out, $in, "tail -f $file";
open2 $out, $in, "tail -q -F $file --pid=$pid";
print "merging $file to $outfile\n";
while(my $line = <$out>) {
chomp $line;
if(getppid == 1) {
print "$file: Parent died, exiting\n";
exit;
}
print "$file: got [$line]\n";
write_output $line;
}
}
my $pid = fork();
sub merge {
my ($file) = @_;
my $pid = fork;
die "fork failed: $!" if not defined $pid;
if($pid == 0) {
merge '.gdb_output';
print "$file pid: $$\n";
while(1) {
merge_file $file, $$;
print "merge $file killed, restarting...\n";
}
exit;
} else {
merge '.prog_output';
return $pid;
}
}
waitpid $pid, 0;
my ($gdb_pid, $prog_pid);
sub merge_outputs {
$gdb_pid = merge '.gdb_output';
$prog_pid = merge '.prog_output';
print "merge_outputs: gdb_pid: $gdb_pid; prog_pid: $prog_pid\n";
while(1) {
sleep 1;
}
}
$SIG{CHLD} = \&REAPER;
sub REAPER {
my $stiff;
while (($stiff = waitpid(-1, &WNOHANG)) > 0) {
print "child died: $stiff\n";
print "reaper: gdb_pid: $gdb_pid; prog_pid: $prog_pid\n";
if($stiff == $gdb_pid) {
$gdb_pid = merge '.gdb_output';
} elsif($stiff == $prog_pid) {
$prog_pid = merge '.prog_output';
}
}
$SIG{CHLD} = \&REAPER;
}
merge_outputs;

View File

@ -13,7 +13,7 @@ my $SERIAL_PORT = 3333;
my $HEARTBEAT_PORT = 3336;
my $COMPILE_TIMEOUT = 7;
my $NOGRAPHIC = 0;
my $NOGRAPHIC = 1;
sub server_listen {
my $port = shift @_;
@ -46,7 +46,7 @@ sub vm_start {
}
if($pid == 0) {
my $command = "nice -n -20 qemu-system-x86_64 -M pc -net none -hda /home/compiler/compiler/compiler-savedvm.qcow2 -m 128 -monitor tcp:127.0.0.1:$MONITOR_PORT,server,nowait -serial tcp:127.0.0.1:$SERIAL_PORT,server,nowait -serial tcp:127.0.0.1:$HEARTBEAT_PORT,server -boot c -loadvm 1 -enable-kvm -no-kvm-irqchip" . ($NOGRAPHIC ? "" : " -nographic");
my $command = "nice -n -20 qemu-system-x86_64 -M pc -net none -hda /home/compiler/compiler/compiler-savedvm.qcow2 -m 128 -monitor tcp:127.0.0.1:$MONITOR_PORT,server,nowait -serial tcp:127.0.0.1:$SERIAL_PORT,server,nowait -serial tcp:127.0.0.1:$HEARTBEAT_PORT,server -boot c -loadvm 1 -enable-kvm -no-kvm-irqchip" . ($NOGRAPHIC ? " -nographic" : "");
my @command_list = split / /, $command;
exec(@command_list);
} else {

View File

@ -911,7 +911,7 @@ $code =~ s/(?:\n\n)+/\n\n/g;
print "final code: [$code]\n" if $debug;
$input = `fortune -u` if not length $input;
$input = `fortune -u -s` if not length $input;
$input =~ s/[\n\r\t]/ /msg;
$input =~ s/:/ - /g;
$input =~ s/\s+/ /g;
@ -920,7 +920,9 @@ print FILE "$nick: [lang:$lang][args:$args][input:$input]\n", pretty($code), "\n
my $pretty_code = pretty $code;
$args .= ' -paste' if defined $got_paste or $got_run eq "paste";
$output = compile($lang, $pretty_code, $args, $input, $USE_LOCAL);
$args =~ s/ -paste$// if defined $got_paste or $got_run eq "paste";
if($output =~ m/^\s*$/) {
$output = $nooutput

View File

@ -3,6 +3,8 @@
use warnings;
use strict;
use Proc::ProcessTable;
my $USE_LOCAL = defined $ENV{'CC_LOCAL'};
my %languages = (
@ -28,6 +30,8 @@ my %languages = (
},
);
my $merger_pid;
sub runserver {
my ($input, $output, $heartbeat);
@ -128,13 +132,20 @@ sub interpret {
my $cmdline = $languages{$lang}{'cmdline'};
my $diagnostics_caret;
if($user_args =~ s/\s+-paste//) {
$diagnostics_caret = '-fdiagnostics-show-caret';
} else {
$diagnostics_caret = '-fno-diagnostics-show-caret';
}
if(length $user_args) {
print "Replacing args with $user_args\n";
my $user_args_quoted = quotemeta($user_args);
$user_args_quoted =~ s/\\ / /g;
$cmdline =~ s/\$args/$user_args_quoted/;
$cmdline =~ s/\$args/$user_args_quoted $diagnostics_caret/;
} else {
$cmdline =~ s/\$args/$languages{$lang}{'args'}/;
$cmdline =~ s/\$args/$languages{$lang}{'args'} $diagnostics_caret/;
}
$cmdline =~ s/\$file/$languages{$lang}{'file'}/;
@ -164,7 +175,19 @@ sub interpret {
}
print "Executing gdb\n";
unlink '.output';
open my $truncate_output, '>', '.output';
close $truncate_output;
unlink '.gdb_output', '.prog_output';
if(not defined $merger_pid or not find_pid($merger_pid)) {
waitpid $merger_pid, 0 if defined $merger_pid;
print "compiler_vm_server: starting merger\n";
$merger_pid = start_merger;
sleep 1;
print "merger started; pid: $merger_pid\n";
}
my $user_input_quoted = quotemeta $user_input;
$user_input_quoted =~ s/\\"/"'\\"'"/g;
($ret, $result) = execute(60, "bash -c \"date -s \@$date; ulimit -t 1; compiler_watchdog.pl $user_input_quoted\"");
@ -227,4 +250,27 @@ sub execute {
return ($ret, $result);
}
sub start_merger {
my $merger_pid = fork;
die "merger fork failed: $!" if not defined $merger_pid;
if($merger_pid == 0) {
exec('compiler_output_merger.pl');
die "merger exec failed: $!";
} else {
print "compiler_vm_server: merger startered; pid: $merger_pid\n";
return $merger_pid;
}
}
sub find_pid {
my ($pid) = @_;
return 0 if not defined $pid;
my $t = new Proc::ProcessTable('enable_ttys' => 0);
foreach my $p (@{ $t->table }) {
return 1 if $p->pid == $pid;
}
return 0;
}
runserver;

View File

@ -17,6 +17,7 @@ my $got_output = 0;
my $local_vars = "";
sub flushall;
sub writenewline;
sub gdb;
use IO::Handle;
@ -95,7 +96,8 @@ sub execute {
my $line = <$out>;
print "== got: $line\n" if $debug >= 5;
if($line =~ m/^\d+\s+return.*?;\s*$/ or $line =~ m/^\d+\s+}\s*$/) {
if($got_output == 0 and -s '.output' == 0) {
writenewline $in, $out;
if($got_output == 0 and -s '.output' <= 1) {
print "no output, checking locals\n" if $debug >= 5;
gdb $in, "print \"Go.\"\ninfo locals\nprint \"Ok.\"\n";
@ -477,6 +479,18 @@ sub gdb {
print $in "$command\n";
}
sub writenewline {
my ($in, $out) = @_;
gdb $in, "call puts(\"\")\nprint \"Ok.\"\n";
while(my $line = <$out>) {
chomp $line;
$line =~ s/^\(gdb\)\s*//;
$line =~ s/\$\d+ = 0$//;
last if $line =~ m/\$\d+ = "Ok."/;
}
}
sub flushall {
my ($in, $out) = @_;