view release on metacpan or  search on metacpan

lib/App/EvalServerAdvanced/Sandbox.pm  view on Meta::CPAN

package App::EvalServerAdvanced::Sandbox;
our $VERSION = '0.024';

use strict;
use warnings;

use Config;
use Sys::Linux::Namespace;
use Sys::Linux::Mount qw/:all/;
use Path::Tiny qw/path/;
use BSD::Resource;
use Unix::Mknod qw/makedev mknod/;
use Fcntl qw/:mode/;

use App::EvalServerAdvanced::Log;
use App::EvalServerAdvanced::Config;
use App::EvalServerAdvanced::Sandbox::Internal;
use App::EvalServerAdvanced::Seccomp;
use POSIX qw/_exit/;
use Data::Dumper;
use Sys::Linux::Syscall::Execve qw/execve_byref/;

my %sig_map;
do {
  my @sig_names = split ' ', $Config{sig_name};
  my @sig_nums = split ' ', $Config{sig_num};
  @sig_map{@sig_nums} = map {'SIG' . $_} @sig_names;
  $sig_map{31} = "SIGSYS (Illegal Syscall)";
};

my $namespace = Sys::Linux::Namespace->new(private_pid => 1, no_proc => 1, private_mount => 1, private_uts => 1,  private_ipc => 0, private_sysvsem => 1);

sub _rel2abs {
  my $base = config->sandbox->mount_base;
  die "sandbox.mount_base must be set" unless defined $base;
  my $p = shift;
  if ($p !~ m|^/|) {
    $p = path("$base/$p")->realpath;
  }
  return "".$p
}

my $seccomp;

sub run_eval {
  my $code = shift; # TODO this should be more than just code
  my $language = shift;
  my $files = shift;
  my $work_path = Path::Tiny->tempdir("eval-XXXXXXXX");

  $|++;

  chmod(0555, $work_path); # have to fix permissions on the new / or nobody can do anything!

  unless ($seccomp) {
    App::EvalServerAdvanced::Sandbox::Internal->load_plugins();
    $seccomp = App::EvalServerAdvanced::Seccomp->new();
    $seccomp->load_yaml(config->sandbox->seccomp->yaml); # TODO allow multiple yamls
    $seccomp->build_seccomp;
  }

  my @binds = config->sandbox->bind_mounts->@*;

  # Setup SECCOMP for us
  my $lang_config = config->language->$language;
  die "Language $language not configured." unless $lang_config;

  my $profile = $lang_config->seccomp_profile // "default";

	# Get the nobody uid before we chroot, namespace and do other funky stuff.
	my $nobody_uid = getpwnam("nobody");
	die "Error, can't find a uid for 'nobody'. Replace with someone who exists" unless $nobody_uid;

  my $exitcode = $namespace->run(code => sub {
    delete $SIG{CHLD};
    select(STDERR);
    $|++;
    select(STDOUT);
    $|++;
    binmode STDOUT, ":encoding(utf8)"; # Enable utf8 output.