mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-25 13:29:29 +01:00
compiler_vm: refactor some things related to vm-exec
This commit is contained in:
Pragmatic Software
parent
1326b0ac5f
commit
d609206be8
@ -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
|
||||
|
||||
@ -93,19 +93,22 @@ 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");
|
||||
|
||||
$ENV{USER} = $user;
|
||||
$ENV{USER} = $user;
|
||||
$ENV{LOGNAME} = $user;
|
||||
$ENV{HOME} = $home;
|
||||
$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;
|
||||
}
|
||||
}
|
||||
|
||||
@ -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,86 +25,158 @@ 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}) {
|
||||
die "Usage: $0 <code>\n";
|
||||
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);
|
||||
}
|
||||
|
||||
# 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;
|
||||
sub connect_vm($context) {
|
||||
my ($input, $output);
|
||||
|
||||
# parse -lang option
|
||||
if ($data->{code} =~ s/^-lang=([^ ]+)\s+//) {
|
||||
$data->{lang} = $1;
|
||||
# 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);
|
||||
}
|
||||
|
||||
my $language = lc $data->{lang};
|
||||
sub main() {
|
||||
my $args = join ' ', @ARGV;
|
||||
|
||||
eval {
|
||||
require "Languages/$language.pm";
|
||||
} or do {
|
||||
my $found = 0;
|
||||
my ($languages, $comma) = ('', '');
|
||||
my $context = eval { decode_json $args };
|
||||
|
||||
foreach my $module (sort glob "$RealBin/../lib/Languages/*.pm") {
|
||||
$module = basename $module;
|
||||
$module =~ s/.pm$//;
|
||||
next if $module =~ m/^_/;
|
||||
if ($@) {
|
||||
# wasn't JSON; make structure manually
|
||||
if ($args =~ s/^-lang=([^ ]+)\s+//) {
|
||||
$context = { lang => $1, code => $args };
|
||||
} else {
|
||||
$context = { code => $args };
|
||||
}
|
||||
}
|
||||
|
||||
require "Languages/$module.pm" or die $!;
|
||||
my $mod = "Languages::$module"->new;
|
||||
if (not exists $context->{code}) {
|
||||
die "Usage: $0 <code>\n";
|
||||
}
|
||||
|
||||
if (exists $mod->{name} and $mod->{name} eq $language) {
|
||||
$language = $module;
|
||||
$found = 1;
|
||||
last;
|
||||
# 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 ($context->{code} =~ s/^-lang=([^ ]+)\s+//) {
|
||||
$context->{lang} = $1;
|
||||
}
|
||||
|
||||
my $language = lc $context->{lang};
|
||||
|
||||
eval {
|
||||
require "Languages/$language.pm";
|
||||
} or do {
|
||||
my $found = 0;
|
||||
my ($languages, $comma) = ('', '');
|
||||
|
||||
foreach my $module (sort glob "$RealBin/../lib/Languages/*.pm") {
|
||||
$module = basename $module;
|
||||
$module =~ s/.pm$//;
|
||||
next if $module =~ m/^_/;
|
||||
|
||||
require "Languages/$module.pm" or die $!;
|
||||
my $mod = "Languages::$module"->new;
|
||||
|
||||
if (exists $mod->{name} and $mod->{name} eq $language) {
|
||||
$language = $module;
|
||||
$found = 1;
|
||||
last;
|
||||
}
|
||||
|
||||
$module = $mod->{name} if exists $mod->{name};
|
||||
$languages .= "$comma$module";
|
||||
$comma = ', ';
|
||||
}
|
||||
|
||||
$module = $mod->{name} if exists $mod->{name};
|
||||
$languages .= "$comma$module";
|
||||
$comma = ', ';
|
||||
}
|
||||
if (not $found) {
|
||||
print "Language '$language' is not supported.\nSupported languages are: $languages\n";
|
||||
exit;
|
||||
}
|
||||
};
|
||||
|
||||
if (not $found) {
|
||||
print "Language '$language' is not supported.\nSupported languages are: $languages\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;
|
||||
}
|
||||
};
|
||||
|
||||
if (not length $data->{code}) {
|
||||
if (exists $data->{usage}) {
|
||||
print "$data->{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();
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user