mirror of
https://github.com/perlbot/perlbuut
synced 2025-06-07 21:05:42 -04:00
247 lines
7.6 KiB
Perl
247 lines
7.6 KiB
Perl
package EvalServer::Seccomp;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Data::Dumper;
|
|
use List::Util qw/reduce/;
|
|
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)});
|
|
|
|
# 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'],
|
|
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 => 'futext'},
|
|
{syscall => 'getrlimit'},
|
|
],
|
|
},
|
|
|
|
# File related stuff
|
|
stdio => {
|
|
rules => [{syscall => 'read', args => [[qw|0 == 0|]]}, # STDIN
|
|
{syscall => 'write', args => [[qw|0 == 1|]]}, # STDOUT
|
|
{syscall => 'write', args => [[qw|0 == 2|]]},
|
|
],
|
|
},
|
|
file_open => {
|
|
rules => [{syscall => 'open', permute_args => [['1', '==', \'open_modes']]},
|
|
{syscall => 'openat', permute_args => [['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'],
|
|
},
|
|
|
|
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, $used_sets) = @_;
|
|
|
|
croak "Rule set $profile not found" unless exists $rule_sets{$profile};
|
|
|
|
for my $rules (@{$rule_sets{$profile}}) {
|
|
}
|
|
}
|
|
|
|
sub build_seccomp {
|
|
my ($self) = @_;
|
|
|
|
my %used_sets = (); # keep track of which sets we've seen so we don't include multiple times
|
|
|
|
my %comp_rules; # computed rules
|
|
|
|
for my $profile (@{$self->profiles}) {
|
|
next if ($used_sets{$profile});
|
|
$used_sets{$profile} = 1;
|
|
|
|
my @rules = $self->_rec_get_rules($profile, \%used_sets);
|
|
print Dumper({profile => $profile, rules=>\@rules});
|
|
}
|
|
}
|
|
|
|
# sub get_seccomp {
|
|
# my $lang = shift;
|
|
#
|
|
#
|
|
#
|
|
#
|
|
# # 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";
|
|
# }
|
|
#
|
|
#
|
|
#
|
|
#
|
|
#
|
|
# $seccomp->load unless -e './noseccomp';
|
|
# }
|
|
1;
|