mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-29 07:19:23 +01:00
compiler_vm: refactor some things related to vm-exec
This commit is contained in:
parent
1326b0ac5f
commit
d609206be8
@ -28,9 +28,10 @@ sub accept_client() {
|
|||||||
print STDERR "VSOCK accepted new connection.\n";
|
print STDERR "VSOCK accepted new connection.\n";
|
||||||
|
|
||||||
my $buffer = '';
|
my $buffer = '';
|
||||||
|
my $command;
|
||||||
|
|
||||||
while (1) {
|
while (1) {
|
||||||
my $command = Guest::read_input(*STDIN, \$buffer, 'VSOCK');
|
$command = Guest::read_input(*STDIN, \$buffer, 'VSOCK');
|
||||||
|
|
||||||
if (not defined $command) {
|
if (not defined $command) {
|
||||||
# recoverable error or waiting for more input
|
# recoverable error or waiting for more input
|
||||||
|
@ -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("cp -R -p \"/root/factdata/$command->{'persist-key'}\" \"/home/$user/$command->{'persist-key'}\" 1>&2");
|
||||||
}
|
}
|
||||||
|
|
||||||
system("chmod -R 755 /home/$user 1>&2");
|
my $dir = "/home/$user/$$";
|
||||||
system("chown -R $user /home/$user 1>&2");
|
|
||||||
system("chgrp -R $user /home/$user 1>&2");
|
system("mkdir -p $dir 1>&2");
|
||||||
system("rm -rf /home/$user/prog* 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("pkill -u $user 1>&2");
|
||||||
|
|
||||||
system("date -s \@$command->{date} 1>&2");
|
system("date -s \@$command->{date} 1>&2");
|
||||||
@ -105,7 +108,7 @@ sub process_command($command, $mod, $user, $tag) {
|
|||||||
$ENV{LOGNAME} = $user;
|
$ENV{LOGNAME} = $user;
|
||||||
$ENV{HOME} = $home;
|
$ENV{HOME} = $home;
|
||||||
|
|
||||||
chdir("/home/$user");
|
chdir("/home/$user/$$");
|
||||||
|
|
||||||
$GID = $gid;
|
$GID = $gid;
|
||||||
$EGID = "$gid $gid";
|
$EGID = "$gid $gid";
|
||||||
@ -129,6 +132,7 @@ sub process_command($command, $mod, $user, $tag) {
|
|||||||
|
|
||||||
# kill any left-over processes started by $user
|
# kill any left-over processes started by $user
|
||||||
system("pkill -u $user");
|
system("pkill -u $user");
|
||||||
|
system("rm -rf /home/$user/$pid");
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -11,14 +11,13 @@
|
|||||||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||||
# SPDX-License-Identifier: MIT
|
# SPDX-License-Identifier: MIT
|
||||||
|
|
||||||
|
use 5.020;
|
||||||
|
|
||||||
use warnings;
|
use warnings;
|
||||||
use strict;
|
use strict;
|
||||||
|
|
||||||
use File::Basename;
|
use feature qw(signatures);
|
||||||
use JSON::XS;
|
no warnings qw(experimental::signatures);
|
||||||
|
|
||||||
use FindBin qw($RealBin);
|
|
||||||
use lib "$RealBin/../lib";
|
|
||||||
|
|
||||||
use constant {
|
use constant {
|
||||||
SERIAL => $ENV{PBOTVM_SERIAL} // 5555,
|
SERIAL => $ENV{PBOTVM_SERIAL} // 5555,
|
||||||
@ -26,36 +25,104 @@ use constant {
|
|||||||
VPORT => $ENV{PBOTVM_VPORT} // 5555,
|
VPORT => $ENV{PBOTVM_VPORT} // 5555,
|
||||||
};
|
};
|
||||||
|
|
||||||
my $json = join ' ', @ARGV;
|
use File::Basename;
|
||||||
my $data = eval { decode_json $json };
|
use JSON::XS;
|
||||||
|
use IPC::Open2;
|
||||||
|
use IO::Socket;
|
||||||
|
|
||||||
|
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);
|
||||||
|
}
|
||||||
|
|
||||||
|
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 ($@) {
|
if ($@) {
|
||||||
# wasn't JSON; make structure manually
|
# wasn't JSON; make structure manually
|
||||||
if ($json =~ s/^-lang=([^ ]+)\s+//) {
|
if ($args =~ s/^-lang=([^ ]+)\s+//) {
|
||||||
$data = { lang => $1, code => $json };
|
$context = { lang => $1, code => $args };
|
||||||
} else {
|
} else {
|
||||||
$data = { code => $json };
|
$context = { code => $args };
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
if (not exists $data->{code}) {
|
if (not exists $context->{code}) {
|
||||||
die "Usage: $0 <code>\n";
|
die "Usage: $0 <code>\n";
|
||||||
}
|
}
|
||||||
|
|
||||||
# set any missing fields to default values
|
# set any missing fields to default values
|
||||||
$data->{nick} //= 'vm';
|
$context->{nick} //= 'vm';
|
||||||
$data->{channel} //= 'vm';
|
$context->{channel} //= 'vm';
|
||||||
$data->{lang} //= 'c11';
|
$context->{lang} //= 'c11';
|
||||||
$data->{'vm-serial'} //= SERIAL;
|
$context->{'vm-serial'} //= SERIAL;
|
||||||
$data->{'vm-cid'} //= CID;
|
$context->{'vm-cid'} //= CID;
|
||||||
$data->{'vm-vport'} //= VPORT;
|
$context->{'vm-vport'} //= VPORT;
|
||||||
|
|
||||||
# parse -lang option
|
# parse -lang option
|
||||||
if ($data->{code} =~ s/^-lang=([^ ]+)\s+//) {
|
if ($context->{code} =~ s/^-lang=([^ ]+)\s+//) {
|
||||||
$data->{lang} = $1;
|
$context->{lang} = $1;
|
||||||
}
|
}
|
||||||
|
|
||||||
my $language = lc $data->{lang};
|
my $language = lc $context->{lang};
|
||||||
|
|
||||||
eval {
|
eval {
|
||||||
require "Languages/$language.pm";
|
require "Languages/$language.pm";
|
||||||
@ -88,24 +155,28 @@ eval {
|
|||||||
}
|
}
|
||||||
};
|
};
|
||||||
|
|
||||||
if (not length $data->{code}) {
|
if (not length $context->{code}) {
|
||||||
if (exists $data->{usage}) {
|
if (exists $context->{usage}) {
|
||||||
print "$data->{usage}\n";
|
print "$context->{usage}\n";
|
||||||
} else {
|
} else {
|
||||||
print "Usage: cc [-lang=<language>] [-info] [-paste] [-args \"command-line arguments\"] [compiler/language options] <code> [-stdin <stdin input>]\n";
|
print "Usage: cc [-lang=<language>] [-info] [-paste] [-args \"command-line arguments\"] [compiler/language options] <code> [-stdin <stdin input>]\n";
|
||||||
}
|
}
|
||||||
exit;
|
exit;
|
||||||
}
|
}
|
||||||
|
|
||||||
my $lang = "Languages::$language"->new(%$data);
|
my $lang = "Languages::$language"->new(%$context);
|
||||||
|
|
||||||
$lang->{local} = $ENV{CC_LOCAL};
|
|
||||||
|
|
||||||
$lang->process_interactive_edit;
|
$lang->process_interactive_edit;
|
||||||
$lang->process_standard_options;
|
$lang->process_standard_options;
|
||||||
$lang->process_custom_options;
|
$lang->process_custom_options;
|
||||||
$lang->process_cmdline_options;
|
$lang->process_cmdline_options;
|
||||||
$lang->preprocess_code;
|
$lang->preprocess_code;
|
||||||
|
|
||||||
|
($lang->{'vm-input'}, $lang->{'vm-output'}) = connect_vm($context);
|
||||||
$lang->execute;
|
$lang->execute;
|
||||||
|
|
||||||
$lang->postprocess_output;
|
$lang->postprocess_output;
|
||||||
$lang->show_output;
|
$lang->show_output;
|
||||||
|
}
|
||||||
|
|
||||||
|
main();
|
||||||
|
@ -12,8 +12,6 @@ no if $] >= 5.018, warnings => "experimental::smartmatch";
|
|||||||
|
|
||||||
package Languages::_default;
|
package Languages::_default;
|
||||||
|
|
||||||
use IPC::Open2;
|
|
||||||
use IO::Socket;
|
|
||||||
use LWP::UserAgent;
|
use LWP::UserAgent;
|
||||||
use Time::HiRes qw/gettimeofday/;
|
use Time::HiRes qw/gettimeofday/;
|
||||||
use Text::Balanced qw/extract_delimited/;
|
use Text::Balanced qw/extract_delimited/;
|
||||||
@ -318,73 +316,11 @@ sub paste_0x0 {
|
|||||||
return $result;
|
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 {
|
sub execute {
|
||||||
my ($self) = @_;
|
my ($self) = @_;
|
||||||
|
|
||||||
my ($input, $output, $pid);
|
my $input = $self->{'vm-input'};
|
||||||
|
my $output = $self->{'vm-output'};
|
||||||
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 $date = time;
|
my $date = time;
|
||||||
my $stdin = $self->{options}->{'-stdin'};
|
my $stdin = $self->{options}->{'-stdin'};
|
||||||
@ -511,7 +447,6 @@ sub execute {
|
|||||||
}
|
}
|
||||||
|
|
||||||
close $input;
|
close $input;
|
||||||
waitpid($pid, 0) if defined $pid;
|
|
||||||
|
|
||||||
$self->{output} = $result;
|
$self->{output} = $result;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user