Bring in new seccomp code

.gitmodules

@@ -1,6 +1,6 @@
 [submodule "jail"]
 	path = jail_root
-	url = https://github.com/simcop2387/perlbot-jail
+	url = https://github.com/perlbot/perlbot-jail
 [submodule "wiki"]
 	path = wiki
 	url = https://github.com/perlbot/perlbuut.wiki.git

lib/EvalServer/Seccomp.pm

@@ -0,0 +1,338 @@
+package EvalServer::Seccomp;
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+use List::Util qw/reduce uniq/;
+use Moo;
+use Sys::Linux::Unshare qw/:consts/;
+use POSIX;
+use Linux::Seccomp;
+use Carp qw/croak/;
+
+has exec_map => (is => 'ro', default => sub {
+  # TODO this should actually end up in eval.pl specifically.
+    return {
+     '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'},
+     'perl5.8' =>  {bin => '/perl5/perlbrew/perls/perl-5.8.9/bin/perl'},
+     'perl5.10' => {bin => '/perl5/perlbrew/perls/perl-5.10.1/bin/perl'},
+     'perl5.12' => {bin => '/perl5/perlbrew/perls/perl-5.12.5/bin/perl'},
+     'perl5.14' => {bin => '/perl5/perlbrew/perls/perl-5.14.4/bin/perl'},
+     'perl5.16' => {bin => '/perl5/perlbrew/perls/perl-5.16.3/bin/perl'},
+     'perl5.18' => {bin => '/perl5/perlbrew/perls/perl-5.18.4/bin/perl'},
+     'perl5.20' => {bin => '/perl5/perlbrew/perls/perl-5.20.3/bin/perl'},
+     'perl5.22' => {bin => '/perl5/perlbrew/perls/perl-5.22.3/bin/perl'},
+     'perl5.24' => {bin => '/perl5/perlbrew/perls/perl-5.24.0/bin/perl'},
+     'ruby'     => {bin => '/usr/bin/ruby2.1'},
+    };
+  });
+
+has profiles => (is => 'ro'); # aref
+
+has _rules => (is => 'rw');
+
+has seccomp => (is => 'ro', default => sub {Linux::Seccomp->new(SCMP_ACT_KILL)});
+has _permutes => (is => 'ro', default => sub {+{}});
+has _used_sets => (is => 'ro', default => sub {+{}});
+
+has _finalized => (is => 'rw', default => 0); # TODO make this set once
+
+# Define some more open modes that POSIX doesn't have for us.
+my ($O_DIRECTORY, $O_CLOEXEC, $O_NOCTTY, $O_NOFOLLOW) = (00200000, 02000000, 00000400, 00400000);
+
+# TODO this needs some accessors to make it easier to define rulesets
+our %rule_sets = (
+  default => {
+    include => ['time_calls', 'file_readonly', 'stdio', 'exec_wrapper', 'file_write', 'file_tty'],
+    rules => [{syscall => 'mmap'},
+              {syscall => 'munmap'},
+              {syscall => 'mremap'},
+              {syscall => 'mprotect'},
+              {syscall => 'brk'},
+
+              {syscall => 'exit'},
+              {syscall => 'exit_group'},
+              {syscall => 'rt_sigaction'},
+              {syscall => 'rt_sigprocmask'},
+
+              {syscall => 'getuid'},
+              {syscall => 'geteuid'},
+              {syscall => 'getcwd'},
+              {syscall => 'getpid'},
+              {syscall => 'getgid'},
+              {syscall => 'getegid'},
+              {syscall => 'getgroups'},
+    
+              {syscall => 'access'}, # file_* instead?
+              {syscall => 'readlink'},
+              
+              {syscall => 'arch_prctl'},
+              {syscall => 'set_tid_address'},
+              {syscall => 'set_robust_list'},
+              {syscall => 'futex'},
+              {syscall => 'getrlimit'},
+    ],
+  },
+
+  perm_test => {
+    permute => {foo => [1, 2, 3], bar => [4, 5, 6]},
+    rules => [{syscall => 'permme', permute_rules => [[0, '==', \'foo'], [1, '==', \'bar']]}]
+  },
+
+  # File related stuff
+  stdio => {
+    rules => [{syscall => 'read', rules => [[qw|0 == 0|]]},  # STDIN
+              {syscall => 'write', rules => [[qw|0 == 1|]]}, # STDOUT
+              {syscall => 'write', rules => [[qw|0 == 2|]]},
+              ],
+  },
+  file_open => {
+    rules => [{syscall => 'open',   permute_rules => [['1', '==', \'open_modes']]}, 
+              {syscall => 'openat', permute_rules => [['2', '==', \'open_modes']]},
+              {syscall => 'close'},
+              {syscall => 'select'},
+              {syscall => 'read'},
+              {syscall => 'lseek'},
+              {syscall => 'fstat'}, # default? not file_open?
+              {syscall => 'stat'},
+              {syscall => 'lstat'},
+              {syscall => 'fcntl'},
+              # 4352  ioctl(4, TCGETS, 0x7ffd10963820)  = -1 ENOTTY (Inappropriate ioctl for device)
+              # This happens on opened files for some reason? wtf
+              {syscall => 'ioctl', rules =>[[1, '==', 0x5401]]},
+              ],
+  },
+  file_opendir => {
+    permute => {open_modes => [$O_DIRECTORY]},
+    rules => [{syscall => 'getdents'}],
+    include => ['file_open'],
+  },
+  file_tty => {
+    permute => {open_modes => [$O_NOCTTY, ]},
+    include => ['file_open'],
+  },
+  file_readonly => { 
+    permute => {open_modes => [&POSIX::O_NONBLOCK, &POSIX::O_EXCL, &POSIX::O_RDONLY, $O_NOFOLLOW, $O_CLOEXEC]},
+    include => ['file_open'],
+  },
+  file_write => {
+    permute => {open_modes => [&POSIX::O_CREAT,&POSIX::O_WRONLY, &POSIX::O_TRUNC, &POSIX::O_RDWR]},
+    rules => [{syscall => 'write'}],
+    include => ['file_open', 'file_readonly'],
+  },
+
+  # time related stuff
+  time_calls => {
+    rules => [
+      {syscall => 'nanosleep'},
+      {syscall => 'clock_gettime'},
+      {syscall => 'clock_getres'},
+    ],
+  },
+
+  # ruby timer threads
+  ruby_timer_thread => {
+#    permute => {clone_flags => []},
+    rules => [
+      {syscall => 'clone', rules => [[0, '==', CLONE_VM|CLONE_FS|CLONE_FILES|CLONE_SIGHAND|CLONE_THREAD|CLONE_SYSVSEM|CLONE_SETTLS|CLONE_PARENT_SETTID|CLONE_CHILD_CLEARTID]]},
+
+      # Only allow a new signal stack context to be created, and only with a size of 8192 bytes.  exactly what ruby does
+      # Have to allow it to be blind since i can't inspect inside the struct passed to it :(  I'm not sure how i feel about this one
+      {syscall => 'sigaltstack', }, #=> rules [[1, '==', 0], [2, '==', 8192]]},
+      {syscall => 'pipe2', },
+    ],
+  },
+
+  # perl module specific
+  perlmod_file_temp => {
+    rules => [
+      {syscall => 'chmod', rules => [[1, '==', 0600]]},
+      {syscall => 'unlink', },
+      ],
+  },
+
+  # exec wrapper
+  exec_wrapper => {
+    # we have to generate these at runtime, we can't know ahead of time what they will be
+    rules => sub {
+        my $seccomp = shift;
+        my $strptr = sub {unpack "Q", pack("p", $_[0])};
+        my @rules;
+
+        my $exec_map = $seccomp->exec_map;
+
+        for my $version (keys %$exec_map) {
+          push @rules, {syscall => 'execve', rules => [[0, '==', $strptr->($exec_map->{$version}{bin})]]};
+        }
+
+        return @rules;
+      }, # sub returns a valid arrayref.  given our $self as first arg.
+  },
+
+  # language master rules
+  lang_perl => {
+    rules => [],
+    include => ['default', 'perlmod_file_temp'],
+  },
+
+  lang_ruby => {
+    rules => [
+      # Thread IPC writes, these might not be fixed but I don't know how to detect them otherwise 
+      {syscall => 'write', rules => [[0, '==', 5]]},
+      {syscall => 'write', rules => [[0, '==', 7]]},
+    ],
+    include => ['default', 'ruby_timer_thread'],
+  },
+);
+
+sub rule_add {
+  my ($self, $name, @rules) = @_;
+
+  $self->seccomp->rule_add(SCMP_ACT_ALLOW, Linux::Seccomp::syscall_resolve_name($name), @rules);
+}
+
+sub _rec_get_rules {
+  my ($self, $profile) = @_;
+
+  return () if ($self->_used_sets->{$profile});
+  $self->_used_sets->{$profile} = 1;
+
+  croak "Rule set $profile not found" unless exists $rule_sets{$profile};
+
+  my @rules;
+  #print "getting profile $profile\n";
+
+  if (ref $rule_sets{$profile}{rules} eq 'ARRAY') {
+    push @rules, @{$rule_sets{$profile}{rules}};
+  } elsif (ref $rule_sets{$profile}{rules} eq 'CODE') {
+    my @sub_rules = $rule_sets{$profile}{rules}->($self);
+    push @rules, @sub_rules;
+  } elsif (!exists $rule_sets{$profile}{rules}) { # ignore it if missing
+  } else {
+    croak "Rule set $profile defines an invalid set of rules";
+  }
+  
+  for my $perm (keys %{$rule_sets{$profile}{permute} // +{}}) {
+    push @{$self->_permutes->{$perm}}, @{$rule_sets{$profile}{permute}{$perm}};
+  }
+
+  for my $include (@{$rule_sets{$profile}{include}//[]}) {
+    push @rules, $self->_rec_get_rules($include);
+  }
+
+  return @rules;
+}
+
+sub build_seccomp {
+  my ($self) = @_;
+
+  croak "build_seccomp called more than once" if ($self->_finalized);
+
+  my %gathered_rules; # computed rules
+
+  for my $profile (@{$self->profiles}) {
+    my @rules = $self->_rec_get_rules($profile);
+
+    for my $rule (@rules) {
+      my $syscall = $rule->{syscall};
+      push @{$gathered_rules{$syscall}}, $rule;
+    }
+  }
+
+  # optimize phase
+  my %full_permute;
+  for my $permute (keys %{$self->_permutes}) {
+    my @modes = @{$self->_permutes->{$permute}} = sort {$a <=> $b} uniq @{$self->_permutes->{$permute}};
+
+    # Produce every bitpattern for this permutation
+    for my $b (1..(2**@modes) - 1) {
+      my $q = 1;
+      my $mode = 0;
+      #printf "%04b: ", $b;
+      do {
+        if ($q & $b) {
+          my $r = int(log($q)/log(2)+0.5); # get the thing
+
+          $mode |= $modes[$r];
+
+          #print "$r";
+        }
+        $q <<= 1;
+      } while ($q <= $b);
+
+      push @{$full_permute{$permute}}, $mode;
+    }
+  }
+
+  for my $k (keys %full_permute) {
+  @{$full_permute{$k}} = sort {$a <=> $b} uniq @{$full_permute{$k}} 
+  }
+
+
+  my %comp_rules;
+
+  for my $syscall (keys %gathered_rules) {
+    my @rules = @{$gathered_rules{$syscall}};
+    for my $rule (@rules) {
+      my $syscall = $rule->{syscall};
+
+      if (exists ($rule->{permute_rules})) {
+        my @perm_on = ();
+        for my $prule (@{$rule->{permute_rules}}) {
+          if (ref $prule->[2]) {
+            push @perm_on, ${$prule->[2]};
+          }
+          if (ref $prule->[0]) {
+            croak "Permuation on argument number not supported using $syscall";
+          }
+        }
+
+        croak "Permutation on syscall rule without actual permutation specified" if (!@perm_on);
+
+        my $glob_string = join '__', map { "{".join(",", @{$full_permute{$_}})."}" } @perm_on;
+        for my $g_value (glob $glob_string) {
+          my %pvals;
+          @pvals{@perm_on} = split /__/, $g_value;
+
+
+          push @{$comp_rules{$syscall}}, 
+            [map {
+              my @r = @$_;
+              $r[2] = $pvals{${$r[2]}};
+              \@r;
+            } @{$rule->{permute_rules}}];
+        }
+      } elsif (exists ($rule->{rules})) {
+        push @{$comp_rules{$syscall}}, $rule->{rules};
+      } else {
+        push @{$comp_rules{$syscall}}, [];
+      }
+    }
+  }
+
+  # TODO optimize for permissive rules
+  # e.g. write => OR write => [0, '==', 1] OR write => [0, '==', 2] becomes write =>
+  for my $syscall (keys %comp_rules) {
+    for my $rule (@{$comp_rules{$syscall}}) {
+      $self->rule_add($syscall, @$rule);
+    }
+  }
+
+  $self->_finalized(1);
+}
+
+sub apply_seccomp {
+  my $self = shift;
+  $self->seccomp->load;
+}
+
+sub engage {
+  my $self = shift;
+  $self->build_seccomp();
+  $self->apply_seccomp();
+}
+
+1;

lib/eval.pl

@@ -2,6 +2,7 @@
 
 #use lib '/home/ryan/perl5/lib/perl5/i686-linux';
 #use lib '/home/ryan/perl5/lib/perl5';
+use lib '/eval/elib';
 
 use strict;
 use Data::Dumper;
@@ -17,6 +18,7 @@ use FindBin;
 use Encode qw/encode decode/;
 use IO::String;
 use File::Slurper qw/read_text/;
+use EvalServer::Seccomp;
 
 # Easter eggs
 do {package Tony::Robbins; sub import {die "Tony Robbins hungry: https://www.youtube.com/watch?v=GZXp7r_PP-w\n"}; $INC{"Tony/Robbins.pm"}=1};
@@ -72,129 +74,6 @@ my %exec_map = (
    'ruby'     => {bin => '/usr/bin/ruby2.1'},
 );
 
-sub get_seccomp {
-    my $lang = shift;
-    use Linux::Seccomp ;
-    my $seccomp = Linux::Seccomp->new(SCMP_ACT_KILL);
-    ##### set seccomp
-    #
-    # Rules should only allow:
-    # 1. open as read
-    # 2. write to stderr/stdout
-    # 3. exit
-    # 4. close file handle
-    # 5. random syscall
-    # 6. read
-    # 7. seek
-# 8. fstat/fcntl
-# 9. brk
-# 10.
-
-    my $rule_add = sub {
-        my $name = shift;
-        $seccomp->rule_add(SCMP_ACT_ALLOW, Linux::Seccomp::syscall_resolve_name($name), @_);
-    };
-
-    my $strptr = sub {unpack "Q", pack("p", $_[0])};
-
-    $rule_add->(write =>); # TBD!
-    $rule_add->(write => [0, '==', 2]); # STDERR
-    $rule_add->(write => [0, '==', 1]); # STDOUT
-
-    # Added for Ruby.  Not sure if keeping
-    if ($lang eq 'ruby') { # ruby opens up some pipes to communicate between threads that it must have
-      $rule_add->(write => [0, '==', 5]);
-      $rule_add->(write => [0, '==', 7]);
-
-      # clone(child_stack=0x7ff62036cff0, flags=CLONE_VM|CLONE_FS|CLONE_FILES|CLONE_SIGHAND|CLONE_THREAD|CLONE_SYSVSEM|CLONE_SETTLS|CLONE_PARENT_SETTID|CLONE_CHILD_CLEARTID, parent_tidptr=0x7ff62036d9d0, tls=0x7ff62036d700, child_tidptr=0x7ff62036d9d0) = 8055
-
-      # magic number extracted via
-      ## #include <stdio.h>
-      ## #include <linux/sched.h>
-      ## 
-      ## int main(char **argv, int argc) {
-      ##     printf("%08X\n", CLONE_VM|CLONE_FS|CLONE_FILES|CLONE_SIGHAND|CLONE_THREAD|CLONE_SYSVSEM|CLONE_SETTLS|CLONE_PARENT_SETTID|CLONE_CHILD_CLEARTID);
-      ## }
-
-      my $thread_mode = 0x003D0F00; 
-      $rule_add->(clone => [0, '==', $thread_mode]);
-
-      # Only allow a new signal stack context to be created, and only with a size of 8192 bytes.  exactly what ruby does
-      # Have to allow it to be blind since i can't inspect inside the struct passed to it :(  I'm not sure how i feel about this one
-      $rule_add->(sigaltstack =>);# [1, '==', 0], [2, '==', 8192]);
-      $rule_add->(pipe2 =>);
-    }
-
-    #mmap(NULL, 2112544, PROT_READ|PROT_EXEC, MAP_PRIVATE|MAP_DENYWRITE, 7, 0) = 0x7efedad0e000
-    #mprotect(0x7efedad12000, 2093056, PROT_NONE) = 0
-    #mmap(0x7efedaf11000, 4096, PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_FIXED|MAP_DENYWRITE, 7, 0x3000) = 0x7efedaf11000
-    ## MMAP? I don't know what it's being used for exactly.  I'll leave it out and see what happens
-    # Used when loading executable code.  Might need to figure out what to do to make it more secure?
-    # also seems to be used when freeing/allocating large blocks of memory, as you'd expect
-    $rule_add->(mmap => );
-    $rule_add->(munmap => );
-    $rule_add->(mremap => );
-    $rule_add->(mprotect =>);
-
-    # Enable us to run other perl binaries
-    for my $version (keys %exec_map) {
-      $rule_add->(execve => [0, '==', $strptr->($exec_map{$version}{bin})]);
-    }
-    $rule_add->(access => );
-    $rule_add->(arch_prctl => );
-    $rule_add->(readlink => );
-    $rule_add->(getpid => );
-    
-    $rule_add->(set_tid_address => ); # needed for perl >= 5.20
-    $rule_add->(set_robust_list => );
-    $rule_add->(futex => );
-    
-    # Allow select, might need to have some kind of restriction on it?  probably fine
-    $rule_add->(select => );
-
-    $rule_add->(chmod => [1, '==', 0600]);
-    $rule_add->(unlink => );
-
-    # These are the allowed modes on open, allow that to work in any combo
-    my ($O_DIRECTORY, $O_CLOEXEC, $O_NOCTTY, $O_NOFOLLOW) = (00200000, 02000000, 00000400, 00400000);
-    my @allowed_open_modes = (&POSIX::O_RDONLY, &POSIX::O_NONBLOCK, $O_DIRECTORY, $O_CLOEXEC, $O_NOCTTY, &POSIX::O_CREAT, &POSIX::O_EXCL, &POSIX::O_WRONLY, &POSIX::O_TRUNC, $O_NOFOLLOW, &POSIX::O_RDWR);
-
-    # this annoying bitch of code is because Algorithm::Permute doesn't work with newer perls
-    # Also this ends up more efficient.  We skip 0 because it's redundant
-    for my $b (1..(2**@allowed_open_modes) - 1) {
-      my $q = 1;
-      my $mode = 0;
-      #printf "%04b: ", $b;
-      do {
-        if ($q & $b) {
-          my $r = int(log($q)/log(2)+0.5); # get the thing
-
-          $mode |= $allowed_open_modes[$r];
-
-          #print "$r";
-        }
-        $q <<= 1;
-      } while ($q <= $b);
-
-      $rule_add->(open => [1, '==', $mode]);
-      $rule_add->(openat => [2, '==', $mode]);
-      #print " => $mode\n";
-    }
-
-    # 4352  ioctl(4, TCGETS, 0x7ffd10963820)  = -1 ENOTTY (Inappropriate ioctl for device)
-    $rule_add->(ioctl => [1, '==', 0x5401]); # This happens on opened files for some reason? wtf
-
-
-
-    my @blind_syscalls = qw/read exit exit_group brk lseek fstat fcntl stat rt_sigaction rt_sigprocmask geteuid getuid getcwd close getdents getgid getegid getgroups lstat nanosleep getrlimit clock_gettime clock_getres/;
-
-    for my $syscall (@blind_syscalls) {
-        $rule_add->($syscall);
-    }
-
-    $seccomp->load unless -e './noseccomp';
-}
-
 no warnings;
 
 # This sub is defined here so that it is defined before the 'use charnames'
@@ -329,6 +208,9 @@ use Storable qw/nfreeze/; nfreeze([]); #Preload Nfreeze since it's loaded on dem
   };
   
   my $code = do {local $/; <STDIN>};
+  # Chomp code..
+	$code =~ s/\s*$//;
+
   # redirect STDIN to /dev/null, to avoid warnings in convoluted cases.
   # we have to leave this open for perl4, so only do this for other systems
   open STDIN, '<', '/dev/null' or die "Can't open /dev/null: $!";
@@ -405,10 +287,10 @@ use Storable qw/nfreeze/; nfreeze([]); #Preload Nfreeze since it's loaded on dem
 	# close STDIN;
 
   # Setup SECCOMP for us
-  get_seccomp($type);
+  my ($profile) = ($type =~ /^(\w+)/g);
-	# Chomp code..
+  my $esc = EvalServer::Seccomp->new(profiles => ["lang_$profile"]);
-	$code =~ s/\s*$//;
+  $esc->engage();
-
+	
 	# Choose which type of evaluation to perform
 	# will probably be a dispatch table soon.
 	if( $type eq 'perl' or $type eq 'pl' ) {