From 0cda14300d79b8aad0045fdb1c1621b0b69ea578 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 13 Mar 2018 15:35:16 -0600 Subject: [PATCH] non-original code inspector => mark loaded bytecode as non-runnable This change adjusts the way that trust is threaded through bytecode and the code inspector. In Racket v6.x, reading bytecode would fail if the code inspector is non-original and if the bytecode contains a reference to an unsafe operation. Now, reading bytecode doesn't fail for that reason, but all bytecode is marked as non-runnable (even without references to unsafe operations) when loaded under a non-original code inspector. A `read` operation by itself remains as safe as ever. This commit also disables the bytecode validator. For now, the validate can be re-enabled with `PLT_VALIDATE_LOAD`. --- .../reference/code-inspectors.scrbl | 8 +- .../scribblings/reference/printer.scrbl | 43 +++++---- .../tests/racket/modprot.rktl | 31 +------ .../tests/racket/optimize.rktl | 90 ++++--------------- pkgs/racket-test/tests/racket/stress/fuzz.rkt | 5 +- racket/src/racket/src/linklet.c | 15 ++++ racket/src/racket/src/marshal.c | 5 +- racket/src/racket/src/read.c | 17 ++-- racket/src/racket/src/schpriv.h | 5 +- 9 files changed, 83 insertions(+), 136 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/code-inspectors.scrbl b/pkgs/racket-doc/scribblings/reference/code-inspectors.scrbl index b9d053bd20..db5c6eb4e9 100644 --- a/pkgs/racket-doc/scribblings/reference/code-inspectors.scrbl +++ b/pkgs/racket-doc/scribblings/reference/code-inspectors.scrbl @@ -57,5 +57,9 @@ requires control over the old one). @defparam[current-code-inspector insp inspector?]{ -A @tech{parameter} that determines an inspector to control access to module -bindings and redefinitions.} +A @tech{parameter} that determines an inspector to control access to +module bindings and redefinitions. + +If the code inspector is changed from its original value, then +bytecode loaded by the default @tech{compiled-load handler} is marked +as non-runnable.} diff --git a/pkgs/racket-doc/scribblings/reference/printer.scrbl b/pkgs/racket-doc/scribblings/reference/printer.scrbl index 5678a7ea50..2fdc269a51 100644 --- a/pkgs/racket-doc/scribblings/reference/printer.scrbl +++ b/pkgs/racket-doc/scribblings/reference/printer.scrbl @@ -560,12 +560,16 @@ be @tech{tainted} or @tech{armed}; the @litchar{#~}-marshaled form drops source-location information and properties (see @secref["stxprops"]) for the @tech{syntax objects}. -Compiled code parsed from @litchar{#~} may contain references to -unexported or protected bindings from a module. At read time, such -references are associated with the current code inspector (see -@racket[current-code-inspector]), and the code will only execute if -that inspector controls the relevant module invocation (see -@secref["modprotect"]). +Compiled code parsed from @litchar{#~} is marked as non-runnable if +the current code inspector (see @racket[current-code-inspector]) is +not the original code inspector; on attempting to evaluate or reoptimize +non-runnable bytecode, @exnraise[exn:fail]. Otherwise, compiled +code parsed from @litchar{#~} may contain references to unexported or +protected bindings from a module. Conceptually, the references in +bytecode are associated with the current code inspector, where the +code will only execute if that inspector controls the relevant module +invocation (see @secref["modprotect"])---but the original code +inspector controls all other inspectors, anyway. A compiled-form object may contain @tech{uninterned} symbols (see @secref["symbols"]) that were created by @racket[gensym] or @@ -587,17 +591,7 @@ identifiers either with @racket[generate-temporaries] or by applying the result of @racket[make-syntax-introducer] to an existing identifier; those functions lead to top-level and module variables with @tech{unreadable symbol}ic names, and the names are deterministic -as long as expansion is otherwise deterministic. - -Despite the problems inherent with @tech{uninterned} symbols as -variable names, they are partially supported even across multiple -@litchar{#~}s: When compiled code contains a reference to a module-defined -variable whose name is an @tech{uninterned} symbol, the relative -position of the variable among the module's definitions is recorded, -and the reference can be linked back to the definition based on its -position and the characters in its name. This accommodation works only -for variable references in compiled code; it does not work for -@racket[syntax]-quoted identifiers, for example. +as long as expansion is otherwise deterministic. Finally, a compiled form may contain path literals. Although paths are not normally printed in a way that can be read back in, path literals @@ -615,3 +609,18 @@ path is not relative to the value of the coerced to a string that preserves only part of the path (an in effort to make it less tied to the build-time filesystem, which can be different than the run-time filesystem). + +For internal testing purposes, when the +@as-index{@envvar{PLT_VALIDATE_LOAD}} environment variable is set, the +reader runs a validator on bytecode parsed from @litchar{#~}. The +validator may catch miscompilations or bytecode-file corruption. The +validtor may run lazily, such as checking a procedure only when the +procedure is called. + +@history[#:changed "6.90.0.21" @elem{Adjusted the effect of changing + the code inspector on parsed + bytecode, causing the reader to + mark the loaded code as generally + unrunnable instead of rejecting at + read time references to unsafe + operations.}] diff --git a/pkgs/racket-test-core/tests/racket/modprot.rktl b/pkgs/racket-test-core/tests/racket/modprot.rktl index 1fc17e3d04..4d189b2b05 100644 --- a/pkgs/racket-test-core/tests/racket/modprot.rktl +++ b/pkgs/racket-test-core/tests/racket/modprot.rktl @@ -222,11 +222,7 @@ (define (xeval e) (eval (if (bytes? e) - (parameterize ([read-accept-compiled #t] - ;; The read-time inspector is supposed to - ;; be irrelevant; only the declaration-time - ;; inspector should matter - [current-code-inspector (make-inspector)]) + (parameterize ([read-accept-compiled #t]) (read (open-input-bytes e))) e))) @@ -366,30 +362,7 @@ three/nabbed-c three/pnabbed-c three/snabbed-c three/nfnabbed-c three/nfpnabbed-c three/nfsnabbed-c three/normal-c current-code-inspector make-inspector #f #f #f #f #f) -(unsafe-try unsafe-c make-inspector #f #f #t) - -;; zo and source; changing inspector affects access in various ways----------------- - -(displayln "zo and source:") -(mp-try-all zero-zo one-zo two/no-protect-zo two/protect-zo - three/nabbed-zo three/pnabbed-zo three/snabbed-zo three/nfnabbed-zo three/nfpnabbed-zo three/nfsnabbed-zo - three/normal-zo - make-inspector current-code-inspector #t #f #f #f #t) -(unsafe-try unsafe-zo make-inspector #f #f #t) - -(displayln "source and zo, change inspector:") -(mp-try-all zero one two/no-protect two/protect - three/nabbed three/pnabbed three/snabbed-zo three/nfnabbed three/nfpnabbed three/nfsnabbed-zo - three/normal - current-code-inspector make-inspector #t #t #t #t #t - #:early-ok? #t) -(unsafe-try unsafe make-inspector #t #t #f) - -(displayln "zo, change inspector:") -(mp-try-all zero-zo one-zo two/no-protect-zo two/protect-zo - three/nabbed-zo three/pnabbed-zo three/snabbed-zo three/nfnabbed-zo three/nfpnabbed-zo three/nfsnabbed-zo - three/normal-zo - make-inspector make-inspector #t #t #f #f #f #:via-2-ok? #t) +(unsafe-try unsafe-c make-inspector #f #f #f) (displayln "just source, weaken inspector:") (mp-try-all zero one two/no-protect two/protect diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl index e609d14d8b..92cf898257 100644 --- a/pkgs/racket-test-core/tests/racket/optimize.rktl +++ b/pkgs/racket-test-core/tests/racket/optimize.rktl @@ -4975,8 +4975,8 @@ (err/rt-test (do-test-of-lift-fixpoint) exn:fail?) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; generate byecode with a lifted function that has -;; a boxed argument and rest args, to test that case +;; generate bytecode with a lifted function that has +;; a boxed argument and rest args, originally to test that case ;; of the validator (parameterize ([current-namespace (make-base-namespace)]) @@ -5023,65 +5023,6 @@ (test #t (dynamic-require ''check-tail-call-by-jit-for-struct-predicate 'go)) -;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Test bytecode validator's checking of constantness - -(let () - (define c1 - '(module c1 racket/kernel - ((if (zero? (random 1)) - (lambda (f) (display (f))) - #f) - (lambda () - ;; This access of i should raise an exception: - i)) - (define-values (i) (random 1)))) - - (define o (open-output-bytes)) - - (parameterize ([current-namespace (make-base-namespace)]) - (write (compile c1) o)) - - (define m (zo-parse (open-input-bytes (get-output-bytes o)))) - - (define o2 (open-output-bytes)) - - ;; construct bytecode that is broken by claiming that `i' is constant - ;; in the too-early reference: - (void - (write-bytes - (zo-marshal - (match m - [(linkl-bundle t) - (linkl-bundle - (hash-set t - 0 - (let* ([l (hash-ref t 0)] - [body (linkl-body l)]) - (struct-copy linkl l [body - (match body - [(list a b c) - (list (match a - [(application rator (list rand)) - (application - rator - (list - (struct-copy - lam rand - [body - (match (lam-body rand) - [(toplevel depth pos const? ready?) - (toplevel depth pos #t #t)])])))]) - b - c)])]))))])) - o2)) - - ;; validator should reject this at read or eval time (depending on how lazy validation is): - (err/rt-test (parameterize ([current-namespace (make-base-namespace)] - [read-accept-compiled #t]) - (eval (read (open-input-bytes (get-output-bytes o2))))) - exn:fail:read?)) - ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; make sure sfs pass doesn't add a nested begin0 ;; to clear the variables used in the first expression @@ -5123,8 +5064,8 @@ list))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Make sure compiler isn't too agressive for the validator -;; in terms of typed arguments: +;; Originally: make sure compiler isn't too agressive for the +;; validator in terms of typed arguments: (let ([m '(module m racket/base (require racket/flonum) @@ -5140,7 +5081,7 @@ (define o (open-output-bytes)) (write (compile m) o) (parameterize ([read-accept-compiled #t]) - ;; too-aggressive compilation produces a validator failure here + ;; too-aggressive compilation produced a validator failure here (read (open-input-bytes (get-output-bytes o))))) (when (extflonum-available?) @@ -5158,7 +5099,7 @@ (define o (open-output-bytes)) (write (compile m) o) (parameterize ([read-accept-compiled #t]) - ;; too-aggressive compilation produces a validator failure here + ;; too-aggressive compilation produced a validator failure here (read (open-input-bytes (get-output-bytes o)))))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -5368,7 +5309,7 @@ (test #t toplevel-const? v))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; The validator should understand that a structure +;; Originally: The validator should understand that a structure ;; constructor always succeeds: (let () @@ -5473,7 +5414,7 @@ (define n (fxmax (length l) 1)) (lambda _ n)))) o) - ;; Should succeed, as opposed to a validation error: + ;; Should succeed; once produced a validation error: (eval (read (open-input-bytes (get-output-bytes o)))))) (parameterize ([current-namespace (make-base-namespace)] @@ -5489,7 +5430,7 @@ (let ([n (fxmax (length '()) 1)]) (app (lambda _ (ident n)))))) o) - ;; Should succeed, as opposed to a validation error: + ;; Should succeed; once produced a validation error: (eval (read (open-input-bytes (get-output-bytes o)))))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -5608,8 +5549,8 @@ (void))))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Check that bytecode validator is consistent with respect to the -;; optimizer and special-casing of bitwise operators: +;; Originally: Check that bytecode validator is consistent with +;; respect to the optimizer and special-casing of bitwise operators: (let ([o (open-output-bytes)]) (write (compile @@ -5877,8 +5818,8 @@ (void proc proc))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Make sure validation doesn't fail for importing a setter of a -;; structure type that has auto fields: +;; Originally: Make sure validation doesn't fail for importing a +;; setter of a structure type that has auto fields: (module provides-a-mutator-for-a-struct-with-an-auto-field racket/base (provide foo set-foo-y!) @@ -5955,9 +5896,8 @@ bar) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Check that `string-append` on a known-string argument -;; is not treated consistently by the optimzier and -;; validator +;; Originally: Check that `string-append` on a known-string argument +;; is not treated consistently by the optimzier and validator (let ([c (compile '(module m racket/base diff --git a/pkgs/racket-test/tests/racket/stress/fuzz.rkt b/pkgs/racket-test/tests/racket/stress/fuzz.rkt index 619c8968c1..61468f0809 100644 --- a/pkgs/racket-test/tests/racket/stress/fuzz.rkt +++ b/pkgs/racket-test/tests/racket/stress/fuzz.rkt @@ -15,8 +15,9 @@ (custodian-limit-memory (current-custodian) (* 512 (expt 2 20))) (with-handlers ([void void]) - (parameterize ([read-accept-compiled #t]) - (with-input-from-bytes bs read)))))))) + (eval (parameterize ([read-accept-compiled #t] + [current-code-inspector (make-inspector)]) + (with-input-from-bytes bs read))))))))) (define (run-file fname seed0 #:write? [out-fname? #f]) (define seed (or seed0 (+ 1 (random (expt 2 30))))) diff --git a/racket/src/racket/src/linklet.c b/racket/src/racket/src/linklet.c index 1c5f6f3f83..bbfc83237d 100644 --- a/racket/src/racket/src/linklet.c +++ b/racket/src/racket/src/linklet.c @@ -323,6 +323,15 @@ static Scheme_Object *linklet_p(int argc, Scheme_Object **argv) : scheme_false); } +static void check_linklet_allowed(const char *who, Scheme_Linklet *linklet) +{ + if (linklet->reject_eval) { + scheme_raise_exn(MZEXN_FAIL, + "%s: cannot use linklet loaded with non-original code inspector", + who); + } +} + void extract_import_info(const char *who, int argc, Scheme_Object **argv, Scheme_Object **_import_keys, Scheme_Object **_get_import) { @@ -395,6 +404,8 @@ static Scheme_Object *recompile_linklet(int argc, Scheme_Object **argv) linklet = (Scheme_Linklet *)argv[0]; + check_linklet_allowed("recompile-linklet", linklet); + extract_import_info("recompile-linklet", argc, argv, &import_keys, &get_import); if ((argc > 1) && SCHEME_TRUEP(argv[1])) @@ -434,6 +445,9 @@ static Scheme_Object *eval_linklet(int argc, Scheme_Object **argv) scheme_wrong_contract("eval-linklet", "linklet?", 0, argc, argv); linklet = (Scheme_Linklet *)argv[0]; + + check_linklet_allowed("eval-linklet", linklet); + if (!linklet->jit_ready) { Scheme_Object *b; b = scheme_get_param(scheme_current_config(), MZCONFIG_USE_JIT); @@ -476,6 +490,7 @@ static Scheme_Object *instantiate_linklet(int argc, Scheme_Object **argv) scheme_wrong_contract("instantiate-linklet", "(listof instance?)", 1, argc, argv); linklet = (Scheme_Linklet *)argv[0]; + check_linklet_allowed("instantiate-linklet", linklet); num_importss = SCHEME_VEC_SIZE(linklet->importss); if (len != num_importss) scheme_contract_error("instantiate-linklet", diff --git a/racket/src/racket/src/marshal.c b/racket/src/racket/src/marshal.c index e1f3d15941..9b04e78cbe 100644 --- a/racket/src/racket/src/marshal.c +++ b/racket/src/racket/src/marshal.c @@ -422,7 +422,7 @@ static Scheme_Object *vector_to_hash_tree(Scheme_Object *vec) return (Scheme_Object *)ht; } -Scheme_Object *scheme_read_linklet(Scheme_Object *obj) +Scheme_Object *scheme_read_linklet(Scheme_Object *obj, int unsafe_ok) { Scheme_Linklet *linklet = (Scheme_Linklet *)obj; Scheme_Object *e, *a; @@ -503,5 +503,8 @@ Scheme_Object *scheme_read_linklet(Scheme_Object *obj) return_NULL(); } + if (!unsafe_ok) + linklet->reject_eval = 1; + return (Scheme_Object *)linklet; } diff --git a/racket/src/racket/src/read.c b/racket/src/racket/src/read.c index 14beb56f34..483a0fc6b4 100644 --- a/racket/src/racket/src/read.c +++ b/racket/src/racket/src/read.c @@ -1,4 +1,4 @@ - /* +/* Racket Copyright (c) 2004-2018 PLT Design Inc. Copyright (c) 1995-2001 Matthew Flatt @@ -61,6 +61,7 @@ SHARED_OK int scheme_square_brackets_are_parens = 1; SHARED_OK int scheme_curly_braces_are_parens = 1; /* global flag set from environment variable */ SHARED_OK static int use_perma_cache = 1; +SHARED_OK static int validate_loaded_linklet = 0; THREAD_LOCAL_DECL(int scheme_num_read_syntax_objects = 0); @@ -296,9 +297,10 @@ void scheme_init_read(Scheme_Startup_Env *env) ADD_NONCM_PRIM("datum-intern-literal", read_intern, 1, 1, env); - if (getenv("PLT_DELAY_FROM_ZO")) { + if (getenv("PLT_DELAY_FROM_ZO")) use_perma_cache = 0; - } + if (getenv("PLT_VALIDATE_LOAD")) + validate_loaded_linklet = 0; } void scheme_init_variable_references_constants() @@ -2783,7 +2785,7 @@ static Scheme_Object *read_compact(CPort *port, int use_stack) case CPT_LINKLET: { v = read_compact(port, 1); - v = scheme_read_linklet(v); + v = scheme_read_linklet(v, port->unsafe_ok); if (!v) scheme_ill_formed_code(port); return v; } @@ -2794,9 +2796,6 @@ static Scheme_Object *read_compact(CPort *port, int use_stack) case CPT_REFERENCE: l = read_compact_number(port); RANGE_CHECK(l, < EXPECTED_PRIM_COUNT); - if ((l >= unsafe_variable_references_start) - && !port->unsafe_ok) - unsafe_disallowed(port); return variable_references[l]; break; case CPT_TOPLEVEL: @@ -3979,7 +3978,9 @@ static Scheme_Object *read_compiled(Scheme_Object *port, i = scheme_hash_tree_next(t, -1); while (i != -1) { scheme_hash_tree_index(t, i, &key, &val); - if (SAME_TYPE(SCHEME_TYPE(val), scheme_linklet_type)) + if (validate_loaded_linklet + && SAME_TYPE(SCHEME_TYPE(val), scheme_linklet_type) + && !((Scheme_Linklet *)val)->reject_eval) scheme_validate_linklet(rp, (Scheme_Linklet *)val); i = scheme_hash_tree_next(t, i); } diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 3cb721d2b8..b9da4b1968 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -463,7 +463,7 @@ Scheme_Object *scheme_read_lambda(int flags, int closure_size, int num_params, i Scheme_Object *closure_map, Scheme_Object *tl_map); Scheme_Object *scheme_write_linklet(Scheme_Object *obj); -Scheme_Object *scheme_read_linklet(Scheme_Object *obj); +Scheme_Object *scheme_read_linklet(Scheme_Object *obj, int unsafe_ok); extern Scheme_Equal_Proc *scheme_type_equals; extern Scheme_Primary_Hash_Proc *scheme_type_hash1s; @@ -3271,7 +3271,8 @@ struct Scheme_Linklet int max_let_depth; int need_instance_access; /* whether the instance-access toplevel is needed */ - int jit_ready; /* true if the linklet is in has been prepared for the JIT */ + char jit_ready; /* true if the linklet is in has been prepared for the JIT */ + char reject_eval; /* true when loaded without the root inspector, for example */ Scheme_Hash_Table *constants; /* holds info about the linklet's body for inlining */ };