Starting setup of new evalserver

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 --------

lib/EvalServer/Seccomp.pm

@@ -193,7 +193,9 @@ our %rule_sets = (
 
   # language master rules
   lang_perl => {
-    rules => [],
+    rules => [
+      {syscall => 'dup'}
+    ],
     include => ['default'],
   },
 

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

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 ) = @_;

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;