From 98975fc524d322882745117b71cdb761039493f4 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Tue, 7 Oct 2008 14:20:18 +0000 Subject: [PATCH] move the reader of make-module-evaluator inside the user context jail svn: r11963 --- collects/scheme/sandbox.ss | 36 +++++++++++++++++++----------------- 1 file changed, 19 insertions(+), 17 deletions(-) diff --git a/collects/scheme/sandbox.ss b/collects/scheme/sandbox.ss index a4ce87fc05..3cf6b807a1 100644 --- a/collects/scheme/sandbox.ss +++ b/collects/scheme/sandbox.ss @@ -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))