pbot/applets/compiler_vm/guest/bin/start-guest

#!/usr/bin/env perl

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

# SPDX-FileCopyrightText: 2022 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT

use warnings;
use strict;

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',
};

my $USE_LOCAL = $ENV{'CC_LOCAL'} // 0;

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 run_server {
    my ($input, $output, $heartbeat);

    if (not $USE_LOCAL) {
        # set serial to 115200 baud instead of 9600
        system('stty -F ' . SERIAL . ' 115200');

        open($input,     '<', SERIAL)       or die $!;
        open($output,    '>', SERIAL)       or die $!;
        open($heartbeat, '>', HEARTBEAT)    or die $!;
    } else {
        open($input,     '<', INPUT)        or die $!;
        open($output,    '>', OUTPUT)       or die $!;
    }

    my $date;
    my $lang;
    my $sourcefile;
    my $execfile;
    my $code;
    my $cmdline;
    my $user_input;

    my $pid = fork;
    die "Fork failed: $!" if not defined $pid;

    if ($pid == 0) {
        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;
            }

            $total_read += $ret;

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

            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 $compile_in = decode_json($line);

            print Dumper $compile_in;

            $compile_in->{arguments} //= '';
            $compile_in->{input}     //= '';

            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 ($compile_in->{'persist-key'}) {
                    system ("rm -rf \"/home/$USERNAME/$compile_in->{'persist-key'}\"");
                    system("mount /dev/vdb1 /root/factdata");
                    system("mkdir -p \"/root/factdata/$compile_in->{'persist-key'}\"");
                    system("cp -R -p \"/root/factdata/$compile_in->{'persist-key'}\" \"/home/$USERNAME/$compile_in->{'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 \@$compile_in->{date}");

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

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

                chdir("/home/$USERNAME");

                my $result = interpret(%$compile_in);

                $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 ($compile_in->{'persist-key'}) {
                    system("id");
                    system("cp -R -p \"/home/$USERNAME/$compile_in->{'persist-key'}\" \"/root/factdata/$compile_in->{'persist-key'}\"");
                    system("umount /root/factdata");
                    system ("rm -rf \"/home/$USERNAME/$compile_in->{'persist-key'}\"");
                }

                exit;
            } else {
                waitpid $pid, 0;

                # kill any left-over processes started by $USERNAME
                system("pkill -u $USERNAME");
            }

            if (not $USE_LOCAL) {
                print "=" x 40, "\n";
                next;
            } else {
                exit;
            }
        }
    } else {
        while (1) {
            print $heartbeat "\n";
            sleep 5;
        }
    }

    close $input;
    close $output;
    close $heartbeat;
}

sub interpret {
    my %h = @_;

    $h{lang} = '_default' if not exists $languages{$h{lang}};

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

    $mod->preprocess;

    $mod->postprocess if not $mod->{error} and not $mod->{done};

    if (exists $mod->{no_output} or not length $mod->{output}) {
        if ($h{factoid}) {
            $mod->{output} = "";
        } else {
            $mod->{output} .= "\n" if length $mod->{output};
            $mod->{output} .= "Success (no output).\n" if not $mod->{error};
            $mod->{output} .= "Success (exit code $mod->{error}).\n" if $mod->{error};
        }
    }

    return $mod->{output};
}

load_modules;
run_server;