view release on metacpan or  search on metacpan

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

}

method build_seccomp() {
  croak "build_seccomp called more than once" if ($self->_finalized);
  $self->_finalized(1);

  for my $profile_key (keys $self->profiles->%*) {
    my $profile_obj = $self->profiles->{$profile_key};

    $self->_used_sets({});
    my @rules = $profile_obj->to_seccomp($self);
    $self->_rendered_profiles->{$profile_key} = \@rules;
  }
}

sub calculate_permutations {
  my ($self) = @_;
  # TODO this is possible to implement with bitwise checks in seccomp, producing fewer rules.  it should be faster, but is more annoying to implement currently

  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 $bit (1..(2**@modes) - 1) {
      my $q = 1;
      my $mode = 0;
      #printf "%04b: ", $b;
      do {
        if ($q & $bit) {
          my $r = int(log($q)/log(2)+0.5); # get the position

          $mode |= $modes[$r];

          #print "$r";
        }
        $q <<= 1;
      } while ($q <= $bit);

      push $full_permute{$permute}->@*, $mode;
    }
  }

  # This originally sorted the values, why? it shouldn't matter.  must have been for easier sanity checking?
  for my $k (keys %full_permute) {
    $full_permute{$k}->@* = uniq $full_permute{$k}->@*
  }

  return \%full_permute;
}

method apply_seccomp($profile_name) {
  # TODO LOAD the rules

  my $seccomp = Linux::Seccomp->new(SCMP_ACT_KILL);

  for my $rule ($self->_rendered_profiles->{$profile_name}->@* ) {
      # TODO make this support raw syscall numbers?
      my $syscall = $rule->{syscall};
      # If it looks like it's not a raw number, try to resolve.
      $syscall = Linux::Seccomp::syscall_resolve_name($syscall) if ($syscall =~ /\D/);
      my @rules = ($rule->{rules}//[])->@*;

      my %actions = (
        ALLOW => SCMP_ACT_ALLOW,
        KILL  => SCMP_ACT_KILL,
        TRAP  => SCMP_ACT_TRAP,
      );

      my $action = $actions{$rule->{action}//""} // SCMP_ACT_ALLOW;

       if ($rule->{action} && $rule->{action} =~ /^\s*ERRNO\((-?\d+)\)\s*$/ ) { # send errno() to the process
         # TODO, support constants? keys from %! maybe? Errno module?
         $action = SCMP_ACT_ERRNO($1 // -1);
       } elsif ($rule->{action} && $rule->{action} =~ /^\s*TRACE\((-?\d+)?\)\s*$/) { # hit ptrace with msgnum
         $action = SCMP_ACT_TRACE($1 // 0);
       }

  #    printf "%s => [%s]\n", $rule->{syscall}, join("", map {sprintf "\n    $_->[0] $_->[1] $_->[2]"} @rules);
      $seccomp->rule_add($action, $syscall, @rules);
  }

  $seccomp->load;
}

method engage($profile_name) {
  $self->build_seccomp();
  $self->apply_seccomp($profile_name);
}

sub load_plugin {
  my ($self, $plugin_name) = @_;

  return $self->_plugins->{$plugin_name} if (exists $self->_plugins->{$plugin_name});

  check_module_name($plugin_name);

  if ($plugin_name !~ /^App::EvalServerAdvanced::Seccomp::Plugin::/) {
    my $plugin;
    if (config->sandbox->plugin_base) { # if we have a plugin base configured, use it first.
      my $plugin_filename = module_notional_filename($plugin_name);
      my $path = path(config->sandbox->plugin_base); # get the only path we'll load short stuff from by it's short name, otherwise deleting a file or a typo could load something we don't want

      my $full_path = $path->child($plugin_filename);

      $plugin = $plugin_name if (eval {require $full_path}); # TODO check if it was a failure to find, or a failure to compile.  failure to compile should still be fatal.
  }

    unless ($plugin) {
      # we couldnt' load it from the plugin base, try from @INC with a fully qualified name
      my $fullname = "App::EvalServerAdvanced::Seccomp::Plugin::$plugin_name";
      $plugin = $fullname if (eval {require_module($fullname)});
      # TODO log errors from module loading
    }

    die "Failed to find plugin $plugin_name" unless $plugin;

    $self->_plugins->{$plugin_name} = $plugin;
    $plugin->init_plugin($self);
    return $plugin;