Basic sandboxing

db4
Maxim Savchenko 2009-04-01 19:11:08 -04:00
parent 422eb03fb4
commit 509399b620
5 changed files with 108 additions and 0 deletions

View File

@ -0,0 +1 @@
Maxim Savchenko

View File

@ -0,0 +1,57 @@
! Copyright (C) 2009 Maxim Savchenko
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors continuations lexer vocabs vocabs.parser
combinators.short-circuit sandbox tools.test ;
IN: sandbox.tests
<< "sandbox.syntax" load-vocab drop >>
USE: sandbox.syntax.private
: run-script ( x lines -- y )
H{ { "kernel" "kernel" } { "math" "math" } { "sequences" "sequences" } }
parse-sandbox call( x -- x! ) ;
[ 120 ]
[
5
{
"! Simple factorial example"
"APPLYING: kernel math sequences ;"
"1 swap [ 1+ * ] each"
} run-script
] unit-test
[
5
{
"! Jailbreak attempt with USE:"
"USE: io"
"\"Hello world!\" print"
} run-script
]
[
{
[ lexer-error? ]
[ error>> condition? ]
[ error>> error>> no-word-error? ]
[ error>> error>> name>> "USE:" = ]
} 1&&
] must-fail-with
[
5
{
"! Jailbreak attempt with unauthorized APPLY:"
"APPLY: io"
"\"Hello world!\" print"
} run-script
]
[
{
[ lexer-error? ]
[ error>> sandbox-error? ]
[ error>> vocab>> "io" = ]
} 1&&
] must-fail-with

View File

@ -0,0 +1,23 @@
! Copyright (C) 2009 Maxim Savchenko.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences vectors assocs namespaces parser lexer vocabs
combinators.short-circuit vocabs.parser ;
IN: sandbox
SYMBOL: whitelist
: with-sandbox-vocabs ( quot -- )
"sandbox.syntax" load-vocab vocab-words 1vector
use [ call ] with-variable ; inline
: parse-sandbox ( lines assoc -- quot )
whitelist [ [ parse-lines ] with-sandbox-vocabs ] with-variable ;
: reveal-in ( name -- )
[ { [ search ] [ no-word ] } 1|| ] keep current-vocab vocab-words set-at ;
SYNTAX: REVEAL: scan reveal-in ;
SYNTAX: REVEALING: ";" parse-tokens [ reveal-in ] each ;

View File

@ -0,0 +1 @@
Basic sandboxing

View File

@ -0,0 +1,26 @@
! Copyright (C) 2009 Maxim Savchenko.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences assocs namespaces lexer vocabs.parser sandbox ;
IN: sandbox.syntax
<PRIVATE
ERROR: sandbox-error vocab ;
: sandbox-use+ ( alias -- )
dup whitelist get at [ use+ ] [ sandbox-error ] ?if ;
PRIVATE>
SYNTAX: APPLY: scan sandbox-use+ ;
SYNTAX: APPLYING: ";" parse-tokens [ sandbox-use+ ] each ;
REVEALING:
! #!
HEX: OCT: BIN: f t CHAR: "
[ { T{
] } ;
REVEAL: ;