From ef6ea1da39b60e4f00d1dd3e8dac7069808e5885 Mon Sep 17 00:00:00 2001 From: Ryan Voots Date: Fri, 5 May 2017 22:49:36 -0700 Subject: [PATCH 1/5] Basic layout there. --- lib/EvalServer/Seccomp.pm | 626 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 626 insertions(+) create mode 100644 lib/EvalServer/Seccomp.pm diff --git a/lib/EvalServer/Seccomp.pm b/lib/EvalServer/Seccomp.pm new file mode 100644 index 0000000..d003987 --- /dev/null +++ b/lib/EvalServer/Seccomp.pm @@ -0,0 +1,626 @@ +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; + +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 + +# 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); + + my @blind_syscalls = qw/rt_sigaction rt_sigprocmask geteuid getuid getcwd close getdents getgid getegid getgroups lstat nanosleep getrlimit clock_gettime clock_getres/; + +my %rule_sets = { + default => { + include => ['time_calls', 'file_readonly', 'stdio'], + 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'}, + ], + }, + + # 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 => 'fcntl'}, + ], + }, + 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_CLOEXC]}, + 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 => [], + }, + + # 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 => { + rules => sub {...}, # sub returns a valid arrayref. given our $self as first arg. + # # Enable us to run other perl binaries + # for my $version (keys %exec_map) { + # $rule_add->(execve => [0, '==', $strptr->($exec_map{$version}{bin})]); + # } + }, + + # 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 engage_seccomp { + my ($self) = @_; + + my $seccomp = Linux::Seccomp->new(SCMP_ACT_KILL); + + my $rule_add = sub { + my $name = shift; + $seccomp->rule_add(SCMP_ACT_ALLOW, Linux::Seccomp::syscall_resolve_name($name), @_); + }; +} + +sub get_seccomp { + my $lang = shift; + + my $strptr = sub {unpack "Q", pack("p", $_[0])}; + + $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 => ); + + # 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 + + + + + $seccomp->load unless -e './noseccomp'; +} + +no warnings; + +# This sub is defined here so that it is defined before the 'use charnames' +# command. This causes extremely strange interactions that result in the +# deparse output being much longer than it should be. + sub deparse_perl_code { + my( $code ) = @_; + my $sub; + { + no strict; no warnings; no charnames; + $sub = eval "use $]; package botdeparse; sub{ $code\n }"; + } + + my %methods = (map {$_ => botdeparse->can($_)} grep {botdeparse->can($_)} keys {%botdeparse::}->%*); + + if( $@ ) { print STDOUT "Error: $@"; return } + + my $dp = B::Deparse->new("-p", "-q", "-x7", "-d"); + local *B::Deparse::declare_hints = sub { '' }; + my @out; + + my $clean_out = sub { + my $ret = shift; + $ret =~ s/\{//; + $ret =~ s/package (?:\w+(?:::)?)+;//; + $ret =~ s/no warnings;//; + $ret =~ s/\s+/ /g; + $ret =~ s/\s*\}\s*$//; + $ret =~ s/no feature ':all';//; + $ret =~ s/use feature [^;]+;//; + $ret =~ s/^\(\)//g; + $ret =~ s/^\s+|\s+$//g; + return $ret; + }; + + for my $sub (keys %methods) { + my $ret = $clean_out->($dp->coderef2text($methods{$sub})); + + push @out, "sub $sub {$ret} "; + } + + my $ret = $dp->coderef2text($sub); + $ret = $clean_out->($ret); + push @out, $ret; + + my $fullout = join(' ', @out); + + use Perl::Tidy; + my $hide = do {package hiderr; sub print{}; bless {}}; + my $tidy_out=""; + eval { + my $foo = "$fullout"; + Perl::Tidy::perltidy(source => \$foo, destination => \$tidy_out, errorfile => $hide, logfile => $hide); + }; + + $tidy_out = $fullout if ($@); + + print STDOUT $tidy_out; + } + +eval "use utf8; \$\343\201\257 = 42; 'ש' =~ /([\p{Bidi_Class:L}\p{Bidi_Class:R}])/"; # attempt to automatically load the utf8 libraries. +eval "use utf8; [ 'ß' =~ m/^\Qss\E\z/i ? 'True' : 'False' ];"; # Try to grab some more utf8 libs +eval "use utf8; [CORE::fc '€']"; +use charnames qw(:full); +use PerlIO; +use PerlIO::scalar; +use Text::ParseWords; + +eval {"\N{SPARKLE}"}; # force loading of some of the charnames stuff + +# Required for perl_deparse +use B::Deparse; + +## Javascript Libs +#BEGIN{ eval "use JavaScript::V8; require JSON::XS; JavaScript::V8::Context->new()->eval('1')"; } +#my $JSENV_CODE = do { local $/; open my $fh, "deps/env.js"; <$fh> }; +#require 'bytes_heavy.pl'; + +use Tie::Hash::NamedCapture; + + {#no warnings 'constant'; + uc "\x{666}"; #Attempt to load unicode libraries. + lc "JONQUIÉRE"; + } + binmode STDOUT, ":encoding(utf8)"; # Enable utf8 output. + +#BEGIN{ eval "use PHP::Interpreter;"; } + +# Evil Ruby stuff +#BEGIN{ eval "use Inline::Ruby qw/rb_eval/;"; } +#BEGIN { $SIG{SEGV} = sub { die "Segmentation Fault\n"; } } #Attempt to override the handler Ruby installs. + +# # Evil K20 stuff +# BEGIN { +# local $@; +# eval "use Language::K20;"; +# unless( $@ ) { +# Language::K20::k20eval( "2+2\n" ); # This eval loads the dynamic components before the chroot. +# # Note that k20eval always tries to output to stdout so we +# # must end the command with a \n to prevent this output. +# } +# } +# +# BEGIN { chdir "var/"; $0="../$0"; } # CHDIR to stop inline from creating stupid _Inline directories everywhere +# # Inline::Lua doesn't seem to provide an eval function. SIGH. +# BEGIN { eval 'use Inline Lua => "function lua_eval(str) return loadstring(str) end";'; } +# BEGIN { chdir ".."; $0=~s/^\.\.\/// } # Assume our earlier chdir succeded. Yay! + + +# # Evil python stuff +# BEGIN { eval "use Inline::Python qw/py_eval/;"; } + +# # Evil J stuff +# BEGIN { eval "use Jplugin;"; } + +use Carp::Heavy; +use Storable qw/nfreeze/; nfreeze([]); #Preload Nfreeze since it's loaded on demand + + my $type = do { local $/=" "; + + # have to do this with sysread in order to keep it from destroying STDIN for exec later. + + my $q; + my $c; + + while (sysread STDIN, $c, 1) { + $q .= $c; + last if $c eq $/; + } + + chomp $q; $q + }; + + my $code = do {local $/; }; + # 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: $!"; + + # Get the nobody uid before we chroot. + my $nobody_uid = 65534; #getpwnam("nobody"); + die "Error, can't find a uid for 'nobody'. Replace with someone who exists" unless $nobody_uid; + + # Set the CPU LIMIT. + # Do this before the chroot because some of the other + # setrlimit calls will prevent chroot from working + # however at the same time we need to preload an autload file + # that chroot will prevent, so do it here. + setrlimit(RLIMIT_CPU, 10,10); + +# # Root Check +# if( $< != 0 ) +# { +# die "Not root, can't chroot or take other precautions, dying\n"; +# } + + # The chroot section + chdir("/eval") or die $!; + + # It's now safe for us to do this so that we can load modules and files provided by the user + push @INC, "/eval/lib"; + + if ($< == 0) { + # Here's where we actually drop our root privilege + $)="$nobody_uid $nobody_uid"; + $(=$nobody_uid; + $<=$>=$nobody_uid; + POSIX::setgid($nobody_uid); #We just assume the uid is the same as the gid. Hot. + + + die "Failed to drop to nobody" + if $> != $nobody_uid + or $< != $nobody_uid; + } + + my $kilo = 1024; + my $meg = $kilo * $kilo; + my $limit = 300 * $meg; + + ( + setrlimit(RLIMIT_VMEM, 1.5*$limit, 1.5*$limit) + and + setrlimit(RLIMIT_DATA, $limit, $limit ) + and + setrlimit(RLIMIT_STACK, $limit, $limit ) + and + setrlimit(RLIMIT_NPROC, 4,4) # CHANGED to 3 for Ruby. Might take it away. + and + setrlimit(RLIMIT_NOFILE, 20,20) + and + setrlimit(RLIMIT_OFILE, 20,20) + and + setrlimit(RLIMIT_OPEN_MAX,20,20) + and + setrlimit(RLIMIT_LOCKS, 0,0) + and + setrlimit(RLIMIT_AS,$limit,$limit) + and + setrlimit(RLIMIT_MEMLOCK,100,100) + and + setrlimit(RLIMIT_CPU, 10, 10) + ) + or die "Failed to set rlimit: $!"; + + %ENV=(TZ=>'Asia/Pyongyang'); + #setrlimit(RLIMIT_MSGQUEUE,100,100); + + die "Failed to drop root: $<" if $< == 0; + # close STDIN; + + # Setup SECCOMP for us + get_seccomp($type); + # Chomp code.. + $code =~ s/\s*$//; + + # Choose which type of evaluation to perform + # will probably be a dispatch table soon. + if( $type eq 'perl' or $type eq 'pl' ) { + perl_code($code); + } + elsif( $type eq 'deparse' ) { + deparse_perl_code($code); + } + elsif ($type =~ /perl([0-9.]+)/) { # run specific perl version + perl_version_code($1, $code); + } +# elsif( $type eq 'javascript' ) { +# javascript_code($code); +# } +# elsif( $type eq 'php' ) { +# php_code($code); +# } +# elsif( $type eq 'k20' ) { +# k20_code($code); +# } + elsif( $type eq 'ruby' ) { + ruby_code($code); + } +# elsif( $type eq 'py' or $type eq 'python' ) { +# python_code($code); +# } +# elsif( $type eq 'lua' ) { +# lua_code($code); +# } +# elsif( $type eq 'j' ) { +# j_code($code); +# } + +# *STDOUT = $oldout; + close($stdh); + select(STDOUT); + print($outbuffer); + + exit; + + #----------------------------------------------------------------------------- + # Evaluate the actual code + #----------------------------------------------------------------------------- + sub perl_code { + my( $code ) = @_; + local $@; + local @INC = map {s|/home/ryan||r} @INC; +# local $$=24601; + close STDIN; + my $stdin = q{Biqsip bo'degh cha'par hu jev lev lir loghqam lotlhmoq nay' petaq qaryoq qeylis qul tuq qaq roswi' say'qu'moh tangqa' targh tiq 'ab. Chegh chevwi' tlhoy' da'vi' ghet ghuy'cha' jaghla' mevyap mu'qad ves naq pach qew qul tuq rach tagh tal tey'. Denibya' dugh ghaytanha' homwi' huchqed mara marwi' namtun qevas qay' tiqnagh lemdu' veqlargh 'em 'e'mam 'orghenya' rojmab. Baqa' chuy da'nal dilyum ghitlhwi' ghubdaq ghuy' hong boq chuydah hutvagh jorneb law' mil nadqa'ghach pujwi' qa'ri' ting toq yem yur yuvtlhe' 'e'mamnal 'iqnah qad 'orghenya' rojmab 'orghengan. Beb biqsip 'ugh denibya' ghal ghobchuq lodni'pu' ghochwi' huh jij lol nanwi' ngech pujwi' qawhaq qeng qo'qad qovpatlh ron ros say'qu'moh soq tugh tlhej tlhot verengan ha'dibah waqboch 'er'in 'irneh. +Cha'par denib qatlh denibya' ghiq jim megh'an nahjej naq nay' podmoh qanwi' qevas qin rilwi' ros sila' tey'lod tus vad vay' vem'eq yas cha'dich 'entepray' 'irnehnal 'urwi'. Baqa' be'joy' bi'res chegh chob'a' dah hos chohwi' piq pivlob qa'ri' qa'rol qewwi' qo'qad qi'tu' qu'vatlh say'qu'moh sa'hut sosbor'a' tlhach mu'mey vid'ir yas cha'dich yergho. Chegh denibya'ngan jajvam jij jim lev lo'lahbe'ghach ngun nguq pa' beb pivlob pujwi' qab qid sosbor'a' tlhepqe' tlhov va 'o'megh 'ud haqtaj. Bor cha'nas denibya' qatlh duran lung dir ghogh habli' homwi' hoq je' notqa' pegh per pitlh qarghan qawhaq qen red tey'lod valqis vid'ir wab yer yintagh 'edjen. Bi'rel tlharghduj cheb ghal lorlod ne' ngij pipyus pivlob qutluch red sila' tuqnigh. +Chob'a' choq chuq'a' dol jev jij lev marwi' mojaq ngij ngugh pujmoh puqni'be' qaywi' qirq qi'yah qum taq tey'be' tlhup valqis 'edsehcha. Chadvay' cha'par ghal je' lir lolchu' lursa' maqmigh ngun per qen qevas quv bey' soq targh tiq tlhot veqlargh wen. Baqa' chuq'a' jev juch logh lol lor mistaq nahjej nuh bey' nguq pujmoh qovpatlh ron tahqeq tuy' vithay' yo'seh yahniv yuqjijdivi' 'em 'orghenya'ngan. Beb cheb chob da'nal da'vi' ghoti' ghuy'cha' hoq loghqam ngav po ha'dibah qen qo'qad qid ril siq tuy' tlhoy' sas vinpu' wab yuqjijqa' 'em 'o'megh. Bachha' biq boqha''egh cheb dor duran lung dir ghang hos chohwi' je' luh mu'qad ves nav habli' qab qan rach siqwi' tennus tepqengwi' tuqnigh tlhoy' sas va vin yeq yuqjijdivi' 'ab 'edjen 'iqnah 'ud'a' 'urwi'. +Baqa' bi'res boq'egh da'vi' dol dor ghet ghetwi' ghogh habli' hos chohwi' nga'chuq petaq pirmus puqni' qutluch qaj qid qi'tu' qongdaqdaq siq tahqeq ti'ang toq tlhup yatqap yer 'ur. Biqsip 'ugh chang'eng choq choq hutvagh jajlo' qa' jer nanwi' nav habli' pirmus qab qa'meh vittlhegh qa'ri' sen siv vem'eq yer yo'seh yahniv yuqjijdivi' 'arlogh 'e'mamnal 'och. Chang'eng chas cha'dich choq lursa' mil natlh nay' puqni'be' qeng qid qulpa' ret sa'hut viq wen yiq yuqjijdivi' yu'egh 'edsehcha 'entepray' 'er'in 'ev 'irneh 'iw 'ip ghomey 'orwi' 'ud haqtaj 'usgheb. Chadvay' gheb lol lorbe' lursa' pivlob qep'it sen senwi' rilwi' je tajvaj wogh. Chevwi' tlhoy' huh lol lorbe' neslo' ne' pipyus qaq qi'yah tal 'ev. +Biqsip biqsip 'ugh chan ghitlh lursa' nuh bey' ngun petaq qeng soj tlhej waqboch 'ab 'entepray' 'e'mam. Bo denibya' ghetwi' ghochwi' ghuy' ghuy'cha' holqed huh jaj je' matlh pegh petaq qawhaq qa'meh qay' tagh tey' wogh yer yu'egh 'orghen 'urwi'. Boq'egh choq dav jim laq nga'chuq ngoqde' ngusdi' qan qu'vatlh sen tijwi'ghom ti'ang wogh 'orghenya'ngan. Biq cha'nas chegh chob dilyum ghetwi' juch me'nal motlh po ha'dibah puqni'lod qab qarghan qaywi' qaj rutlh say'qu'moh todsah tus yas wa'dich 'aqtu' 'edjen 'e'nal 'orwi'. Bor chob jaghla' je' jorneb mellota' meqba' nguq rachwi' ron tey' tiqnagh lemdu' vay' 'usgheb. Bis'ub cheb chob'a' dugh homwi' lotlhmoq mu'qad ves nahjej nanwi' naw' nitebha' ngoqde' ngusdi' pach pujmoh puqni'lod qan qay' rech senwi' tangqa' tepqengwi' tlhej tlhot valqis waqboch 'aqtu' 'e'mam 'iqnah 'orghen rojmab.}; + open(STDIN, "<", \$stdin); + + local $_; + + my $ret; + + my @os = qw/aix bsdos darwin dynixptx freebsd haiku linux hpux irix next openbsd dec_osf svr4 sco_sv unicos unicosmk solaris sunos MSWin32 MSWin16 MSWin63 dos os2 cygwin vos os390 os400 posix-bc riscos amigaos xenix/; + + { +# local $^O = $os[rand()*@os]; + no strict; no warnings; package main; +# my $oldout; + do { + local $/="\n"; + local $\; + local $,; + $code = "use $]; use feature qw/postderef refaliasing lexical_subs postderef_qq signatures/; use experimental 'declared_refs';\n#line 1 \"(IRC)\"\n$code"; + $ret = eval $code; + } + } + select STDOUT; + + local $Data::Dumper::Terse = 1; + local $Data::Dumper::Quotekeys = 0; + local $Data::Dumper::Indent = 0; + local $Data::Dumper::Useqq = 1; + local $Data::Dumper::Freezer = "dd_freeze"; + + my $out = ref($ret) ? Dumper( $ret ) : "" . $ret; + + print $out unless $outbuffer; + + if( $@ ) { print "ERROR: $@" } + } + + sub perl_version_code { + my ($version, $code) = @_; + + my $qcode = quotemeta $code; + + my $wrapper = 'use Data::Dumper; + + local $Data::Dumper::Terse = 1; + local $Data::Dumper::Quotekeys = 0; + local $Data::Dumper::Indent = 0; + local $Data::Dumper::Useqq = 1; + + my $val = eval "#line 1 \"(IRC)\"\n'.$qcode.'"; + + if ($@) { + print $@; + } else { + $val = ref($val) ? Dumper ($val) : "".$val; + print " ",$val; + } + '; + + unless ($version eq '4') { + 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 + } + } + + sub ruby_code { + my ($code) = @_; + + exec($exec_map{'ruby'}{bin}, '-e', $code); + } + +# sub javascript_code { +# my( $code ) = @_; +# local $@; +# +# my $js = JavaScript::V8::Context->new; +# +# # Set up the Environment for ENVJS +# $js->bind("print", sub { print @_ } ); +# $js->bind("write", sub { print @_ } ); +# +# # for( qw/log debug info warn error/ ) { +# # $js->eval("Envjs.$_=function(x){}"); +# # } +# +# # $js->eval($JSENV_CODE) or die $@; +# +# $code =~ s/(["\\])/\\$1/g; +# my $rcode = qq{write(eval("$code"))}; +# +# +# +# my $out = eval { $js->eval($rcode) }; +# +# if( $@ ) { print "ERROR: $@"; } +# else { print encode_json $out } +# } +# +# sub ruby_code { +# my( $code ) = @_; +# local $@; +# +# print rb_eval( $code ); +# } +# +# sub php_code { +# my( $code ) = @_; +# local $@; +# +# #warn "PHP - [$code]"; +# +# my $php = PHP::Interpreter->new; +# +# $php->set_output_handler(\ my $output ); +# +# $php->eval("$code;"); +# +# print $php->get_output; +# +# #warn "ENDING"; +# +# if( $@ ) { print "ERROR: $@"; } +# } +# +# sub k20_code { +# my( $code ) = @_; +# +# $code =~ s/\r?\n//g; +# +# +# Language::K20::k20eval( '."\\\\r ' . int(rand(2**31)) . '";' . "\n"); # set random seed +# +# Language::K20::k20eval( $code ); +# } +# +# sub python_code { +# my( $code ) = @_; +# +# py_eval( $code, 2 ); +# } +# +# sub lua_code { +# my( $code ) = @_; +# +# #print lua_eval( $code )->(); +# +# my $ret = lua_eval( $code ); +# +# print ref $ret ? $ret->() : $ret; +# } +# +# sub j_code { +# my( $code ) = @_; +# +# Jplugin::jplugin( $code ); +# } From 151daca0bbce652e6b9456c4d12ae0de557668d0 Mon Sep 17 00:00:00 2001 From: Ryan Voots Date: Fri, 5 May 2017 23:54:33 -0700 Subject: [PATCH 2/5] mostly there. need to find the syntax error --- lib/EvalServer/Seccomp.pm | 599 +++++++------------------------------- 1 file changed, 110 insertions(+), 489 deletions(-) diff --git a/lib/EvalServer/Seccomp.pm b/lib/EvalServer/Seccomp.pm index d003987..fd7d0af 100644 --- a/lib/EvalServer/Seccomp.pm +++ b/lib/EvalServer/Seccomp.pm @@ -9,6 +9,7 @@ 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. @@ -31,14 +32,17 @@ has exec_map => (is => 'ro', default => sub { 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); - my @blind_syscalls = qw/rt_sigaction rt_sigprocmask geteuid getuid getcwd close getdents getgid getegid getgroups lstat nanosleep getrlimit clock_gettime clock_getres/; - -my %rule_sets = { +# TODO this needs some accessors to make it easier to define rulesets +our %rule_sets = { default => { - include => ['time_calls', 'file_readonly', 'stdio'], + include => ['time_calls', 'file_readonly', 'stdio', 'exec_wrapper'], rules => [{syscall => 'mmap'}, {syscall => 'munmap'}, {syscall => 'mremap'}, @@ -53,6 +57,19 @@ my %rule_sets = { {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'}, ], }, @@ -72,7 +89,11 @@ my %rule_sets = { {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 => { @@ -85,7 +106,7 @@ my %rule_sets = { include => ['file_open'], }, file_readonly => { - permute => {open_modes => [&POSIX::O_NONBLOCK, &POSIX::O_EXCL, &POSIX::O_RDONLY, $O_NOFOLLOW, $O_CLOEXC]}, + permute => {open_modes => [&POSIX::O_NONBLOCK, &POSIX::O_EXCL, &POSIX::O_RDONLY, $O_NOFOLLOW, $O_CLOEXEC]}, include => ['file_open'], }, file_write => { @@ -96,14 +117,18 @@ my %rule_sets = { # time related stuff time_calls => { - rules => [], + 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]]}, + {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 @@ -118,15 +143,24 @@ my %rule_sets = { {syscall => 'chmod', rules => [[1, '==', 0600]]}, {syscall => 'unlink', }, ], - } + }, # exec wrapper exec_wrapper => { - rules => sub {...}, # sub returns a valid arrayref. given our $self as first arg. - # # Enable us to run other perl binaries - # for my $version (keys %exec_map) { - # $rule_add->(execve => [0, '==', $strptr->($exec_map{$version}{bin})]); - # } + # 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 @@ -138,489 +172,76 @@ my %rule_sets = { 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]]}, + {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 engage_seccomp { +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 $seccomp = Linux::Seccomp->new(SCMP_ACT_KILL); - my $rule_add = sub { - my $name = shift; - $seccomp->rule_add(SCMP_ACT_ALLOW, Linux::Seccomp::syscall_resolve_name($name), @_); - }; + 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; - - my $strptr = sub {unpack "Q", pack("p", $_[0])}; - - $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 => ); - - # 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 - - - - - $seccomp->load unless -e './noseccomp'; -} - -no warnings; - -# This sub is defined here so that it is defined before the 'use charnames' -# command. This causes extremely strange interactions that result in the -# deparse output being much longer than it should be. - sub deparse_perl_code { - my( $code ) = @_; - my $sub; - { - no strict; no warnings; no charnames; - $sub = eval "use $]; package botdeparse; sub{ $code\n }"; - } - - my %methods = (map {$_ => botdeparse->can($_)} grep {botdeparse->can($_)} keys {%botdeparse::}->%*); - - if( $@ ) { print STDOUT "Error: $@"; return } - - my $dp = B::Deparse->new("-p", "-q", "-x7", "-d"); - local *B::Deparse::declare_hints = sub { '' }; - my @out; - - my $clean_out = sub { - my $ret = shift; - $ret =~ s/\{//; - $ret =~ s/package (?:\w+(?:::)?)+;//; - $ret =~ s/no warnings;//; - $ret =~ s/\s+/ /g; - $ret =~ s/\s*\}\s*$//; - $ret =~ s/no feature ':all';//; - $ret =~ s/use feature [^;]+;//; - $ret =~ s/^\(\)//g; - $ret =~ s/^\s+|\s+$//g; - return $ret; - }; - - for my $sub (keys %methods) { - my $ret = $clean_out->($dp->coderef2text($methods{$sub})); - - push @out, "sub $sub {$ret} "; - } - - my $ret = $dp->coderef2text($sub); - $ret = $clean_out->($ret); - push @out, $ret; - - my $fullout = join(' ', @out); - - use Perl::Tidy; - my $hide = do {package hiderr; sub print{}; bless {}}; - my $tidy_out=""; - eval { - my $foo = "$fullout"; - Perl::Tidy::perltidy(source => \$foo, destination => \$tidy_out, errorfile => $hide, logfile => $hide); - }; - - $tidy_out = $fullout if ($@); - - print STDOUT $tidy_out; - } - -eval "use utf8; \$\343\201\257 = 42; 'ש' =~ /([\p{Bidi_Class:L}\p{Bidi_Class:R}])/"; # attempt to automatically load the utf8 libraries. -eval "use utf8; [ 'ß' =~ m/^\Qss\E\z/i ? 'True' : 'False' ];"; # Try to grab some more utf8 libs -eval "use utf8; [CORE::fc '€']"; -use charnames qw(:full); -use PerlIO; -use PerlIO::scalar; -use Text::ParseWords; - -eval {"\N{SPARKLE}"}; # force loading of some of the charnames stuff - -# Required for perl_deparse -use B::Deparse; - -## Javascript Libs -#BEGIN{ eval "use JavaScript::V8; require JSON::XS; JavaScript::V8::Context->new()->eval('1')"; } -#my $JSENV_CODE = do { local $/; open my $fh, "deps/env.js"; <$fh> }; -#require 'bytes_heavy.pl'; - -use Tie::Hash::NamedCapture; - - {#no warnings 'constant'; - uc "\x{666}"; #Attempt to load unicode libraries. - lc "JONQUIÉRE"; - } - binmode STDOUT, ":encoding(utf8)"; # Enable utf8 output. - -#BEGIN{ eval "use PHP::Interpreter;"; } - -# Evil Ruby stuff -#BEGIN{ eval "use Inline::Ruby qw/rb_eval/;"; } -#BEGIN { $SIG{SEGV} = sub { die "Segmentation Fault\n"; } } #Attempt to override the handler Ruby installs. - -# # Evil K20 stuff -# BEGIN { -# local $@; -# eval "use Language::K20;"; -# unless( $@ ) { -# Language::K20::k20eval( "2+2\n" ); # This eval loads the dynamic components before the chroot. -# # Note that k20eval always tries to output to stdout so we -# # must end the command with a \n to prevent this output. -# } +# 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'; # } -# -# BEGIN { chdir "var/"; $0="../$0"; } # CHDIR to stop inline from creating stupid _Inline directories everywhere -# # Inline::Lua doesn't seem to provide an eval function. SIGH. -# BEGIN { eval 'use Inline Lua => "function lua_eval(str) return loadstring(str) end";'; } -# BEGIN { chdir ".."; $0=~s/^\.\.\/// } # Assume our earlier chdir succeded. Yay! - - -# # Evil python stuff -# BEGIN { eval "use Inline::Python qw/py_eval/;"; } - -# # Evil J stuff -# BEGIN { eval "use Jplugin;"; } - -use Carp::Heavy; -use Storable qw/nfreeze/; nfreeze([]); #Preload Nfreeze since it's loaded on demand - - my $type = do { local $/=" "; - - # have to do this with sysread in order to keep it from destroying STDIN for exec later. - - my $q; - my $c; - - while (sysread STDIN, $c, 1) { - $q .= $c; - last if $c eq $/; - } - - chomp $q; $q - }; - - my $code = do {local $/; }; - # 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: $!"; - - # Get the nobody uid before we chroot. - my $nobody_uid = 65534; #getpwnam("nobody"); - die "Error, can't find a uid for 'nobody'. Replace with someone who exists" unless $nobody_uid; - - # Set the CPU LIMIT. - # Do this before the chroot because some of the other - # setrlimit calls will prevent chroot from working - # however at the same time we need to preload an autload file - # that chroot will prevent, so do it here. - setrlimit(RLIMIT_CPU, 10,10); - -# # Root Check -# if( $< != 0 ) -# { -# die "Not root, can't chroot or take other precautions, dying\n"; -# } - - # The chroot section - chdir("/eval") or die $!; - - # It's now safe for us to do this so that we can load modules and files provided by the user - push @INC, "/eval/lib"; - - if ($< == 0) { - # Here's where we actually drop our root privilege - $)="$nobody_uid $nobody_uid"; - $(=$nobody_uid; - $<=$>=$nobody_uid; - POSIX::setgid($nobody_uid); #We just assume the uid is the same as the gid. Hot. - - - die "Failed to drop to nobody" - if $> != $nobody_uid - or $< != $nobody_uid; - } - - my $kilo = 1024; - my $meg = $kilo * $kilo; - my $limit = 300 * $meg; - - ( - setrlimit(RLIMIT_VMEM, 1.5*$limit, 1.5*$limit) - and - setrlimit(RLIMIT_DATA, $limit, $limit ) - and - setrlimit(RLIMIT_STACK, $limit, $limit ) - and - setrlimit(RLIMIT_NPROC, 4,4) # CHANGED to 3 for Ruby. Might take it away. - and - setrlimit(RLIMIT_NOFILE, 20,20) - and - setrlimit(RLIMIT_OFILE, 20,20) - and - setrlimit(RLIMIT_OPEN_MAX,20,20) - and - setrlimit(RLIMIT_LOCKS, 0,0) - and - setrlimit(RLIMIT_AS,$limit,$limit) - and - setrlimit(RLIMIT_MEMLOCK,100,100) - and - setrlimit(RLIMIT_CPU, 10, 10) - ) - or die "Failed to set rlimit: $!"; - - %ENV=(TZ=>'Asia/Pyongyang'); - #setrlimit(RLIMIT_MSGQUEUE,100,100); - - die "Failed to drop root: $<" if $< == 0; - # close STDIN; - - # Setup SECCOMP for us - get_seccomp($type); - # Chomp code.. - $code =~ s/\s*$//; - - # Choose which type of evaluation to perform - # will probably be a dispatch table soon. - if( $type eq 'perl' or $type eq 'pl' ) { - perl_code($code); - } - elsif( $type eq 'deparse' ) { - deparse_perl_code($code); - } - elsif ($type =~ /perl([0-9.]+)/) { # run specific perl version - perl_version_code($1, $code); - } -# elsif( $type eq 'javascript' ) { -# javascript_code($code); -# } -# elsif( $type eq 'php' ) { -# php_code($code); -# } -# elsif( $type eq 'k20' ) { -# k20_code($code); -# } - elsif( $type eq 'ruby' ) { - ruby_code($code); - } -# elsif( $type eq 'py' or $type eq 'python' ) { -# python_code($code); -# } -# elsif( $type eq 'lua' ) { -# lua_code($code); -# } -# elsif( $type eq 'j' ) { -# j_code($code); -# } - -# *STDOUT = $oldout; - close($stdh); - select(STDOUT); - print($outbuffer); - - exit; - - #----------------------------------------------------------------------------- - # Evaluate the actual code - #----------------------------------------------------------------------------- - sub perl_code { - my( $code ) = @_; - local $@; - local @INC = map {s|/home/ryan||r} @INC; -# local $$=24601; - close STDIN; - my $stdin = q{Biqsip bo'degh cha'par hu jev lev lir loghqam lotlhmoq nay' petaq qaryoq qeylis qul tuq qaq roswi' say'qu'moh tangqa' targh tiq 'ab. Chegh chevwi' tlhoy' da'vi' ghet ghuy'cha' jaghla' mevyap mu'qad ves naq pach qew qul tuq rach tagh tal tey'. Denibya' dugh ghaytanha' homwi' huchqed mara marwi' namtun qevas qay' tiqnagh lemdu' veqlargh 'em 'e'mam 'orghenya' rojmab. Baqa' chuy da'nal dilyum ghitlhwi' ghubdaq ghuy' hong boq chuydah hutvagh jorneb law' mil nadqa'ghach pujwi' qa'ri' ting toq yem yur yuvtlhe' 'e'mamnal 'iqnah qad 'orghenya' rojmab 'orghengan. Beb biqsip 'ugh denibya' ghal ghobchuq lodni'pu' ghochwi' huh jij lol nanwi' ngech pujwi' qawhaq qeng qo'qad qovpatlh ron ros say'qu'moh soq tugh tlhej tlhot verengan ha'dibah waqboch 'er'in 'irneh. -Cha'par denib qatlh denibya' ghiq jim megh'an nahjej naq nay' podmoh qanwi' qevas qin rilwi' ros sila' tey'lod tus vad vay' vem'eq yas cha'dich 'entepray' 'irnehnal 'urwi'. Baqa' be'joy' bi'res chegh chob'a' dah hos chohwi' piq pivlob qa'ri' qa'rol qewwi' qo'qad qi'tu' qu'vatlh say'qu'moh sa'hut sosbor'a' tlhach mu'mey vid'ir yas cha'dich yergho. Chegh denibya'ngan jajvam jij jim lev lo'lahbe'ghach ngun nguq pa' beb pivlob pujwi' qab qid sosbor'a' tlhepqe' tlhov va 'o'megh 'ud haqtaj. Bor cha'nas denibya' qatlh duran lung dir ghogh habli' homwi' hoq je' notqa' pegh per pitlh qarghan qawhaq qen red tey'lod valqis vid'ir wab yer yintagh 'edjen. Bi'rel tlharghduj cheb ghal lorlod ne' ngij pipyus pivlob qutluch red sila' tuqnigh. -Chob'a' choq chuq'a' dol jev jij lev marwi' mojaq ngij ngugh pujmoh puqni'be' qaywi' qirq qi'yah qum taq tey'be' tlhup valqis 'edsehcha. Chadvay' cha'par ghal je' lir lolchu' lursa' maqmigh ngun per qen qevas quv bey' soq targh tiq tlhot veqlargh wen. Baqa' chuq'a' jev juch logh lol lor mistaq nahjej nuh bey' nguq pujmoh qovpatlh ron tahqeq tuy' vithay' yo'seh yahniv yuqjijdivi' 'em 'orghenya'ngan. Beb cheb chob da'nal da'vi' ghoti' ghuy'cha' hoq loghqam ngav po ha'dibah qen qo'qad qid ril siq tuy' tlhoy' sas vinpu' wab yuqjijqa' 'em 'o'megh. Bachha' biq boqha''egh cheb dor duran lung dir ghang hos chohwi' je' luh mu'qad ves nav habli' qab qan rach siqwi' tennus tepqengwi' tuqnigh tlhoy' sas va vin yeq yuqjijdivi' 'ab 'edjen 'iqnah 'ud'a' 'urwi'. -Baqa' bi'res boq'egh da'vi' dol dor ghet ghetwi' ghogh habli' hos chohwi' nga'chuq petaq pirmus puqni' qutluch qaj qid qi'tu' qongdaqdaq siq tahqeq ti'ang toq tlhup yatqap yer 'ur. Biqsip 'ugh chang'eng choq choq hutvagh jajlo' qa' jer nanwi' nav habli' pirmus qab qa'meh vittlhegh qa'ri' sen siv vem'eq yer yo'seh yahniv yuqjijdivi' 'arlogh 'e'mamnal 'och. Chang'eng chas cha'dich choq lursa' mil natlh nay' puqni'be' qeng qid qulpa' ret sa'hut viq wen yiq yuqjijdivi' yu'egh 'edsehcha 'entepray' 'er'in 'ev 'irneh 'iw 'ip ghomey 'orwi' 'ud haqtaj 'usgheb. Chadvay' gheb lol lorbe' lursa' pivlob qep'it sen senwi' rilwi' je tajvaj wogh. Chevwi' tlhoy' huh lol lorbe' neslo' ne' pipyus qaq qi'yah tal 'ev. -Biqsip biqsip 'ugh chan ghitlh lursa' nuh bey' ngun petaq qeng soj tlhej waqboch 'ab 'entepray' 'e'mam. Bo denibya' ghetwi' ghochwi' ghuy' ghuy'cha' holqed huh jaj je' matlh pegh petaq qawhaq qa'meh qay' tagh tey' wogh yer yu'egh 'orghen 'urwi'. Boq'egh choq dav jim laq nga'chuq ngoqde' ngusdi' qan qu'vatlh sen tijwi'ghom ti'ang wogh 'orghenya'ngan. Biq cha'nas chegh chob dilyum ghetwi' juch me'nal motlh po ha'dibah puqni'lod qab qarghan qaywi' qaj rutlh say'qu'moh todsah tus yas wa'dich 'aqtu' 'edjen 'e'nal 'orwi'. Bor chob jaghla' je' jorneb mellota' meqba' nguq rachwi' ron tey' tiqnagh lemdu' vay' 'usgheb. Bis'ub cheb chob'a' dugh homwi' lotlhmoq mu'qad ves nahjej nanwi' naw' nitebha' ngoqde' ngusdi' pach pujmoh puqni'lod qan qay' rech senwi' tangqa' tepqengwi' tlhej tlhot valqis waqboch 'aqtu' 'e'mam 'iqnah 'orghen rojmab.}; - open(STDIN, "<", \$stdin); - - local $_; - - my $ret; - - my @os = qw/aix bsdos darwin dynixptx freebsd haiku linux hpux irix next openbsd dec_osf svr4 sco_sv unicos unicosmk solaris sunos MSWin32 MSWin16 MSWin63 dos os2 cygwin vos os390 os400 posix-bc riscos amigaos xenix/; - - { -# local $^O = $os[rand()*@os]; - no strict; no warnings; package main; -# my $oldout; - do { - local $/="\n"; - local $\; - local $,; - $code = "use $]; use feature qw/postderef refaliasing lexical_subs postderef_qq signatures/; use experimental 'declared_refs';\n#line 1 \"(IRC)\"\n$code"; - $ret = eval $code; - } - } - select STDOUT; - - local $Data::Dumper::Terse = 1; - local $Data::Dumper::Quotekeys = 0; - local $Data::Dumper::Indent = 0; - local $Data::Dumper::Useqq = 1; - local $Data::Dumper::Freezer = "dd_freeze"; - - my $out = ref($ret) ? Dumper( $ret ) : "" . $ret; - - print $out unless $outbuffer; - - if( $@ ) { print "ERROR: $@" } - } - - sub perl_version_code { - my ($version, $code) = @_; - - my $qcode = quotemeta $code; - - my $wrapper = 'use Data::Dumper; - - local $Data::Dumper::Terse = 1; - local $Data::Dumper::Quotekeys = 0; - local $Data::Dumper::Indent = 0; - local $Data::Dumper::Useqq = 1; - - my $val = eval "#line 1 \"(IRC)\"\n'.$qcode.'"; - - if ($@) { - print $@; - } else { - $val = ref($val) ? Dumper ($val) : "".$val; - print " ",$val; - } - '; - - unless ($version eq '4') { - 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 - } - } - - sub ruby_code { - my ($code) = @_; - - exec($exec_map{'ruby'}{bin}, '-e', $code); - } - -# sub javascript_code { -# my( $code ) = @_; -# local $@; -# -# my $js = JavaScript::V8::Context->new; -# -# # Set up the Environment for ENVJS -# $js->bind("print", sub { print @_ } ); -# $js->bind("write", sub { print @_ } ); -# -# # for( qw/log debug info warn error/ ) { -# # $js->eval("Envjs.$_=function(x){}"); -# # } -# -# # $js->eval($JSENV_CODE) or die $@; -# -# $code =~ s/(["\\])/\\$1/g; -# my $rcode = qq{write(eval("$code"))}; -# -# -# -# my $out = eval { $js->eval($rcode) }; -# -# if( $@ ) { print "ERROR: $@"; } -# else { print encode_json $out } -# } -# -# sub ruby_code { -# my( $code ) = @_; -# local $@; -# -# print rb_eval( $code ); -# } -# -# sub php_code { -# my( $code ) = @_; -# local $@; -# -# #warn "PHP - [$code]"; -# -# my $php = PHP::Interpreter->new; -# -# $php->set_output_handler(\ my $output ); -# -# $php->eval("$code;"); -# -# print $php->get_output; -# -# #warn "ENDING"; -# -# if( $@ ) { print "ERROR: $@"; } -# } -# -# sub k20_code { -# my( $code ) = @_; -# -# $code =~ s/\r?\n//g; -# -# -# Language::K20::k20eval( '."\\\\r ' . int(rand(2**31)) . '";' . "\n"); # set random seed -# -# Language::K20::k20eval( $code ); -# } -# -# sub python_code { -# my( $code ) = @_; -# -# py_eval( $code, 2 ); -# } -# -# sub lua_code { -# my( $code ) = @_; -# -# #print lua_eval( $code )->(); -# -# my $ret = lua_eval( $code ); -# -# print ref $ret ? $ret->() : $ret; -# } -# -# sub j_code { -# my( $code ) = @_; -# -# Jplugin::jplugin( $code ); -# } +1; From c908d0b4cb147d2721759e5d0de4060aa0333820 Mon Sep 17 00:00:00 2001 From: Ryan Voots Date: Sat, 6 May 2017 00:10:15 -0700 Subject: [PATCH 3/5] Almost there, needs to properly save the permutes for open() and such --- lib/EvalServer/Seccomp.pm | 42 +++++++++++++++++++++++++++++++-------- 1 file changed, 34 insertions(+), 8 deletions(-) diff --git a/lib/EvalServer/Seccomp.pm b/lib/EvalServer/Seccomp.pm index fd7d0af..8076e57 100644 --- a/lib/EvalServer/Seccomp.pm +++ b/lib/EvalServer/Seccomp.pm @@ -40,7 +40,7 @@ has seccomp => (is => 'ro', default => sub {Linux::Seccomp->new(SCMP_ACT_KILL)}) 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 = { +our %rule_sets = ( default => { include => ['time_calls', 'file_readonly', 'stdio', 'exec_wrapper'], rules => [{syscall => 'mmap'}, @@ -177,7 +177,7 @@ our %rule_sets = { ], include => ['default', 'ruby_timer_thread'], }, -}; +); sub rule_add { my ($self, $name, @rules) = @_; @@ -185,13 +185,40 @@ sub rule_add { $self->seccomp->rule_add(SCMP_ACT_ALLOW, Linux::Seccomp::syscall_resolve_name($name), @rules); } +sub _process_rule { + my ($self, $rule) = @_; +} + sub _rec_get_rules { - my ($self, $profile, $used_sets) = @_; + my ($self, $profile, $used_sets, $permutes) = @_; + + return () if ($used_sets->{$profile}); + $used_sets->{$profile} = 1; croak "Rule set $profile not found" unless exists $rule_sets{$profile}; - for my $rules (@{$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 @{$permutes->{$perm}}, @{$rule_sets{$profile}{permute}{$perm}}; + } + + for my $include (@{$rule_sets{$profile}{include}//[]}) { + push @rules, $self->_rec_get_rules($include, $used_sets); + } + + return @rules; } sub build_seccomp { @@ -200,13 +227,12 @@ sub build_seccomp { my %used_sets = (); # keep track of which sets we've seen so we don't include multiple times my %comp_rules; # computed rules + my %permutes; 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}); + my @rules = $self->_rec_get_rules($profile, \%used_sets, \%permutes); + print Dumper({profile => $profile, rules=>\@rules, used_sets => \%used_sets, permutes => \%permutes}); } } From a3dda481bfec316ef6715a2a5964eb2107e5e36c Mon Sep 17 00:00:00 2001 From: Ryan Voots Date: Sat, 6 May 2017 01:33:53 -0700 Subject: [PATCH 4/5] Permutation rules created --- .gitmodules | 2 +- etc/bb3.conf | 41 ++---------- lib/EvalServer/Seccomp.pm | 130 +++++++++++++++++++++++++++++++------- 3 files changed, 113 insertions(+), 60 deletions(-) diff --git a/.gitmodules b/.gitmodules index 9c02115..c6c0eaf 100644 --- a/.gitmodules +++ b/.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 diff --git a/etc/bb3.conf b/etc/bb3.conf index 4e43c41..5248f6b 100644 --- a/etc/bb3.conf +++ b/etc/bb3.conf @@ -36,27 +36,9 @@ http_plugin_port 1092 default_plugin default - - channel \#buubot - channel \#\#turtles + channel \#perlcafe - channel \#webgui - channel \#citadel - channel \#modperl - channel \#perl - channel \#ipv6 channel \#perlbot - channel \#mrtg - channel \#ipv6-fr - channel \#freebsd-fr - channel \#botpark - channel \#css - channel \#modus - channel \#perl-cats - channel \#cout.dev - channel \#web-locals - channel \#regex - channel \#regexen ignore buubot ignore avarbot @@ -74,23 +56,8 @@ http_plugin_port 1092 ignore EvanCarol ignore EC - server localhost - username perlbot - password sindarin - port 65432 + server chat.freenode.net + username perlbot-dev + port 6667 root_mask p3m/member/simcop2387 - - - channel \#freenode-perl-cabal - channel \#perl-help - - ignore purl - ignore perlbot - - server localhost - username perlbot-magnet - password sindarin - port 65432 - root_mask ~simcop238@simcop2387.info - diff --git a/lib/EvalServer/Seccomp.pm b/lib/EvalServer/Seccomp.pm index 8076e57..de7cfb8 100644 --- a/lib/EvalServer/Seccomp.pm +++ b/lib/EvalServer/Seccomp.pm @@ -4,7 +4,7 @@ use strict; use warnings; use Data::Dumper; -use List::Util qw/reduce/; +use List::Util qw/reduce uniq/; use Moo; use Sys::Linux::Unshare qw/:consts/; use POSIX; @@ -35,6 +35,10 @@ 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); @@ -42,7 +46,7 @@ my ($O_DIRECTORY, $O_CLOEXEC, $O_NOCTTY, $O_NOFOLLOW) = (00200000, 02000000, 000 # TODO this needs some accessors to make it easier to define rulesets our %rule_sets = ( default => { - include => ['time_calls', 'file_readonly', 'stdio', 'exec_wrapper'], + include => ['time_calls', 'file_readonly', 'stdio', 'exec_wrapper', 'file_write', 'file_tty'], rules => [{syscall => 'mmap'}, {syscall => 'munmap'}, {syscall => 'mremap'}, @@ -73,16 +77,21 @@ our %rule_sets = ( ], }, + 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', args => [[qw|0 == 0|]]}, # STDIN - {syscall => 'write', args => [[qw|0 == 1|]]}, # STDOUT - {syscall => 'write', args => [[qw|0 == 2|]]}, + 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_args => [['1', '==', \'open_modes']]}, - {syscall => 'openat', permute_args => [['2', '==', \'open_modes']]}, + rules => [{syscall => 'open', permute_rules => [['1', '==', \'open_modes']]}, + {syscall => 'openat', permute_rules => [['2', '==', \'open_modes']]}, {syscall => 'close'}, {syscall => 'select'}, {syscall => 'read'}, @@ -159,14 +168,14 @@ our %rule_sets = ( push @rules, {syscall => 'execve', rules => [[0, '==', $strptr->($exec_map->{$version}{bin})]]}; } - return \@rules; + return @rules; }, # sub returns a valid arrayref. given our $self as first arg. }, # language master rules lang_perl => { rules => [], - include => ['default'], + include => ['default', 'perlmod_file_temp'], }, lang_ruby => { @@ -190,15 +199,15 @@ sub _process_rule { } sub _rec_get_rules { - my ($self, $profile, $used_sets, $permutes) = @_; + my ($self, $profile) = @_; - return () if ($used_sets->{$profile}); - $used_sets->{$profile} = 1; + 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"; + #print "getting profile $profile\n"; if (ref $rule_sets{$profile}{rules} eq 'ARRAY') { push @rules, @{$rule_sets{$profile}{rules}}; @@ -211,11 +220,11 @@ sub _rec_get_rules { } for my $perm (keys %{$rule_sets{$profile}{permute} // +{}}) { - push @{$permutes->{$perm}}, @{$rule_sets{$profile}{permute}{$perm}}; + push @{$self->_permutes->{$perm}}, @{$rule_sets{$profile}{permute}{$perm}}; } for my $include (@{$rule_sets{$profile}{include}//[]}) { - push @rules, $self->_rec_get_rules($include, $used_sets); + push @rules, $self->_rec_get_rules($include); } return @rules; @@ -224,16 +233,93 @@ sub _rec_get_rules { 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 - my %permutes; + my %gathered_rules; # computed rules for my $profile (@{$self->profiles}) { - - my @rules = $self->_rec_get_rules($profile, \%used_sets, \%permutes); - print Dumper({profile => $profile, rules=>\@rules, used_sets => \%used_sets, permutes => \%permutes}); + 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}} + } + + # TODO optimize for permissive rules + # e.g. write => OR write => [0, '==', 1] OR write => [0, '==', 2] becomes write => + + + my %comp_rules; + + for my $syscall (keys %gathered_rules) { + my @rules = @{$gathered_rules{$syscall}}; + for my $rule (@rules) { + print Dumper($rule); + 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}}, []; + } + } + } + + print Dumper({comp_rules=>\%comp_rules, used_sets => $self->_used_sets, permutes => $self->_permutes}); } # sub get_seccomp { From 71795844cd1e93e7d2e37b184ad0272bb340d190 Mon Sep 17 00:00:00 2001 From: Ryan Voots Date: Sat, 6 May 2017 01:56:12 -0700 Subject: [PATCH 5/5] IT WORKS --- lib/EvalServer/Seccomp.pm | 67 +++++++------------ lib/eval.pl | 136 +++----------------------------------- 2 files changed, 32 insertions(+), 171 deletions(-) diff --git a/lib/EvalServer/Seccomp.pm b/lib/EvalServer/Seccomp.pm index de7cfb8..1bffb39 100644 --- a/lib/EvalServer/Seccomp.pm +++ b/lib/EvalServer/Seccomp.pm @@ -72,7 +72,7 @@ our %rule_sets = ( {syscall => 'arch_prctl'}, {syscall => 'set_tid_address'}, {syscall => 'set_robust_list'}, - {syscall => 'futext'}, + {syscall => 'futex'}, {syscall => 'getrlimit'}, ], }, @@ -194,10 +194,6 @@ sub rule_add { $self->seccomp->rule_add(SCMP_ACT_ALLOW, Linux::Seccomp::syscall_resolve_name($name), @rules); } -sub _process_rule { - my ($self, $rule) = @_; -} - sub _rec_get_rules { my ($self, $profile) = @_; @@ -233,6 +229,8 @@ sub _rec_get_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}) { @@ -273,16 +271,12 @@ sub build_seccomp { @{$full_permute{$k}} = sort {$a <=> $b} uniq @{$full_permute{$k}} } - # TODO optimize for permissive rules - # e.g. write => OR write => [0, '==', 1] OR write => [0, '==', 2] becomes write => - my %comp_rules; for my $syscall (keys %gathered_rules) { my @rules = @{$gathered_rules{$syscall}}; for my $rule (@rules) { - print Dumper($rule); my $syscall = $rule->{syscall}; if (exists ($rule->{permute_rules})) { @@ -319,41 +313,26 @@ sub build_seccomp { } } - print Dumper({comp_rules=>\%comp_rules, used_sets => $self->_used_sets, permutes => $self->_permutes}); + # 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(); } -# 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; diff --git a/lib/eval.pl b/lib/eval.pl index 7081583..30ad7bf 100755 --- a/lib/eval.pl +++ b/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 - ## #include - ## - ## 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 $/; }; + # 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); - # Chomp code.. - $code =~ s/\s*$//; - + my ($profile) = ($type =~ /^(\w+)/g); + my $esc = EvalServer::Seccomp->new(profiles => ["lang_$profile"]); + $esc->engage(); + # Choose which type of evaluation to perform # will probably be a dispatch table soon. if( $type eq 'perl' or $type eq 'pl' ) {