3
0
mirror of https://github.com/pragma-/pbot.git synced 2024-12-25 12:12:34 +01:00
pbot/applets/compiler_vm/guest/lib/Languages/_c_base.pm
Pragmatic Software 1326b0ac5f compiler_vm: major refactor to support VM sockets (AF_VSOCK)
VM socket communication is superior to VM serial communication in
every way. Unfortunately at this time only Linux supports them.
Fortunately, that's 99% of PBot's userbase.

If you're not using Linux or if you're using an older Linux that
does not support VM sockets, the PBot VM scripts will gracefully
fallback to using the serial connection. You may explicitly
disable VM socket connection attempts by setting PBOTVM_CID=0.
2022-02-12 16:06:04 -08:00

117 lines
3.6 KiB
Perl
Executable File

#!/usr/bin/perl
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
use warnings;
use strict;
package _c_base;
use parent '_default';
sub preprocess {
my $self = shift;
my $input = $self->{input} // '';
open(my $fh, '>', '.input');
print $fh "$input\n";
close $fh;
my @cmd = $self->split_line($self->{cmdline}, strip_quotes => 1, preserve_escapes => 0);
if ($self->{code} =~ m/print_last_statement\(.*\);$/m) {
# remove print_last_statement wrapper in order to get warnings/errors from last statement line
my $code = $self->{code};
$code =~ s/print_last_statement\((.*)\);$/$1;/mg;
open(my $fh, '>', $self->{sourcefile}) or die $!;
print $fh $code . "\n";
close $fh;
print STDERR "Executing [$self->{cmdline}] without print_last_statement\n";
my ($retval, $stdout, $stderr) = $self->execute(60, undef, @cmd);
$self->{output} = $stderr;
$self->{output} .= ' ' if length $self->{output};
$self->{output} .= $stdout;
$self->{error} = $retval;
# now compile with print_last_statement intact, ignoring compile results
if (not $self->{error}) {
open(my $fh, '>', $self->{sourcefile}) or die $!;
print $fh $self->{code} . "\n";
close $fh;
print STDERR "Executing [$self->{cmdline}] with print_last_statement\n";
$self->execute(60, undef, @cmd);
}
} else {
open(my $fh, '>', $self->{sourcefile}) or die $!;
print $fh $self->{code} . "\n";
close $fh;
print STDERR "Executing [$self->{cmdline}]\n";
my ($retval, $stdout, $stderr) = $self->execute(60, undef, @cmd);
$self->{output} = $stderr;
$self->{output} .= ' ' if length $self->{output};
$self->{output} .= $stdout;
$self->{error} = $retval;
}
if ($self->{cmdline} =~ m/--(?:version|analyze)/) {
$self->{done} = 1;
}
}
sub postprocess {
my $self = shift;
$self->SUPER::postprocess;
# no errors compiling, but if output contains something, it must be diagnostic messages
if(length $self->{output}) {
$self->{output} =~ s/^\s+//;
$self->{output} =~ s/\s+$//;
$self->{output} = "[$self->{output}]\n";
}
print STDERR "Executing gdb\n";
my ($exitval, $stdout, $stderr);
my $ulimits = "ulimit -f 2000; ulimit -t 8; ulimit -u 200";
my @args = $self->split_line($self->{arguments}, strip_quotes => 1, preserve_escapes => 0);
my $quoted_args = '';
foreach my $arg (@args) {
$arg =~ s/'/'"'"'/g;
$quoted_args .= "'$arg' ";
}
if ($self->{cmdline} =~ /-fsanitize=(?:[^ ]+,)?address/) {
# leak sanitizer doesn't work under ptrace/gdb
# ASAN_OPTIONS=strict_string_checks=1:detect_stack_use_after_return=1:check_initialization_order=1:strict_init_order=1
($exitval, $stdout, $stderr) = $self->execute(60, "$ulimits; ./prog $quoted_args\n", '/bin/sh');
} else {
my $input = "$ulimits; guest-gdb ./prog $quoted_args";
($exitval, $stdout, $stderr) = $self->execute(60, $input, '/bin/sh');
}
my $result = $stderr;
$result .= ' ' if length $result;
$result .= $stdout;
if (not length $result) {
$self->{no_output} = 1;
} elsif ($self->{code} =~ m/print_last_statement\(.*\);$/m
&& ($result =~ m/A syntax error in expression/ || $result =~ m/No symbol.*in current context/ || $result =~ m/has unknown return type; cast the call to its declared return/ || $result =~ m/Can't take address of.*which isn't an lvalue/)) {
# strip print_last_statement and rebuild/re-run
$self->{code} =~ s/print_last_statement\((.*)\);/$1;/mg;
$self->preprocess;
$self->postprocess;
} else {
$self->{output} .= $result;
}
}
1;