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`.
This commit is contained in:
Matthew Flatt
parent
85ff4eee74
commit
0cda14300d
|
|
@ -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.}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -589,16 +593,6 @@ 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.
|
||||
|
||||
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
|
||||
can be written and read as part of compiled code. The
|
||||
|
|
@ -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.}]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
|
|
|||
|
|
@ -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",
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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 */
|
||||
};
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user