3
0
mirror of https://github.com/pragma-/pbot.git synced 2024-11-05 11:39:34 +01:00
pbot/applets/pbot-vm/host/bin/vm-exec
Pragmatic Software 951b771b9c pbot-vm: vm-exec can now select VM; can be configured by vm-exec.json file
The vm-exec command now recognizes the following options:

    -vm-serial -vm-heart -vm-cid -vm-vport -vm

The -vm option accepts a name and configures the serial,
heart, cid and vport appropriately.

The vm-exec command can be configured by /host/config/vm-exec.json.
2022-02-15 11:28:47 -08:00

262 lines
7.0 KiB
Perl
Executable File

#!/usr/bin/env perl
# File: vm-exec
#
# Purpose: Process and send commands to the PBot Guest server (guest-server) on
# the default VM socket CID/port (7/5555) or the default serial TCP port (5555).
#
# Use the PBOTVM_CID, PBOTVM_VPORT and/or PBOTVM_SERIAL environment variables to
# override these defaults. E.g.:
#
# $ PBOTVM_CID=42 PBOTVM_SERIAL=7777 vm-exec -lang=sh echo test
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
use 5.020;
use warnings;
use strict;
use feature qw(signatures);
no warnings qw(experimental::signatures);
use constant {
SERIAL => $ENV{PBOTVM_SERIAL} // 5555,
CID => $ENV{PBOTVM_CID} // 7,
VPORT => $ENV{PBOTVM_VPORT} // 5555,
};
use File::Basename;
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 make_context_from_args(@args_in) {
my $args = join ' ', @args_in;
my $context = eval { decode_json $args };
if ($@) {
# wasn't JSON; make structure manually
$context = { code => $args };
# command-line usage
if (not length $context->{code}) {
die "Usage: $0 [-lang=<language>] <code>\n";
}
}
# parse options specific to vm-exec
while ($context->{code} =~ s/^-(lang|vm-cid|vm-vport|vm-serial|vm)=([^ ]+)\s+//) {
my ($option, $value) = ($1, $2);
print STDERR "Overriding `$option` to `$value`.\n";
$context->{$option} = lc $value;
}
return $context;
}
sub load_language($context) {
my $language = $context->{lang};
eval {
require "Languages/$language.pm";
} or do {
my @languages;
foreach my $module (sort glob "$RealBin/../lib/Languages/*.pm") {
$module = basename $module;
next if $module =~ m/^_/;
$module =~ s/.pm$//;
require "Languages/$module.pm" or die $!;
my $mod = "Languages::$module"->new(%$context);
if (exists $mod->{name} && $mod->{name} eq $language) {
return $mod;
}
$module = $mod->{name} if exists $mod->{name};
push @languages, $module;
}
print "Language '$language' is not supported.\nSupported languages are: ", join(', ', @languages), "\n";
exit 1;
};
return "Languages::$language"->new(%$context);
}
sub load_config($file) {
open my $fh, '<', $file or die "load config: could not open $file: $!\n";
local $/ = undef;
my $json = <$fh>;
close $fh;
return decode_json($json);
}
sub config_get_machine($config, $machine) {
# check if machine is an alias and update to actual machine
if (exists $config->{aliases}->{$machine}) {
$machine = $config->{aliases}->{$machine};
}
# return pointer to config entry
return $config->{machines}->{$machine};
}
sub list_machines($config) {
my @machines;
# quick-and-easy: just list the aliases
foreach my $alias (keys %{$config->{aliases}}) {
push @machines, $alias;
}
return join ', ', sort @machines;
}
sub configure_context($context, $config) {
if (exists $context->{vm}) {
# -vm option was passed, forcibly override machine
my $machine = $context->{vm};
# point at config entry
my $entry = config_get_machine($config, $machine);
if (not defined $entry) {
my $machines = list_machines($config);
print "Unknown machine '$machine'; available machines are: $machines\n";
exit 1;
}
# override values
$context->{'vm-serial'} = $entry->{'serial'};
$context->{'vm-heart'} = $entry->{'heart'};
$context->{'vm-cid'} = $entry->{'cid'};
$context->{'vm-vport'} = $entry->{'vport'};
} else {
# otherwise configure any undefined values as default machine
my $machine = $config->{'default-machine'};
# point at config entry
my $entry = config_get_machine($config, $machine);
if (not defined $entry) {
my $machines = list_machines($config);
print "Unknown machine '$machine'; available machines are: $machines\n";
exit 1;
}
# update any undefined values, preserving any existing values
$context->{'vm-serial'} //= $entry->{'serial'};
$context->{'vm-heart'} //= $entry->{'heart'};
$context->{'vm-cid'} //= $entry->{'cid'};
$context->{'vm-vport'} //= $entry->{'vport'};
}
# set any undefined values to default values
$context->{nick} //= 'vm';
$context->{channel} //= 'vm';
$context->{lang} //= 'c11';
$context->{'vm-serial'} //= SERIAL;
$context->{'vm-cid'} //= CID;
$context->{'vm-vport'} //= VPORT;
}
sub main() {
my $context = make_context_from_args(@ARGV);
my $config = load_config("$RealBin/../config/vm-exec.json");
configure_context($context, $config);
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 1;
}
my $lang = load_language($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;
}
main();