compiler_vm: refactor some things related to vm-exec

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

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");
+        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("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;
     }
 }

applets/compiler_vm/host/bin/vm-exec

@@ -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 feature qw(signatures);
-use JSON::XS;
+no warnings qw(experimental::signatures);
-
-use FindBin qw($RealBin);
-use lib "$RealBin/../lib";
 
 use constant {
     SERIAL => $ENV{PBOTVM_SERIAL} // 5555,
@@ -26,86 +25,158 @@ use constant {
     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;
 
-if ($@) {
+use FindBin qw($RealBin);
-    # wasn't JSON; make structure manually
+use lib "$RealBin/../lib";
-    if ($json =~ s/^-lang=([^ ]+)\s+//) {
+
-      $data = { lang => $1, code => $json };
+sub connect_vsock($context) {
-    } else {
+    return undef if not $context->{'vm-cid'};
-      $data = { code => $json };
+
+    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) {
-    die "Usage: $0 <code>\n";
+    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
+sub connect_vm($context) {
-$data->{nick}        //= 'vm';
+    my ($input, $output);
-$data->{channel}     //= 'vm';
-$data->{lang}        //= 'c11';
-$data->{'vm-serial'} //= SERIAL;
-$data->{'vm-cid'}    //= CID;
-$data->{'vm-vport'}  //= VPORT;
 
-# parse -lang option
+    # attempt preferred VSOCK connection
-if ($data->{code} =~ s/^-lang=([^ ]+)\s+//) {
+    ($input, $output) = connect_vsock($context);
-    $data->{lang} = $1;
+
+    # 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 {
+    my $context = eval { decode_json $args };
-    require "Languages/$language.pm";
-} or do {
-    my $found = 0;
-    my ($languages, $comma) = ('', '');
 
-    foreach my $module (sort glob "$RealBin/../lib/Languages/*.pm") {
+    if ($@) {
-        $module = basename $module;
+        # wasn't JSON; make structure manually
-        $module =~ s/.pm$//;
+        if ($args =~ s/^-lang=([^ ]+)\s+//) {
-        next if $module =~ m/^_/;
+            $context = { lang => $1, code => $args };
+        } else {
+            $context = { code => $args };
+        }
+    }
 
-        require "Languages/$module.pm" or die $!;
+    if (not exists $context->{code}) {
-        my $mod = "Languages::$module"->new;
+        die "Usage: $0 <code>\n";
+    }
 
-        if (exists $mod->{name} and $mod->{name} eq $language) {
+    # set any missing fields to default values
-            $language = $module;
+    $context->{nick}        //= 'vm';
-            $found = 1;
+    $context->{channel}     //= 'vm';
-            last;
+    $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};
+        if (not $found) {
-        $languages .= "$comma$module";
+            print "Language '$language' is not supported.\nSupported languages are: $languages\n";
-        $comma = ', ';
+            exit;
-    }
+        }
+    };
 
-    if (not $found) {
+    if (not length $context->{code}) {
-        print "Language '$language' is not supported.\nSupported languages are: $languages\n";
+        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}) {
+    my $lang = "Languages::$language"->new(%$context);
-    if (exists $data->{usage}) {
+
-        print "$data->{usage}\n";
+    $lang->process_interactive_edit;
-    } else {
+    $lang->process_standard_options;
-        print "Usage: cc [-lang=<language>] [-info] [-paste] [-args \"command-line arguments\"] [compiler/language options] <code> [-stdin <stdin input>]\n";
+    $lang->process_custom_options;
-    }
+    $lang->process_cmdline_options;
-    exit;
+    $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);
+main();
-
-$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;

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);
+    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 $stdin = $self->{options}->{'-stdin'};
@@ -511,7 +447,6 @@ sub execute {
     }
 
     close $input;
-    waitpid($pid, 0) if defined $pid;
 
     $self->{output} = $result;