Improved sandboxing with code from Eli.

This commit is contained in:
Vincent St-Amour 2010-08-27 16:55:31 -04:00
parent f06c2d4926
commit b386f01ee4

View File

@ -1,6 +1,13 @@
#lang racket #lang racket
(require racket/runtime-path racket/sandbox) (require racket/runtime-path racket/sandbox)
(define prog-rx
(pregexp (string-append "^\\s*"
"(#lang typed/(?:scheme|racket)(?:/base)?)"
"\\s+"
"#:optimize"
"\\s+")))
(define (evaluator file #:optimize [optimize? #f]) (define (evaluator file #:optimize [optimize? #f])
(call-with-trusted-sandbox-configuration (call-with-trusted-sandbox-configuration
(lambda () (lambda ()
@ -12,14 +19,15 @@
'typed/racket 'typed/racket
'typed/scheme)]) 'typed/scheme)])
;; drop the #lang line ;; drop the #lang line
(let* ((prog (regexp-replace #rx"^#lang typed/(scheme|racket)(/base)?" (let* ([prog (file->string file)]
(file->string file) "")) ;; drop the #lang line and #:optimize
(in (if optimize? [m (or (regexp-match-positions prog-rx prog)
prog (error 'evaluator "bad program contents in ~e" file))]
;; drop the #:optimize [prog (string-append (substring prog (caadr m) (cdadr m))
(regexp-replace #rx"#:optimize" prog ""))) (if optimize? "\n#:optimize\n" "\n")
(evaluator (make-evaluator 'typed/racket in)) (substring prog (cdar m)))]
(out (get-output evaluator))) [evaluator (make-module-evaluator prog)]
[out (get-output evaluator)])
(kill-evaluator evaluator) (kill-evaluator evaluator)
out))))) out)))))