Commit | Line | Data |
03ae33ef |
1 | #!/usr/bin/env perl |
2 | |
3 | use strictures 1; |
4 | use JSON::PP qw(encode_json decode_json); |
5 | use Eval::WithLexicals; |
6 | use Data::Dumper::Concise; |
7 | use IO::Handle; |
8 | |
4d5b62fa |
9 | our $DEBUG; |
10 | |
03ae33ef |
11 | STDOUT->autoflush(1); |
12 | |
13 | my $eval = Eval::WithLexicals->new; |
14 | |
15 | sub out { |
4d5b62fa |
16 | warn "sending: ".encode_json([ @_ ])."\n" if $DEBUG; |
03ae33ef |
17 | print STDOUT encode_json([ @_ ])."\n" |
18 | or die "Failed to print to STDOUT: $!"; |
19 | } |
20 | |
21 | sub run_eval { |
22 | my ($perl) = @_; |
23 | unless ($perl) { |
24 | out(MISTAKE => eval_input => "No code supplied"); |
25 | return; |
26 | } |
27 | if (my $ref = ref($perl)) { |
28 | out(MISTAKE => eval_input => "Code was a ${ref} reference"); |
29 | return; |
30 | } |
31 | my ($code, @ret); |
32 | open my $stdout, '>', \my $output; |
33 | open my $stderr, '>', \my $errors; |
34 | if (eval { |
35 | local *STDOUT = $stdout; |
36 | local *STDERR = $stderr; |
37 | @ret = $eval->eval($perl); |
38 | 1 |
39 | }) { |
40 | $code = 'OK'; |
41 | } else { |
42 | ($code, @ret) = (FAILURE => $@); |
43 | } |
44 | my $dumped_ret; |
45 | unless (eval { $dumped_ret = Dumper(@ret); 1 }) { |
46 | $dumped_ret = "Error dumping ${code} result: $@"; |
47 | $code = 'FAILURE'; |
48 | } |
49 | out($code => { stdout => $output, stderr => $errors, return => $dumped_ret }); |
50 | } |
51 | |
4d5b62fa |
52 | warn "starting\n" if $DEBUG; |
53 | |
03ae33ef |
54 | while (my $line = <STDIN>) { |
4d5b62fa |
55 | warn "got: $line" if $DEBUG; |
03ae33ef |
56 | my $data = eval { decode_json($line) }; |
57 | if ($@) { |
58 | out(MISTAKE => invalid_json => $@); |
59 | next; |
60 | } |
61 | unless (ref($data) eq 'ARRAY') { |
62 | out(MISTAKE => message_format => "Not an ARRAY"); |
63 | next; |
64 | } |
65 | unless (@$data > 0) { |
66 | out(MISTAKE => message_format => "No message name"); |
67 | next; |
68 | } |
69 | if (my $ref = ref($data->[0])) { |
70 | out(MISTAKE => message_format => "Message name was a ${ref} ref"); |
71 | next; |
72 | } |
73 | my ($message, @args) = @{$data}; |
74 | if ($message eq 'EXIT') { |
75 | exit 0; |
76 | } elsif ($message eq 'EVAL') { |
77 | run_eval(@args); |
78 | } else { |
79 | out(MISTAKE => message_name => "Unknown message"); |
80 | } |
81 | } |