mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-20 02:49:49 +01:00
Remove use of compiler output merger
This commit is contained in:
Pragmatic Software
parent
7a99175bd7
commit
e72a8c04a2
@ -13,7 +13,7 @@ use warnings;
|
||||
# These are set automatically by the build/commit script
|
||||
use constant {
|
||||
BUILD_NAME => "PBot",
|
||||
BUILD_REVISION => 490,
|
||||
BUILD_REVISION => 491,
|
||||
BUILD_DATE => "2014-02-27",
|
||||
};
|
||||
|
||||
|
||||
@ -3,8 +3,6 @@
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use Proc::ProcessTable;
|
||||
|
||||
my $USE_LOCAL = defined $ENV{'CC_LOCAL'};
|
||||
|
||||
my %languages = (
|
||||
@ -30,8 +28,6 @@ my %languages = (
|
||||
},
|
||||
);
|
||||
|
||||
my $merger_pid;
|
||||
|
||||
sub runserver {
|
||||
my ($input, $output, $heartbeat);
|
||||
|
||||
@ -162,6 +158,7 @@ sub interpret {
|
||||
|
||||
if($user_args =~ m/--version/) {
|
||||
# arg contained --version, so don't compile and just return the version output
|
||||
$result =~ s/\s+\(Ubuntu.*-\d+ubuntu\d+\)//;
|
||||
return $result;
|
||||
}
|
||||
|
||||
@ -175,22 +172,9 @@ sub interpret {
|
||||
}
|
||||
|
||||
print "Executing gdb\n";
|
||||
|
||||
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\"");
|
||||
($ret, $result) = execute(60, "bash -c \"date -s \@$date; ulimit -t 1; compiler_watchdog.pl $user_input_quoted > .output\"");
|
||||
|
||||
$result = "";
|
||||
|
||||
@ -250,27 +234,4 @@ 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;
|
||||
|
||||
@ -17,18 +17,12 @@ my $got_output = 0;
|
||||
my $local_vars = "";
|
||||
|
||||
sub flushall;
|
||||
sub writenewline;
|
||||
sub gdb;
|
||||
|
||||
use IO::Handle;
|
||||
|
||||
sub execute {
|
||||
my ($cmdline) = @_;
|
||||
my ($ret, $result);
|
||||
|
||||
open my $output_file, '>>', '.gdb_output' or die "Couldn't open .output: $!";
|
||||
$output_file->autoflush(1);
|
||||
|
||||
my ($out, $in);
|
||||
open2($out, $in, "$cmdline 2>&1");
|
||||
|
||||
@ -50,7 +44,7 @@ sub execute {
|
||||
next if $line =~ m/libc_start_main/;
|
||||
|
||||
if($line =~ m/^\d+: (.*? = .*)/) {
|
||||
print $output_file "<$1>\n";
|
||||
print "<$1>\n";
|
||||
$got_output = 1;
|
||||
next;
|
||||
}
|
||||
@ -88,7 +82,7 @@ sub execute {
|
||||
gdb $in, "break $break\n";
|
||||
gdb $in, "set width 0\n";
|
||||
gdb $in, "set height 0\n";
|
||||
gdb $in, "run < .input >> .prog_output\n";
|
||||
gdb $in, "run < .input\n";
|
||||
next;
|
||||
}
|
||||
|
||||
@ -96,8 +90,7 @@ 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*$/) {
|
||||
writenewline $in, $out;
|
||||
if($got_output == 0 and -s '.output' <= 1) {
|
||||
if($got_output == 0) {
|
||||
print "no output, checking locals\n" if $debug >= 5;
|
||||
gdb $in, "print \"Go.\"\ninfo locals\nprint \"Ok.\"\n";
|
||||
|
||||
@ -107,7 +100,7 @@ sub execute {
|
||||
|
||||
# fix this
|
||||
$peep =~ s/^\d+: (.*?) =/$1 =/;
|
||||
print $output_file "<$peep>\n";
|
||||
print "<$peep>\n";
|
||||
$got_output = 1;
|
||||
}
|
||||
|
||||
@ -177,7 +170,7 @@ sub execute {
|
||||
next if not length $retval;
|
||||
next if $retval =~ m/^\$\d+ = 0/;
|
||||
|
||||
print $output_file "$retval\n";
|
||||
print "$retval\n";
|
||||
$got_output = 1;
|
||||
}
|
||||
}
|
||||
@ -198,7 +191,7 @@ sub execute {
|
||||
|
||||
$indent++ if $direction eq "leaving";
|
||||
|
||||
print $output_file "<$direction [$indent]", ' ' x $indent, "$func$return_value>\n";
|
||||
print "<$direction [$indent]", ' ' x $indent, "$func$return_value>\n";
|
||||
gdb $in, "cont\n";
|
||||
next;
|
||||
}
|
||||
@ -234,6 +227,8 @@ sub execute {
|
||||
|
||||
print "got command [$command]\n" if $debug >= 10;
|
||||
|
||||
flushall $in, $out;
|
||||
|
||||
if($cmd eq "break") {
|
||||
$ignore_response = 1;
|
||||
|
||||
@ -289,10 +284,10 @@ sub execute {
|
||||
if(not $ignore_response) {
|
||||
if($next_line =~ m/=/) {
|
||||
$got_output = 1;
|
||||
print $output_file "<$args$next_line>\n";
|
||||
print "<$args$next_line>\n";
|
||||
} else {
|
||||
$got_output = 1;
|
||||
print $output_file "<$next_line>\n";
|
||||
print "<$next_line>\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -317,7 +312,7 @@ sub execute {
|
||||
my ($val2) = $new =~ m/New value = (.*)/;
|
||||
|
||||
$got_output = 1;
|
||||
print $output_file "<$var = $val2>\n";
|
||||
print "<$var = $val2>\n";
|
||||
gdb $in, "cont\n";
|
||||
next;
|
||||
}
|
||||
@ -337,7 +332,7 @@ sub execute {
|
||||
$got_output = 1;
|
||||
my $output = "<$var changed: $val1 => $val2>\n";
|
||||
flushall $in, $out;
|
||||
print $output_file $output;
|
||||
print $output;
|
||||
gdb $in, "cont\n";
|
||||
next;
|
||||
}
|
||||
@ -350,26 +345,26 @@ sub execute {
|
||||
}
|
||||
|
||||
if($line =~ m/^Program exited/) {
|
||||
print $output_file " $local_vars\n" if length $local_vars and not $got_output;
|
||||
print " $local_vars\n" if length $local_vars and not $got_output;
|
||||
exit 0;
|
||||
}
|
||||
|
||||
if($line =~ s/\[Inferior .* exited with code (\d+)\]//) {
|
||||
print $output_file "$line\n";
|
||||
print $output_file "<Exit $1>\n";
|
||||
print $output_file " $local_vars\n" if length $local_vars and not $got_output;
|
||||
print "$line\n";
|
||||
print "<Exit $1>\n";
|
||||
print " $local_vars\n" if length $local_vars and not $got_output;
|
||||
exit 0;
|
||||
}
|
||||
|
||||
if($line =~ s/\[Inferior .* exited normally\]//) {
|
||||
print $output_file "$line\n" if length $line;
|
||||
print "$line\n" if length $line;
|
||||
$got_output = 1 if length $line;
|
||||
print $output_file " $local_vars\n" if length $local_vars and not $got_output;
|
||||
print " $local_vars\n" if length $local_vars and not $got_output;
|
||||
exit 0;
|
||||
}
|
||||
|
||||
if($line =~ m/Program terminated with signal SIGKILL/) {
|
||||
print $output_file "[Killed]\n";
|
||||
print "[Killed]\n";
|
||||
return 0;
|
||||
}
|
||||
|
||||
@ -387,7 +382,7 @@ sub execute {
|
||||
$output .= "<$line>\n";
|
||||
}
|
||||
flushall $in, $out;
|
||||
print $output_file $output;
|
||||
print $output;
|
||||
gdb $in, "cont\n";
|
||||
next;
|
||||
}
|
||||
@ -399,7 +394,7 @@ sub execute {
|
||||
|
||||
$line =~ s/\.$//;
|
||||
$got_output = 1;
|
||||
print $output_file "$line ";
|
||||
print "$line ";
|
||||
|
||||
while(my $line = <$out>) {
|
||||
chomp $line;
|
||||
@ -450,13 +445,13 @@ sub execute {
|
||||
|
||||
$vars = " <local variables: $vars>" if length $vars;
|
||||
|
||||
print $output_file "$result$vars\n";
|
||||
print "$result$vars\n";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
if($line =~ s/^\(gdb\)\s*//) {
|
||||
$got_output = 1;
|
||||
print $output_file "<$line>\n";
|
||||
print "<$line>\n";
|
||||
next;
|
||||
}
|
||||
|
||||
@ -466,9 +461,8 @@ sub execute {
|
||||
|
||||
$got_output = 1;
|
||||
print "$line\n";
|
||||
flushall $in, $out;
|
||||
}
|
||||
|
||||
close $output_file;
|
||||
}
|
||||
|
||||
sub gdb {
|
||||
@ -479,18 +473,6 @@ 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) = @_;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user