pbot/applets/compiler_vm/guest/bin/guest-server

#!/usr/bin/env perl

# File: guest-server
#
# Purpose: PBot VM Guest server. Runs inside PBot VM Guest and processes
# incoming VM commands from vm-exec.

# SPDX-FileCopyrightText: 2022 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 English;
use Encode;
use File::Basename;
use JSON::XS;
use Data::Dumper;

my $USERNAME = 'vm';   # variable for easier string interpolation

use constant {
    MOD_DIR   => '/usr/local/share/pbot-vm/Languages',
    SERIAL    => '/dev/ttyS1',
    HEARTBEAT => '/dev/ttyS2',
    INPUT     => '/dev/stdin',
    OUTPUT    => '/dev/stdout',
};

use lib MOD_DIR;

my %languages;

sub load_modules() {
    my @files = glob MOD_DIR . "/*.pm";
    foreach my $mod (@files){
        print "Loading module $mod\n";
        my $filename = basename($mod);
        require $filename;
        $filename =~ s/\.pm$//;
        $languages{$filename} = 1;
    }
}

sub do_server($input, $output) {
    my $buffer = '';
    my $line;
    my $total_read = 0;

    while (1) {
        print "Waiting for input...\n";
        my $ret = sysread($input, my $buf, 16384);

        if (not defined $ret) {
            print "Error reading: $!\n";
            next;
        }

        if ($ret == 0) {
            print "Input closed; exiting...\n";
            exit;
        }

        $total_read += $ret;

        chomp $buf;
        print "read $ret bytes [$total_read so far] [$buf]\n";

        $buffer .= $buf;

        next if $buffer !~ s/\s*:end:\s*$//m;

        $line = $buffer;
        chomp $line;

        $buffer = '';
        $total_read = 0;

        $line = encode('UTF-8', $line);

        print "-" x 40, "\n";
        print "Got [$line]\n";

        my $command = decode_json($line);
        $command->{arguments} //= '';
        $command->{input}     //= '';

        print Dumper $command;
        handle_command($command, $output);
    }
}

sub handle_command($command, $output) {
    local $SIG{CHLD} = 'IGNORE';

    my $pid = fork;

    if (not defined $pid) {
        print "fork failed: $!\n";
        next;
    }

    if ($pid == 0) {
        my ($uid, $gid, $home) = (getpwnam $USERNAME)[2, 3, 7];

        if (not $uid and not $gid) {
            print "Could not find user $USERNAME: $!\n";
            exit;
        }

        if ($command->{'persist-key'}) {
            system ("rm -rf \"/home/$USERNAME/$command->{'persist-key'}\"");
            system("mount /dev/vdb1 /root/factdata");
            system("mkdir -p \"/root/factdata/$command->{'persist-key'}\"");
            system("cp -R -p \"/root/factdata/$command->{'persist-key'}\" \"/home/$USERNAME/$command->{'persist-key'}\"");
        }

        system("chmod -R 755 /home/$USERNAME");
        system("chown -R $USERNAME /home/$USERNAME");
        system("chgrp -R $USERNAME /home/$USERNAME");
        system("rm -rf /home/$USERNAME/prog*");
        system("pkill -u $USERNAME");

        system("date -s \@$command->{date}");

        $ENV{USER} = $USERNAME;
        $ENV{LOGNAME} = $USERNAME;
        $ENV{HOME} = $home;

        $GID = $gid;
        $EGID = "$gid $gid";
        $EUID = $UID = $uid;

        chdir("/home/$USERNAME");

        my $result = run_command(%$command);

        $GID = 0;
        $UID = 0;

        my $compile_out = { result => $result };

        my $json = encode_json($compile_out);

        print "Done compiling: $json\n";

        print $output "result:$json\n";
        print $output "result:end\n";

        if ($command->{'persist-key'}) {
            system("cp -R -p \"/home/$USERNAME/$command->{'persist-key'}\" \"/root/factdata/$command->{'persist-key'}\"");
            system("umount /root/factdata");
            system ("rm -rf \"/home/$USERNAME/$command->{'persist-key'}\"");
        }

        print "=" x 40, "\n";

        # kill any left-over processes started by $USERNAME
        system("pkill -u $USERNAME");
        print "after pkill???\n";
        exit;
    }
}

sub run_command(%command) {
    $command{lang} = '_default' if not exists $languages{$command{lang}};

    my $mod = $command{lang}->new(%command);

    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 do_heartbeat($heartbeat) {
    while (1) {
        print $heartbeat "\n";
        sleep 5;
    }
}

sub main() {
    load_modules();

    # set serial to 115200 baud instead of 9600
    system('stty -F ' . SERIAL . ' 115200');

    open(my $input,     '<', SERIAL)    or die $!;
    open(my $output,    '>', SERIAL)    or die $!;
    open(my $heartbeat, '>', HEARTBEAT) or die $!;

    my $pid = fork // die "Fork failed: $!";

    if ($pid == 0) {
        do_server($input, $output);
    } else {
        do_heartbeat($heartbeat);
    }
}

main();