mirror of
				https://github.com/pragma-/pbot.git
				synced 2025-11-04 08:37:24 +01:00 
			
		
		
		
	* VM scripts can now be configured via environment variables: PBOTVM_DOMAIN, PBOTVM_TIMEOUT, PBOTVM_SERVER, PBOTVM_SERIAL, PBOTVM_HEART, PBOTVM_NOREVERT
		
			
				
	
	
		
			53 lines
		
	
	
		
			1.1 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			53 lines
		
	
	
		
			1.1 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
#!/usr/bin/env perl
 | 
						|
 | 
						|
# File: vm-client
 | 
						|
#
 | 
						|
# Purpose: Interfaces with the PBot virtual machine server hosted at
 | 
						|
# PeerAddr/PeerPort defined below. This allows us to host instances of
 | 
						|
# virtual machines on remote servers.
 | 
						|
#
 | 
						|
# This script is intended to be installed to PBot's applets directory
 | 
						|
# and attached to a PBot command such as `cc`.
 | 
						|
 | 
						|
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
 | 
						|
# SPDX-License-Identifier: MIT
 | 
						|
 | 
						|
# TODO: extend to take a list of server/ports to cycle for load-balancing
 | 
						|
 | 
						|
use warnings;
 | 
						|
use strict;
 | 
						|
 | 
						|
use IO::Socket;
 | 
						|
use JSON::XS;
 | 
						|
 | 
						|
use constant {
 | 
						|
    SERVER_PORT => $ENV{PBOTVM_SERVER} // 9000,
 | 
						|
};
 | 
						|
 | 
						|
my $sock = IO::Socket::INET->new(
 | 
						|
    PeerAddr => '127.0.0.1',
 | 
						|
    PeerPort => SERVER_PORT,
 | 
						|
    Proto    => 'tcp'
 | 
						|
);
 | 
						|
 | 
						|
if (not defined $sock) {
 | 
						|
    print "Fatal error compiling: $!; try again later\n";
 | 
						|
    die $!;
 | 
						|
}
 | 
						|
 | 
						|
my $json = join ' ', @ARGV;
 | 
						|
my $h    = decode_json $json;
 | 
						|
 | 
						|
my $lang = $h->{lang} // "c11";
 | 
						|
 | 
						|
if ($h->{code} =~ s/-lang=([^ ]+)//) { $lang = lc $1; }
 | 
						|
 | 
						|
$h->{lang} = $lang;
 | 
						|
$json = encode_json $h;
 | 
						|
 | 
						|
print $sock "$json\n";
 | 
						|
 | 
						|
while (my $line = <$sock>) { print "$line"; }
 | 
						|
 | 
						|
close $sock;
 |