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

#!/usr/bin/env perl

# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at http://mozilla.org/MPL/2.0/.

use warnings;
use strict;

use English;
use Encode;
use File::Basename;
use JSON::XS;

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;

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

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 defined $USE_LOCAL or $USE_LOCAL == 0) {
        # 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 $length = 4096;
        my $line;
        my $total_read = 0;

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

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

            $total_read += $ret;

            if ($ret == 0) {
                print "input  ded?\n";
                print "got buffer [$buffer]\n";
                exit;
            }

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

            if ($buffer =~ s/\s*:end:\s*$//m) {
                $line = $buffer;
                $buffer = "";
                $total_read = 0;
            } else {
                next;
            }

            chomp $line;

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

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

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

            print "Attempting compile [$compile_in->{lang}] ...\n";

            use Data::Dumper;
            print Dumper $compile_in;

            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;

                my $result = interpret(%$compile_in);

                $GID = 0;
                $UID = 0;

                my $compile_out = { result => $result };
                my $json = encode_json($compile_out);

                print "Done compiling; result: [$result] [$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;
            }

            if(not defined $USE_LOCAL or $USE_LOCAL == 0) {
                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}};

    chdir("/home/$USERNAME");

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

    $mod->preprocess;

    #    print "after preprocess: ", Dumper $mod, "\n";

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

    # print "after postprocess: ", Dumper $mod, "\n";

    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;