pbot/applets/pbot-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 constant {
    USERNAME  => 'vm',
    MOD_DIR   => '/usr/local/share/pbot-vm/',
    SERIAL    => '/dev/ttyS1',
    HEARTBEAT => '/dev/ttyS2',
    VPORT     => $ENV{PBOTVM_VPORT} // 5555,
};

use lib MOD_DIR;
use lib MOD_DIR . "Languages";

use Guest;

use File::Basename;
use IPC::Shareable;

my %languages;

sub load_modules() {
    my @files = glob MOD_DIR . "Languages/*.pm";

    foreach my $mod (@files){
        print "Loading module $mod\n";

        my $filename = basename($mod);

        require $filename;

        $filename =~ s/\.pm$//;

        $languages{$filename} = 1;
    }
}

sub vsock_server() {
    print "Starting VSOCK server on PID $$\n";

    system("socat VSOCK-LISTEN:".VPORT.",reuseaddr,fork EXEC:accept-vsock-client");

    print "VSOCK server shutdown.\n";
    exit; # exit child process
}

sub serial_server() {
    print "Starting serial server on PID $$\n";

    # 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 $!;

    tie my $running, 'IPC::Shareable', { key => 'running' };

    my $buffer = '';

    while ($running) {
        my $command = Guest::read_input($input, \$buffer, 'Serial');

        if (not defined $command) {
            # recoverable error while reading, try again
            next;
        }

        if ($command == 0) {
            # serial closed, exit child process
            exit;
        }

        if (not exists $languages{$command->{lang}}) {
            $command->{lang} = '_default';
        }

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

        my $result = Guest::process_command($command, $mod, USERNAME, 'Serial');

        if (not defined $result) {
            $result = "[Fatal error]";
        }

        if ($result) {
            Guest::send_output($output, $result, 'Serial');
            exit; # exit child process
        }
    }
}

sub do_server() {
    my $pid = fork;

    if (not defined $pid) {
        print STDERR "Could not fork server: $!\n";
        die;
    }

    if ($pid == 0) {
        vsock_server();
    } else {
        serial_server();
    }
}

sub do_heartbeat() {
    open(my $heartbeat, '>', HEARTBEAT) or die $!;

    tie my $running, 'IPC::Shareable', { key => 'running' };

    print "Heart beating on PID $$...\n";

    while ($running) {
        print $heartbeat "\n";
        sleep 5;
    }

    print "Heart beat stopped.\n";
    exit; # exit child process
}

sub install_signal_handlers() {
    use POSIX qw(:signal_h :errno_h :sys_wait_h);

    $SIG{CHLD} = \&REAPER;

    sub REAPER {
        my $pid = waitpid(-1, &WNOHANG);

        if ($pid == -1) {
            # no child waiting. Ignore it.
        } elsif (WIFEXITED($?)) {
            print "Process $pid exited.\n";
        }

        $SIG{CHLD} = \&REAPER; # in case of unreliable signals
    }
}

sub main() {
    print "Starting PBot VM Guest server on PID $$\n";

    load_modules();

    install_signal_handlers();

    tie my $running, 'IPC::Shareable', { key => 'running', create => 1, destroy => 1 };

    $running = 1;

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

    if ($pid == 0) {
        do_heartbeat();
    } else {
        do_server();
    }

    print "PBot VM Guest server shutdown.\n";
}

main();