GitHub/pbot
3
0
Fork 0
mirror of https://github.com/pragma-/pbot.git synced 2024-10-01 17:16:39 +02:00
Code Issues Projects Releases Wiki Activity

compiler_vm: refactor some things related to vm-exec

Browse Source
This commit is contained in:
Pragmatic Software 2022-02-13 22:01:06 -08:00
parent 1326b0ac5f
commit d609206be8
4 changed files with 153 additions and 142 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
applets/compiler_vm/guest/bin/accept-vsock-client
View File

@ -28,9 +28,10 @@ sub accept_client() {
print STDERR "VSOCK accepted new connection.\n";
my $buffer = '';
my $command;
while (1) {
my $command = Guest::read_input(*STDIN, \$buffer, 'VSOCK');
$command = Guest::read_input(*STDIN, \$buffer, 'VSOCK');
if (not defined $command) {
# recoverable error or waiting for more input

14
applets/compiler_vm/guest/lib/Guest.pm
View File

@ -93,10 +93,13 @@ sub process_command($command, $mod, $user, $tag) {
system("cp -R -p \"/root/factdata/$command->{'persist-key'}\" \"/home/$user/$command->{'persist-key'}\" 1>&2");
}
system("chmod -R 755 /home/$user 1>&2");
system("chown -R $user /home/$user 1>&2");
system("chgrp -R $user /home/$user 1>&2");
system("rm -rf /home/$user/prog* 1>&2");
my $dir = "/home/$user/$$";
system("mkdir -p $dir 1>&2");
system("chmod -R 755 $dir 1>&2");
system("chown -R $user $dir 1>&2");
system("chgrp -R $user $dir 1>&2");
system("pkill -u $user 1>&2");
system("date -s \@$command->{date} 1>&2");
@ -105,7 +108,7 @@ sub process_command($command, $mod, $user, $tag) {
$ENV{LOGNAME} = $user;
$ENV{HOME} = $home;
chdir("/home/$user");
chdir("/home/$user/$$");
$GID = $gid;
$EGID = "$gid $gid";
@ -129,6 +132,7 @@ sub process_command($command, $mod, $user, $tag) {
# kill any left-over processes started by $user
system("pkill -u $user");
system("rm -rf /home/$user/$pid");
return 0;
}
}

161
applets/compiler_vm/host/bin/vm-exec
View File

@ -11,14 +11,13 @@
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
use 5.020;
use warnings;
use strict;
use File::Basename;
use JSON::XS;
use FindBin qw($RealBin);
use lib "$RealBin/../lib";
use feature qw(signatures);
no warnings qw(experimental::signatures);
use constant {
SERIAL => $ENV{PBOTVM_SERIAL} // 5555,
@ -26,40 +25,108 @@ use constant {
VPORT => $ENV{PBOTVM_VPORT} // 5555,
};
my $json = join ' ', @ARGV;
my $data = eval { decode_json $json };
use File::Basename;
use JSON::XS;
use IPC::Open2;
use IO::Socket;
if ($@) {
# wasn't JSON; make structure manually
if ($json =~ s/^-lang=([^ ]+)\s+//) {
$data = { lang => $1, code => $json };
} else {
$data = { code => $json };
use FindBin qw($RealBin);
use lib "$RealBin/../lib";
sub connect_vsock($context) {
return undef if not $context->{'vm-cid'};
print STDERR "Connecting to remote VM socket CID $context->{'vm-cid'} port $context->{'vm-vport'}\n";
my $command = "socat - VSOCK-CONNECT:$context->{'vm-cid'}:$context->{'vm-vport'}";
my ($pid, $input, $output) = eval {
my $pid = open2(my $output, my $input, $command);
return ($pid, $input, $output);
};
if ($@) {
print STDERR "Failed to connect to VM socket: $@\n";
return undef;
}
if (not defined $pid) {
print STDERR "Failed to connect to VM socket: $!\n";
return undef;
}
return ($input, $output);
}
if (not exists $data->{code}) {
sub connect_serial($context) {
print STDERR "Connecting to remote VM serial port $context->{'vm-serial'}\n";
my $vm = IO::Socket::INET->new(
PeerAddr => '127.0.0.1',
PeerPort => $context->{'vm-serial'},
Proto => 'tcp',
Type => SOCK_STREAM
);
# return same $vm handle for ($input, $output)
return ($vm, $vm);
}
sub connect_vm($context) {
my ($input, $output);
# attempt preferred VSOCK connection
($input, $output) = connect_vsock($context);
# fallback to serial
if (not defined $input) {
($input, $output) = connect_serial($context);
}
if (not defined $input) {
die "Could not create connection to VM: $!";
}
print STDERR "Connected to VM.\n";
return ($input, $output);
}
sub main() {
my $args = join ' ', @ARGV;
my $context = eval { decode_json $args };
if ($@) {
# wasn't JSON; make structure manually
if ($args =~ s/^-lang=([^ ]+)\s+//) {
$context = { lang => $1, code => $args };
} else {
$context = { code => $args };
}
}
if (not exists $context->{code}) {
die "Usage: $0 <code>\n";
}
}
# set any missing fields to default values
$data->{nick} //= 'vm';
$data->{channel} //= 'vm';
$data->{lang} //= 'c11';
$data->{'vm-serial'} //= SERIAL;
$data->{'vm-cid'} //= CID;
$data->{'vm-vport'} //= VPORT;
# set any missing fields to default values
$context->{nick} //= 'vm';
$context->{channel} //= 'vm';
$context->{lang} //= 'c11';
$context->{'vm-serial'} //= SERIAL;
$context->{'vm-cid'} //= CID;
$context->{'vm-vport'} //= VPORT;
# parse -lang option
if ($data->{code} =~ s/^-lang=([^ ]+)\s+//) {
$data->{lang} = $1;
}
# parse -lang option
if ($context->{code} =~ s/^-lang=([^ ]+)\s+//) {
$context->{lang} = $1;
}
my $language = lc $data->{lang};
my $language = lc $context->{lang};
eval {
eval {
require "Languages/$language.pm";
} or do {
} or do {
my $found = 0;
my ($languages, $comma) = ('', '');
@ -86,26 +153,30 @@ eval {
print "Language '$language' is not supported.\nSupported languages are: $languages\n";
exit;
}
};
};
if (not length $data->{code}) {
if (exists $data->{usage}) {
print "$data->{usage}\n";
if (not length $context->{code}) {
if (exists $context->{usage}) {
print "$context->{usage}\n";
} else {
print "Usage: cc [-lang=<language>] [-info] [-paste] [-args \"command-line arguments\"] [compiler/language options] <code> [-stdin <stdin input>]\n";
}
exit;
}
my $lang = "Languages::$language"->new(%$context);
$lang->process_interactive_edit;
$lang->process_standard_options;
$lang->process_custom_options;
$lang->process_cmdline_options;
$lang->preprocess_code;
($lang->{'vm-input'}, $lang->{'vm-output'}) = connect_vm($context);
$lang->execute;
$lang->postprocess_output;
$lang->show_output;
}
my $lang = "Languages::$language"->new(%$data);
$lang->{local} = $ENV{CC_LOCAL};
$lang->process_interactive_edit;
$lang->process_standard_options;
$lang->process_custom_options;
$lang->process_cmdline_options;
$lang->preprocess_code;
$lang->execute;
$lang->postprocess_output;
$lang->show_output;
main();

69
applets/compiler_vm/host/lib/Languages/_default.pm
View File

@ -12,8 +12,6 @@ no if $] >= 5.018, warnings => "experimental::smartmatch";
package Languages::_default;
use IPC::Open2;
use IO::Socket;
use LWP::UserAgent;
use Time::HiRes qw/gettimeofday/;
use Text::Balanced qw/extract_delimited/;
@ -318,73 +316,11 @@ sub paste_0x0 {
return $result;
}
sub connect_vsock {
my ($self) = @_;
return undef if not $self->{'vm-cid'};
print STDERR "Connecting to remote VM socket CID $self->{'vm-cid'} port $self->{'vm-vport'}\n";
my $command = "socat - VSOCK-CONNECT:$self->{'vm-cid'}:$self->{'vm-vport'}";
my ($pid, $input, $output) = eval {
my $pid = open2(my $output, my $input, $command);
return ($pid, $input, $output);
};
if ($@) {
print STDERR "Failed to connect to VM socket: $@\n";
return undef;
}
if (not defined $pid) {
print STDERR "Failed to connect to VM socket: $!\n";
return undef;
}
return ($input, $output);
}
sub connect_serial {
my ($self) = @_;
print STDERR "Connecting to remote VM serial port $self->{'vm-serial'}\n";
my $vm = IO::Socket::INET->new(
PeerAddr => '127.0.0.1',
PeerPort => $self->{'vm-serial'},
Proto => 'tcp',
Type => SOCK_STREAM
);
# return same $vm handle for ($input, $output)
return ($vm, $vm);
}
sub execute {
my ($self) = @_;
my ($input, $output, $pid);
if (defined $self->{local} and $self->{local} != 0) {
print "Using local machine instead of virtual machine\n";
$pid = open2($output, $input, './compiler_vm_server.pl') || die "repl failed: $@\n"; # XXX adapt vm-exec into local-exec
print "Started fake-vm, pid: $pid\n";
} else {
# attempt preferred VSOCK connection
($input, $output) = $self->connect_vsock();
# fallback to serial
if (not defined $input) {
($input, $output) = $self->connect_serial();
}
if (not defined $input) {
die "Could not create connection to VM: $!";
}
print STDERR "Connected to VM.\n";
}
my $input = $self->{'vm-input'};
my $output = $self->{'vm-output'};
my $date = time;
my $stdin = $self->{options}->{'-stdin'};
@ -511,7 +447,6 @@ sub execute {
}
close $input;
waitpid($pid, 0) if defined $pid;
$self->{output} = $result;