From 7a99175bd78e1588aacfe6e5fd5714e045d4de08 Mon Sep 17 00:00:00 2001 From: Pragmatic Software Date: Thu, 27 Feb 2014 16:31:31 +0000 Subject: [PATCH] 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 --- PBot/VERSION.pm | 4 +- modules/compiler_vm/compiler_output_merger.pl | 65 +++++++++++++++---- modules/compiler_vm/compiler_server.pl | 4 +- modules/compiler_vm/compiler_vm_client.pl | 4 +- modules/compiler_vm/compiler_vm_server.pl | 52 ++++++++++++++- modules/compiler_vm/compiler_watchdog.pl | 16 ++++- 6 files changed, 125 insertions(+), 20 deletions(-) diff --git a/PBot/VERSION.pm b/PBot/VERSION.pm index b70182dd..55838b7b 100644 --- a/PBot/VERSION.pm +++ b/PBot/VERSION.pm @@ -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; diff --git a/modules/compiler_vm/compiler_output_merger.pl b/modules/compiler_vm/compiler_output_merger.pl index b9f53dea..6e8559c5 100755 --- a/modules/compiler_vm/compiler_output_merger.pl +++ b/modules/compiler_vm/compiler_output_merger.pl @@ -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(); -die "fork failed: $!" if not defined $pid; +sub merge { + my ($file) = @_; -if($pid == 0) { - merge '.gdb_output'; - exit; -} else { - merge '.prog_output'; + my $pid = fork; + die "fork failed: $!" if not defined $pid; + + if($pid == 0) { + print "$file pid: $$\n"; + while(1) { + merge_file $file, $$; + print "merge $file killed, restarting...\n"; + } + exit; + } else { + 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; diff --git a/modules/compiler_vm/compiler_server.pl b/modules/compiler_vm/compiler_server.pl index bda42321..eb4d19d0 100755 --- a/modules/compiler_vm/compiler_server.pl +++ b/modules/compiler_vm/compiler_server.pl @@ -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 { diff --git a/modules/compiler_vm/compiler_vm_client.pl b/modules/compiler_vm/compiler_vm_client.pl index 09d37aab..60611af2 100755 --- a/modules/compiler_vm/compiler_vm_client.pl +++ b/modules/compiler_vm/compiler_vm_client.pl @@ -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 diff --git a/modules/compiler_vm/compiler_vm_server.pl b/modules/compiler_vm/compiler_vm_server.pl index 0cde2cdb..b2d7db5f 100755 --- a/modules/compiler_vm/compiler_vm_server.pl +++ b/modules/compiler_vm/compiler_vm_server.pl @@ -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; diff --git a/modules/compiler_vm/compiler_watchdog.pl b/modules/compiler_vm/compiler_watchdog.pl index e7fe2a2f..ace12221 100755 --- a/modules/compiler_vm/compiler_watchdog.pl +++ b/modules/compiler_vm/compiler_watchdog.pl @@ -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) = @_;