diff --git a/applets/compiler_vm/guest/bin/accept-vsock-client b/applets/compiler_vm/guest/bin/accept-vsock-client index f0b6a704..6d6334f1 100755 --- a/applets/compiler_vm/guest/bin/accept-vsock-client +++ b/applets/compiler_vm/guest/bin/accept-vsock-client @@ -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 diff --git a/applets/compiler_vm/guest/lib/Guest.pm b/applets/compiler_vm/guest/lib/Guest.pm index 2669848f..011495ff 100644 --- a/applets/compiler_vm/guest/lib/Guest.pm +++ b/applets/compiler_vm/guest/lib/Guest.pm @@ -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; } } diff --git a/applets/compiler_vm/host/bin/vm-exec b/applets/compiler_vm/host/bin/vm-exec index 0cde638b..ff7f571a 100755 --- a/applets/compiler_vm/host/bin/vm-exec +++ b/applets/compiler_vm/host/bin/vm-exec @@ -11,14 +11,13 @@ # SPDX-FileCopyrightText: 2021 Pragmatic Software # 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 \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 \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=] [-info] [-paste] [-args \"command-line arguments\"] [compiler/language options] [-stdin ]\n"; + } exit; } -}; -if (not length $data->{code}) { - if (exists $data->{usage}) { - print "$data->{usage}\n"; - } else { - print "Usage: cc [-lang=] [-info] [-paste] [-args \"command-line arguments\"] [compiler/language options] [-stdin ]\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(); diff --git a/applets/compiler_vm/host/lib/Languages/_default.pm b/applets/compiler_vm/host/lib/Languages/_default.pm index cf22ddac..581454db 100755 --- a/applets/compiler_vm/host/lib/Languages/_default.pm +++ b/applets/compiler_vm/host/lib/Languages/_default.pm @@ -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;