#!/usr/bin/env perl use strictures 1; use JSON::PP qw(encode_json decode_json); use Eval::WithLexicals; use Data::Dumper::Concise; use IO::Handle; our $DEBUG; STDOUT->autoflush(1); my $eval = Eval::WithLexicals->new; sub out { warn "sending: ".encode_json([ @_ ])."\n" if $DEBUG; print STDOUT encode_json([ @_ ])."\n" or die "Failed to print to STDOUT: $!"; } sub run_eval { my ($perl) = @_; unless ($perl) { out(MISTAKE => eval_input => "No code supplied"); return; } if (my $ref = ref($perl)) { out(MISTAKE => eval_input => "Code was a ${ref} reference"); return; } my ($code, @ret); open my $stdout, '>', \my $output; open my $stderr, '>', \my $errors; if (eval { local *STDOUT = $stdout; local *STDERR = $stderr; @ret = $eval->eval($perl); 1 }) { $code = 'OK'; } else { ($code, @ret) = (FAILURE => $@); } my $dumped_ret; unless (eval { $dumped_ret = Dumper(@ret); 1 }) { $dumped_ret = "Error dumping ${code} result: $@"; $code = 'FAILURE'; } out($code => { stdout => $output, stderr => $errors, return => $dumped_ret }); } warn "starting\n" if $DEBUG; while (my $line = ) { warn "got: $line" if $DEBUG; my $data = eval { decode_json($line) }; if ($@) { out(MISTAKE => invalid_json => $@); next; } unless (ref($data) eq 'ARRAY') { out(MISTAKE => message_format => "Not an ARRAY"); next; } unless (@$data > 0) { out(MISTAKE => message_format => "No message name"); next; } if (my $ref = ref($data->[0])) { out(MISTAKE => message_format => "Message name was a ${ref} ref"); next; } my ($message, @args) = @{$data}; if ($message eq 'EXIT') { exit 0; } elsif ($message eq 'EVAL') { run_eval(@args); } else { out(MISTAKE => message_name => "Unknown message"); } }