3
0
mirror of https://github.com/pragma-/pbot.git synced 2024-11-02 18:19:33 +01:00
pbot/modules/compiler_vm/compiler_vm_server.pl

194 lines
4.2 KiB
Perl
Raw Normal View History

#!/usr/bin/perl
use warnings;
use strict;
my $USE_LOCAL = defined $ENV{'CC_LOCAL'};
my %languages = (
'C' => {
'cmdline' => 'gcc $args $file -o prog -ggdb',
'args' => '-Wextra -Wall -Wno-unused -std=gnu89',
'file' => 'prog.c',
},
'C++' => {
'cmdline' => 'g++ $args $file -o prog -ggdb',
'args' => '',
'file' => 'prog.cpp',
},
'C99' => {
'cmdline' => 'gcc $args $file -o prog -ggdb',
'args' => '-Wextra -Wall -Wno-unused -pedantic -std=c99 -lm',
'file' => 'prog.c',
},
);
sub runserver {
my ($input, $output);
if(not defined $USE_LOCAL or $USE_LOCAL == 0) {
open($input, '<', "/dev/ttyS0") or die $!;
open($output, '>', "/dev/ttyS0") or die $!;
} else {
open($input, '<', "/dev/stdin") or die $!;
open($output, '>', "/dev/stdout") or die $!;
}
my $lang;
my $code;
my $user_args;
my $user_input;
print "Waiting for input...\n";
while(my $line = <$input>) {
chomp $line;
next unless length $line;
print "Got [$line]\n";
if($line =~ m/^compile:\s*end/) {
next if not defined $lang or not defined $code;
print "Attempting compile [$lang] ...\n";
my $result = interpret($lang, $code, $user_args, $user_input);
print "Done compiling; result: [$result]\n";
print $output "result:$result\n";
print $output "result:end\n";
if(not defined $USE_LOCAL or $USE_LOCAL == 0) {
print "input: ";
next;
} else {
exit;
}
}
if($line =~ m/^compile:\s*(.*)/) {
my $options = $1;
$user_args = undef;
$user_input = undef;
$lang = undef;
($lang, $user_args, $user_input) = split /:/, $options;
$code = "";
$lang = "C99" if not defined $lang;
$user_args = "" if not defined $user_args;
$user_input = "" if not defined $user_input;
print "Setting lang [$lang]; [$user_args]; [$user_input]\n";
next;
}
$code .= $line . "\n";
}
close $input;
close $output;
}
sub interpret {
my ($lang, $code, $user_args, $user_input) = @_;
print "lang: [$lang], code: [$code], user_args: [$user_args], input: [$user_input]\n";
$lang = uc $lang;
if(not exists $languages{$lang}) {
return "No support for language '$lang' at this time.\n";
}
open(my $fh, '>', $languages{$lang}{'file'}) or die $!;
print $fh $code . "\n";
close $fh;
my $cmdline = $languages{$lang}{'cmdline'};
if(length $user_args) {
print "Replacing args with $user_args\n";
$user_args = quotemeta($user_args);
$user_args =~ s/\\ / /g;
$cmdline =~ s/\$args/$user_args/;
} else {
$cmdline =~ s/\$args/$languages{$lang}{'args'}/;
}
$cmdline =~ s/\$file/$languages{$lang}{'file'}/;
print "Executing [$cmdline]\n";
my ($ret, $result) = execute(60, $cmdline);
# print "Got result: ($ret) [$result]\n";
# if exit code was not 0, then there was a problem compiling, such as an error diagnostic
# so return the compiler output
if($ret != 0) {
return $result;
}
my $output = "";
# no errors compiling, but if $result contains something, it must be a warning message
# so prepend it to the output
if(length $result) {
$result =~ s/^\s+//;
$result =~ s/\s+$//;
$output = "[$result]\n";
}
($ret, $result) = execute(5, "./compiler_watchdog.pl");
$result =~ s/^\s+//;
$result =~ s/\s+$//;
# print "Executed prog; got result: ($ret) [$result]\n";
if(not length $result) {
$result = "Success (no output).\n" if $ret == 0;
$result = "Success (exit code $ret).\n" if $ret != 0;
}
return $output . "\n" . $result;
}
sub execute {
my $timeout = shift @_;
my ($cmdline) = @_;
my ($ret, $result);
($ret, $result) = eval {
print "eval\n";
my $result = '';
my $pid = open(my $fh, '-|', "$cmdline 2>&1");
local $SIG{ALRM} = sub { print "Time out\n"; kill 'TERM', $pid; die "$result [Timed-out]\n"; };
alarm($timeout);
while(my $line = <$fh>) {
$result .= $line;
}
close $fh;
my $ret = $? >> 8;
alarm 0;
return ($ret, $result);
};
print "done eval\n";
alarm 0;
if($@ =~ /Timed-out/) {
return (-1, $@);
}
print "[$ret, $result]\n";
return ($ret, $result);
}
runserver;