From b1a5c8670292f310727ccb0a75f6762a1b536586 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 29 Jun 2019 09:04:27 -0600 Subject: [PATCH] cs: disable bytecode loaded with a non-original code inspector Racket CS now passes all tests in the core Racket test suite. --- pkgs/racket-test-core/tests/racket/sandbox.rktl | 6 ++---- racket/src/cs/linklet.sls | 11 ++++++++--- racket/src/cs/linklet/read.ss | 16 +++++++++++++--- racket/src/cs/linklet/write.ss | 9 +++++---- racket/src/cs/rumble.sls | 1 + 5 files changed, 29 insertions(+), 14 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/sandbox.rktl b/pkgs/racket-test-core/tests/racket/sandbox.rktl index 6d6b9236bc..90fcc30e2c 100644 --- a/pkgs/racket-test-core/tests/racket/sandbox.rktl +++ b/pkgs/racket-test-core/tests/racket/sandbox.rktl @@ -462,9 +462,7 @@ (copy-file ,test-zo ,list-zo) =err> "access denied" ;; timestamp .zo file (needed under Windows): (file-or-directory-modify-seconds ,test-zo (current-seconds)) - ;; loading test gets 'list module declaration via ".zo", thanks - ;; to delayed parsing of the bytecode (so this test doesn't work - ;; if delay-loading is disabled): + ;; loading 'test gets 'list module declaration via ".zo" (load/use-compiled ,test-lib) =err> "cannot use linklet loaded with non-original code inspector" (delete-file ,test-zo) => (void) (delete-file ,test-lib) =err> "`delete' access denied" @@ -480,7 +478,7 @@ (when (file-exists? to) (delete-file to)) (copy-file from to)) (cp ,list-lib ,test-lib) (cp ,list-zo ,test-zo) - (cp ,list-lib ,test2-lib) (cp ,list-zo ,test2-zo) + (cp ,list-lib ,test2-lib) (cp ,list-zo ,test2-zo) ;; bytecode from test-lib is bad, even when we can read/write to it (load/use-compiled ,test-zo) =err> "cannot use linklet loaded with non-original code inspector" ;; bytecode from test2-lib is explicitly allowed diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls index 5b2ec439d5..a4befe3ecd 100644 --- a/racket/src/cs/linklet.sls +++ b/racket/src/cs/linklet.sls @@ -436,7 +436,7 @@ (fields (mutable code) ; the procedure or interpretable form paths ; list of paths; if non-empty, `code` expects them as arguments format ; 'compile or 'interpret (where the latter may have compiled internal parts) - (mutable preparation) ; 'faslable, 'faslable-strict, 'callable, 'lazy, or (cons 'cross ) + (mutable preparation) ; 'faslable, 'faslable-strict, 'faslable-unsafe, 'callable, 'lazy, or (cons 'cross ) importss-abi ; ABI for each import, in parallel to `importss` (mutable exports-info) ; hash(sym -> known) for info about export; see "known.rkt"; unfasl on demand name ; name of the linklet (for debugging purposes) @@ -654,7 +654,7 @@ (if import-keys (values lnk import-keys) lnk)])) - + ;; Intended to speed up reuse of a linklet in exchange for not being ;; able to serialize anymore (define (eval-linklet linklet) @@ -665,9 +665,14 @@ (set-linklet-code linklet (eval-from-bytevector (linklet-code linklet) (linklet-paths linklet) (linklet-format linklet)) 'callable)] + [(faslable-unsafe) + (raise (|#%app| + exn:fail + "eval-linklet: cannot use linklet loaded with non-original code inspector" + (current-continuation-marks)))] [else linklet])) - + (define instantiate-linklet (case-lambda [(linklet import-instances) diff --git a/racket/src/cs/linklet/read.ss b/racket/src/cs/linklet/read.ss index da4793da31..126d351958 100644 --- a/racket/src/cs/linklet/read.ss +++ b/racket/src/cs/linklet/read.ss @@ -33,9 +33,19 @@ (define (adjust-linklet-laziness linklet) (set-linklet-code linklet (linklet-code linklet) - (if (|#%app| read-on-demand-source) - 'faslable - 'faslable-strict))) + (cond + [(not (eq? root-inspector (|#%app| current-code-inspector))) + ;; Originally, the idea was that bytecode can be loaded in + ;; a non-original code inspector as long as it doesn't refer + ;; to unsafe operation. But increasing use of compilation to + ;; unsafe operations, not to mention compilation to machine + ;; code, means that all "bytecode" is unsafe: + 'faslable-unsafe] + [(|#%app| read-on-demand-source) + ;; Remember that the linklet can be lazier: + 'faslable] + [else + 'faslable-strict]))) (define (decode-linklet-paths linklet) (let ([paths (linklet-paths linklet)]) diff --git a/racket/src/cs/linklet/write.ss b/racket/src/cs/linklet/write.ss index 1dc1535987..e860d9ad2a 100644 --- a/racket/src/cs/linklet/write.ss +++ b/racket/src/cs/linklet/write.ss @@ -40,8 +40,9 @@ (let ([prep (linklet-preparation v)]) (and (pair? prep) (cdr prep)))))))))])))) -;; Before fasl conversion, change 'cross to 'faslable +;; Before fasl conversion, change 'cross or 'faslable-unsafe to 'faslable (define (adjust-cross-perparation l) - (if (pair? (linklet-preparation l)) - (set-linklet-preparation l 'faslable) - l)) + (let ([p (linklet-preparation l)]) + (if (or (pair? p) (eq? p 'faslable-unsafe)) + (set-linklet-preparation l 'faslable) + l))) diff --git a/racket/src/cs/rumble.sls b/racket/src/cs/rumble.sls index a848d109e4..963ac00de3 100644 --- a/racket/src/cs/rumble.sls +++ b/racket/src/cs/rumble.sls @@ -89,6 +89,7 @@ make-inspector make-sibling-inspector current-code-inspector + root-inspector ; not exported to Racket struct:exn exn exn? exn-message exn-continuation-marks struct:exn:break exn:break exn:break? exn:break-continuation