3
0
mirror of https://github.com/pragma-/pbot.git synced 2024-11-14 16:09:34 +01:00
pbot/applets/compiler_vm/guest/lib/Guest.pm
Pragmatic Software 1326b0ac5f compiler_vm: major refactor to support VM sockets (AF_VSOCK)
VM socket communication is superior to VM serial communication in
every way. Unfortunately at this time only Linux supports them.
Fortunately, that's 99% of PBot's userbase.

If you're not using Linux or if you're using an older Linux that
does not support VM sockets, the PBot VM scripts will gracefully
fallback to using the serial connection. You may explicitly
disable VM socket connection attempts by setting PBOTVM_CID=0.
2022-02-12 16:06:04 -08:00

166 lines
4.0 KiB
Perl

#!/usr/bin/env perl
# File: Guest.pm
#
# Purpose: Collection of functions to interface with the PBot VM Guest and
# execute VM commands.
# SPDX-FileCopyrightText: 2022 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package Guest;
use 5.020;
use warnings;
use strict;
use feature qw/signatures/;
no warnings qw(experimental::signatures);
use English;
use Encode;
use File::Basename;
use JSON::XS;
use IPC::Shareable;
use Data::Dumper;
sub read_input($input, $buffer, $tag) {
my $line;
my $total_read = 0;
print STDERR "$tag waiting for input...\n";
my $ret = sysread($input, my $buf, 16384);
if (not defined $ret) {
print STDERR "Error reading $tag: $!\n";
return undef;
}
if ($ret == 0) {
print STDERR "$tag input closed.\n";
return 0;
}
$total_read += $ret;
print STDERR "$tag read $ret bytes [$total_read total] [$buf]\n";
$$buffer .= $buf;
return undef if $$buffer !~ s/\s*:end:\s*$//m;
$line = $$buffer;
chomp $line;
$$buffer = '';
$total_read = 0;
$line = encode('UTF-8', $line);
print STDERR "-" x 40, "\n";
print STDERR "$tag got [$line]\n";
my $command = decode_json($line);
$command->{arguments} //= '';
$command->{input} //= '';
print STDERR Dumper($command), "\n";
return $command;
}
sub process_command($command, $mod, $user, $tag) {
my ($uid, $gid, $home) = (getpwnam $user)[2, 3, 7];
if (not $uid and not $gid) {
print STDERR "Could not find user $user: $!\n";
return undef;
}
my $pid = fork;
if (not defined $pid) {
print STDERR "process_command: fork failed: $!\n";
return undef;
}
if ($pid == 0) {
if ($command->{'persist-key'}) {
system ("rm -rf \"/home/$user/$command->{'persist-key'}\" 1>&2");
system("mount /dev/vdb1 /root/factdata 1>&2");
system("mkdir -p \"/root/factdata/$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");
system("chown -R $user /home/$user 1>&2");
system("chgrp -R $user /home/$user 1>&2");
system("rm -rf /home/$user/prog* 1>&2");
system("pkill -u $user 1>&2");
system("date -s \@$command->{date} 1>&2");
$ENV{USER} = $user;
$ENV{LOGNAME} = $user;
$ENV{HOME} = $home;
chdir("/home/$user");
$GID = $gid;
$EGID = "$gid $gid";
$EUID = $UID = $uid;
my $result = run_command($command, $mod);
print STDERR "=" x 40, "\n";
return $result;
} else {
# wait for child to finish
waitpid($pid, 0);
# clean up persistent factoid storage
if ($command->{'persist-key'}) {
system("cp -R -p \"/home/$user/$command->{'persist-key'}\" \"/root/factdata/$command->{'persist-key'}\"");
system("umount /root/factdata");
system ("rm -rf \"/home/$user/$command->{'persist-key'}\"");
}
# kill any left-over processes started by $user
system("pkill -u $user");
return 0;
}
}
sub run_command($command, $mod) {
local $SIG{CHLD} = 'DEFAULT';
$mod->preprocess;
$mod->postprocess if not $mod->{error} and not $mod->{done};
if (exists $mod->{no_output} or not length $mod->{output}) {
if ($command->{factoid}) {
$mod->{output} = '';
} else {
$mod->{output} .= "\n" if length $mod->{output};
if (not $mod->{error}) {
$mod->{output} .= "Success (no output).\n";
} else {
$mod->{output} .= "Exit code $mod->{error}.\n";
}
}
}
return $mod->{output};
}
sub send_output($output, $result, $tag) {
my $json = encode_json({ result => $result });
print $output "result:$json\n";
print $output "result:end\n";
}
1;