suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

move the reader of make-module-evaluator inside the user context jail

Browse Source 
svn: r11963
This commit is contained in:
Eli Barzilay 2008-10-07 14:20:18 +00:00
parent bbceacae84
commit 98975fc524
1 changed files with 19 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
collects/scheme/sandbox.ss
View File

@ -430,7 +430,7 @@
(define-evaluator-messenger get-error-output 'error-output)
(define-evaluator-messenger (get-uncovered-expressions . xs) 'uncovered)
(define (make-evaluator* init-hook require-perms program-or-maker)
(define (make-evaluator* init-hook require-perms program-maker)
(define cust (make-custodian))
(define coverage? (sandbox-coverage-enabled))
(define uncovered #f)
@ -458,7 +458,7 @@
((sandbox-init-hook))
;; now read and evaluate the input program
(evaluate-program
(if (procedure? program-or-maker) (program-or-maker) program-or-maker)
(if (procedure? program-maker) (program-maker) program-maker)
limits
(and coverage? (lambda (es+get) (set! uncovered es+get))))
(channel-put result-ch 'ok))
@ -629,19 +629,21 @@
(define (make-module-evaluator
input-program #:allow-read [allow null] #:language [reqlang #f])
;; this is for a complete module input program
(let ([prog (input->code (list input-program) 'program #f)])
(unless (= 1 (length prog))
(error 'make-evaluator "expecting a single `module' program; ~a"
(if (zero? (length prog))
"no program expressions given"
"got more than a single expression")))
(syntax-case* (car prog) (module) literal-identifier=?
[(module modname lang body ...)
(if (or (not reqlang) (equal? reqlang (syntax->datum #'lang)))
(make-evaluator* void allow (car prog))
(error 'make-evaluator
"module code used `~e' for a language, expecting `~e'"
(syntax->datum #'lang) reqlang))]
[_else (error 'make-evaluator "expecting a `module' program; got ~e"
(syntax->datum (car prog)))])))
(define (make-program)
(let ([prog (input->code (list input-program) 'program #f)])
(unless (= 1 (length prog))
(error 'make-evaluator "expecting a single `module' program; ~a"
(if (zero? (length prog))
"no program expressions given"
"got more than a single expression")))
(syntax-case* (car prog) (module) literal-identifier=?
[(module modname lang body ...)
(if (or (not reqlang) (equal? reqlang (syntax->datum #'lang)))
(car prog)
(error 'make-evaluator
"module code used `~e' for a language, expecting `~e'"
(syntax->datum #'lang) reqlang))]
[_else (error 'make-evaluator "expecting a `module' program; got ~e"
(syntax->datum (car prog)))])))
(make-evaluator* void allow make-program))