From aab4315a6f20b72ab39d1556d068372cbf941e72 Mon Sep 17 00:00:00 2001 From: Ryan Voots Date: Sun, 28 May 2017 15:42:10 -0400 Subject: [PATCH] Starting setup of new evalserver --- bin/testeval.sh | 35 +++++++- lib/EvalServer/Seccomp.pm | 4 +- lib/eval.pl | 4 +- plugins/eval.pm | 2 +- plugins/supereval.pm | 168 ++++++++++++++++++++++++++++++++++++++ 5 files changed, 209 insertions(+), 4 deletions(-) create mode 100644 plugins/supereval.pm diff --git a/bin/testeval.sh b/bin/testeval.sh index b8e9785..727911e 100755 --- a/bin/testeval.sh +++ b/bin/testeval.sh @@ -1,7 +1,40 @@ #!/bin/bash read -r -d '' CODE <<'EOC' -javascript console.log("Hello World"); +perl +use strict; +use warnings; + +use Test::More; +use Test::Deep qw(:v1 cmp_details deep_diag); + +{ + package ClassA; + + sub new { bless {}, shift } + + sub values { + foo => 1, + bar => 2, + baz => 3, + } +} + +my $obj = ClassA->new; + +cmp_deeply $obj, listmethods( + values => code(sub { + my ($it) = @_; + my ($ok, $stack) = cmp_details { @$it }, { + foo => 1, + bar => 2, + baz => 3, + }; + $ok || (0, deep_diag $stack) + }), +); + +done_testing; EOC echo -------- diff --git a/lib/EvalServer/Seccomp.pm b/lib/EvalServer/Seccomp.pm index 8128622..5438a8a 100644 --- a/lib/EvalServer/Seccomp.pm +++ b/lib/EvalServer/Seccomp.pm @@ -193,7 +193,9 @@ our %rule_sets = ( # language master rules lang_perl => { - rules => [], + rules => [ + {syscall => 'dup'} + ], include => ['default'], }, diff --git a/lib/eval.pl b/lib/eval.pl index 06afcff..4d633de 100755 --- a/lib/eval.pl +++ b/lib/eval.pl @@ -61,6 +61,8 @@ $|++; my %exec_map = ( 'perl1' => {bin => '/langs/perl-1.0.16/bin/perl'}, + 'perl2' => {bin => '/langs/perl2/bin/perl'}, + 'perl3' => {bin => '/langs/perl3/bin/perl'}, 'perl4' => {bin => '/perl5/perlbrew/perls/perl-4.036/bin/perl'}, 'perl5.5' => {bin => '/perl5/perlbrew/perls/perl-5.005_04/bin/perl'}, 'perl5.6' => {bin => '/perl5/perlbrew/perls/perl-5.6.2/bin/perl'}, @@ -409,7 +411,7 @@ Biqsip biqsip 'ugh chan ghitlh lursa' nuh bey' ngun petaq qeng soj tlhej waqboch } '; - unless ($version eq '4' || $version eq '1') { + unless ($version eq '4' || $version eq '1' || $version eq '2' || $version eq '3') { exec($exec_map{'perl'.$version}{bin}, '-e', $wrapper) or die "Exec failed $!"; } else { exec($exec_map{'perl'.$version}{bin}, '-e', $code); # the code for perl4 is actually still in STDIN, if we try to -e it needs to write files diff --git a/plugins/eval.pm b/plugins/eval.pm index df8daf2..cadb61a 100644 --- a/plugins/eval.pm +++ b/plugins/eval.pm @@ -11,7 +11,7 @@ use strict; no warnings 'void'; -my @versions = ('', qw(1 4 5.5 5.6 5.8 5.10 5.12 5.14 5.16 5.18 5.20 5.22 5.24 all)); +my @versions = ('', qw(1 2 3 4 5.5 5.6 5.8 5.10 5.12 5.14 5.16 5.18 5.20 5.22 5.24 all)); sub new { my( $class ) = @_; diff --git a/plugins/supereval.pm b/plugins/supereval.pm new file mode 100644 index 0000000..81aa3ff --- /dev/null +++ b/plugins/supereval.pm @@ -0,0 +1,168 @@ +# eval plugin for buubot3 +package Bot::BB3::Plugin::Supereval; + +use POE::Filter::Reference; +use IO::Socket::INET; +use Data::Dumper; +use App::EvalServerAdvanced::Protocol; +use Encode; +use strict; + +no warnings 'void'; + +my @versions = ('', qw(1 2 3 4 5.5 5.6 5.8 5.10 5.12 5.14 5.16 5.18 5.20 5.22 5.24 all)); + +sub new { + my( $class ) = @_; + + my $self = bless {}, $class; + $self->{name} = 'supereval'; + $self->{opts} = { + command => 1, + }; + + my @perl_aliases = map {("Xeval$_", "wXeval$_", "sXeval$_", "wsXeval$_", "swXeval$_")} @versions; + + $self->{aliases} = [ qw/Xpleval Xperleval Xdeparse/, @perl_aliases ]; + $self->{dbh} = DBI->connect("dbi:SQLite:dbname=var/evallogs.db"); + + return $self; +} + +sub command { + my( $self, $said, $pm ) = @_; + + my $code = $said->{"body"}; + + my $command = $said->{command_match}; + my $type = $said->{command_match}; + $type =~ s/^\s*(\w+?)?Xeval(.*)?/$1$2/; + warn "Initial type: $type\n"; + + my %translations = ( + js => 'javascript', + perl => 'perl', + pl => 'perl', + php => 'php', + deparse => 'deparse', + 'k20' => 'k20', + 'k' => 'k20', + 'rb' => 'ruby', + 'ruby' => 'ruby', + 'py' => 'python', + 'python' => 'python', + 'lua' => 'lua', + 'j' => 'j', + 'w' => 'perl', + 's' => 'perl', + 'ws' => 'perl', + 'sw' => 'perl', + map {($_=>"perl$_", "w$_"=>"perl$_", "s$_" => "perl$_", "ws$_"=>"perl$_", "sw$_"=>"perl$_")} @versions + ); + + my $orig_type = $type; + $type = $translations{$type}; + if( not $type ) { $type = 'perl'; } + warn "Found $type: $code"; + + if ($command =~ /^([ws]+)?Xeval/i) { + my $c=$1; + $code = "use warnings; ".$code if ($c =~ /w/); + $code = "use strict; ".$code if ($c =~ /s/); + } + + $code =~ s/␤/\n/g; + + my $resultstr=''; + + unless ($type =~ /perlall/) { + $resultstr = $self->do_singleeval($type, $code); + } else { + # TODO use channel config for this + if ($said->{channel} eq '#perlbot' || $said->{channel} eq '*irc_msg') { + $resultstr = $self->do_multieval([map {"perl".$_} @versions], $code); + } else { + $resultstr = "evalall only works in /msg or in #perlbot"; + } + } + + + if (!$said->{captured} && $resultstr !~ /\S/) { + $resultstr = "No output."; + } + + if ($type eq 'perl') { + $self->{dbh}->do("INSERT INTO evals (input, output) VALUES (?, ?)", {}, $code, $resultstr); + } + + + return( 'handled', $resultstr); +} + +sub do_multieval { + my ($self, $types, $code) = @_; + + + my $socket = IO::Socket::INET->new( PeerAddr => 'localhost', PeerPort => '14401' ) + or die "error: cannot connect to eval server"; + + my $seq = 1; + my $output = ''; + + for my $type (@$types) { + my $eval_obj = {language => $type, files => [{filename => '__code', contents => $code}], prio => {pr_batch=>{}}, sequence => $seq++}; + print $socket encode_message(eval => $eval_obj); + my $message = $self->read_message($socket); + $output .= sprintf "[[ %s ]]\n%s\n", $type, $message->contents; + } + + + return $output; +} + +sub do_singleeval { + my ($self, $type, $code) = @_; + + my $socket = IO::Socket::INET->new( PeerAddr => 'localhost', PeerPort => '14401' ) + or die "error: cannot connect to eval server"; + + my $eval_obj = {language => $type, files => [{filename => '__code', contents => $code}], prio => {pr_realtime=>{}}, sequence => 1}; + + $socket->autoflush(); + print $socket encode_message(eval => $eval_obj); + + my $buf = ''; + my $data = ''; + my $resultstr = "Failed to read a message"; + + my $message = $self->read_message($socket); + + return $message->contents; +} + +sub read_message { + my ($self, $socket) = @_; + + my $header; + $socket->read($header, 8) or die "Couldn't read from socket"; + + my ($reserved, $length) = unpack "NN", $header; + + die "Invalid packet" unless $reserved == 0; + + my $buffer; + $socket->read($buffer, $length) or die "Couldn't read from socket2"; + + my ($res, $message, $nbuf) = decode_message($header . $buffer); + + + die "Data left over in buffer" unless $nbuf eq ''; + die "Couldn't decode packet" unless $res; + + return $message; +} + +"Bot::BB3::Plugin::Supereval"; + +__DATA__ +The eval plugin. Evaluates various different languages. Syntax, eval: code; also pleval deparse. You can use different perl versions by doing eval5.X, e.g. eval5.5: print "$]"; You can also add s or w to the eval to quickly add strict or warnings. sweval: print $foo;