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

fix protected/unexported access check

Browse Source
This commit is contained in:
Matthew Flatt 2012-09-19 07:43:56 -06:00
parent e68db772b2
commit f82a19c963
6 changed files with 46 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/racket/src/env.c
View File

@ -766,7 +766,7 @@ void scheme_prepare_env_renames(Scheme_Env *env, int kind)
if (!env->rename_set) { if (!env->rename_set) {
Scheme_Object *rns, *insp; Scheme_Object *rns, *insp;
insp = env->insp; insp = env->access_insp;
if (!insp) if (!insp)
insp = scheme_get_param(scheme_current_config(), MZCONFIG_CODE_INSPECTOR); insp = scheme_get_param(scheme_current_config(), MZCONFIG_CODE_INSPECTOR);
@ -906,7 +906,8 @@ void scheme_prepare_exp_env(Scheme_Env *env)
eenv->module = env->module; eenv->module = env->module;
eenv->module_registry = env->module_registry; eenv->module_registry = env->module_registry;
eenv->module_pre_registry = env->module_pre_registry; eenv->module_pre_registry = env->module_pre_registry;
eenv->insp = env->insp; eenv->access_insp = env->access_insp;
eenv->guard_insp = env->guard_insp;
modchain = SCHEME_VEC_ELS(env->modchain)[1]; modchain = SCHEME_VEC_ELS(env->modchain)[1];
if (SCHEME_FALSEP(modchain)) { if (SCHEME_FALSEP(modchain)) {
@ -948,7 +949,8 @@ void scheme_prepare_template_env(Scheme_Env *env)
eenv->module = env->module; eenv->module = env->module;
eenv->module_registry = env->module_registry; eenv->module_registry = env->module_registry;
eenv->module_pre_registry = env->module_pre_registry; eenv->module_pre_registry = env->module_pre_registry;
eenv->insp = env->insp; eenv->guard_insp = env->guard_insp;
eenv->access_insp = env->access_insp;
modchain = SCHEME_VEC_ELS(env->modchain)[2]; modchain = SCHEME_VEC_ELS(env->modchain)[2];
if (SCHEME_FALSEP(modchain)) { if (SCHEME_FALSEP(modchain)) {
@ -989,7 +991,8 @@ void scheme_prepare_label_env(Scheme_Env *env)
lenv->module = env->module; lenv->module = env->module;
lenv->module_registry = env->module_registry; lenv->module_registry = env->module_registry;
lenv->module_pre_registry = env->module_pre_registry; lenv->module_pre_registry = env->module_pre_registry;
lenv->insp = env->insp; lenv->guard_insp = env->guard_insp;
lenv->access_insp = env->access_insp;
modchain = scheme_make_vector(5, scheme_false); modchain = scheme_make_vector(5, scheme_false);
prev_modules = scheme_make_hash_table(SCHEME_hash_ptr); prev_modules = scheme_make_hash_table(SCHEME_hash_ptr);
@ -1022,7 +1025,8 @@ Scheme_Env *scheme_copy_module_env(Scheme_Env *menv, Scheme_Env *ns, Scheme_Obje
menv2->module = menv->module; menv2->module = menv->module;
menv2->module_registry = ns->module_registry; menv2->module_registry = ns->module_registry;
menv2->module_pre_registry = ns->module_pre_registry; menv2->module_pre_registry = ns->module_pre_registry;
menv2->insp = menv->insp; menv2->guard_insp = menv->guard_insp;
menv2->access_insp = menv->access_insp;
menv2->instance_env = menv2; menv2->instance_env = menv2;
@ -1764,7 +1768,7 @@ static Scheme_Object *do_variable_namespace(const char *who, int tl, int argc, S
"variable reference", 1, v, "variable reference", 1, v,
NULL); NULL);
} }
return env->module->insp; return env->access_insp;
} else if (tl) { } else if (tl) {
/* return env directly; need to set up */ /* return env directly; need to set up */
if (!env->phase && env->module) if (!env->phase && env->module)
@ -2437,7 +2441,7 @@ Scheme_Object *scheme_get_local_inspector()
Scheme_Thread *p = scheme_current_thread; Scheme_Thread *p = scheme_current_thread;
if (p->current_local_menv) if (p->current_local_menv)
return p->current_local_menv->module->insp; return p->current_local_menv->access_insp;
else else
return scheme_get_param(scheme_current_config(), MZCONFIG_CODE_INSPECTOR); return scheme_get_param(scheme_current_config(), MZCONFIG_CODE_INSPECTOR);
} }

4
src/racket/src/eval.c
View File

@ -921,7 +921,7 @@ static Scheme_Object *link_toplevel(Scheme_Object **exprs, int which, Scheme_Env
else else
return link_module_variable(home->module->modname, return link_module_variable(home->module->modname,
(Scheme_Object *)b->key, (Scheme_Object *)b->key,
1, home->module->insp, 1, home->access_insp,
-1, home->mod_phase, -1, home->mod_phase,
env, env,
exprs, which, exprs, which,
@ -5493,7 +5493,7 @@ Scheme_Object **scheme_push_prefix(Scheme_Env *genv, Resolve_Prefix *rp,
scheme_check_unsafe_accessible((SCHEME_FALSEP(rp->uses_unsafe) scheme_check_unsafe_accessible((SCHEME_FALSEP(rp->uses_unsafe)
? (insp ? (insp
? insp ? insp
: genv->insp) : genv->access_insp)
: rp->uses_unsafe), : rp->uses_unsafe),
genv); genv);
} }

46
src/racket/src/module.c
View File

@ -500,7 +500,8 @@ void scheme_finish_kernel(Scheme_Env *env)
Scheme_Object *insp; Scheme_Object *insp;
insp = scheme_get_current_inspector(); insp = scheme_get_current_inspector();
env->insp = insp; env->guard_insp = insp; /* nothing is protected, anyway */
env->access_insp = insp;
kernel->insp = insp; kernel->insp = insp;
} }
@ -1219,7 +1220,7 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
if (protected) { if (protected) {
Scheme_Object *insp; Scheme_Object *insp;
insp = scheme_get_param(scheme_current_config(), MZCONFIG_CODE_INSPECTOR); insp = scheme_get_param(scheme_current_config(), MZCONFIG_CODE_INSPECTOR);
if (scheme_module_protected_wrt(menv->insp, insp)) if (scheme_module_protected_wrt(menv->guard_insp, insp))
scheme_contract_error(errname, scheme_contract_error(errname,
"name is protected", "name is protected",
"name", 1, name, "name", 1, name,
@ -2191,9 +2192,9 @@ static Scheme_Object *namespace_unprotect_module(int argc, Scheme_Object *argv[]
NULL); NULL);
} }
if (!scheme_module_protected_wrt(menv2->insp, insp) && !menv2->attached) { if (!scheme_module_protected_wrt(menv2->guard_insp, insp) && !menv2->attached) {
code_insp = scheme_make_inspector(code_insp); code_insp = scheme_make_inspector(code_insp);
menv2->insp = code_insp; menv2->guard_insp = code_insp;
} }
} }
@ -2924,7 +2925,7 @@ void scheme_prep_namespace_rename(Scheme_Env *menv)
for (i = SCHEME_VEC_SIZE(vec); i--; ) { for (i = SCHEME_VEC_SIZE(vec); i--; ) {
rn_stx = SCHEME_VEC_ELS(vec)[i]; rn_stx = SCHEME_VEC_ELS(vec)[i];
rns = scheme_stx_to_rename(rn_stx); rns = scheme_stx_to_rename(rn_stx);
rns = scheme_stx_shift_rename_set(rns, midx, m->self_modidx, m->insp); rns = scheme_stx_shift_rename_set(rns, midx, m->self_modidx, menv->access_insp);
rn_stx = scheme_rename_to_stx(rns); rn_stx = scheme_rename_to_stx(rns);
SCHEME_VEC_ELS(vec2)[i] = rn_stx; SCHEME_VEC_ELS(vec2)[i] = rn_stx;
} }
@ -2983,7 +2984,7 @@ Scheme_Object *scheme_module_to_namespace(Scheme_Object *name, Scheme_Env *env)
{ {
Scheme_Object *insp; Scheme_Object *insp;
insp = scheme_get_param(scheme_current_config(), MZCONFIG_CODE_INSPECTOR); insp = scheme_get_param(scheme_current_config(), MZCONFIG_CODE_INSPECTOR);
if (scheme_module_protected_wrt(menv->insp, insp) || menv->attached) { if (scheme_module_protected_wrt(menv->guard_insp, insp) || menv->attached) {
scheme_contract_error("module->namespace", scheme_contract_error("module->namespace",
"current code inspector cannot access namespace of module", "current code inspector cannot access namespace of module",
"module name", 1, name, "module name", 1, name,
@ -4211,9 +4212,9 @@ static void check_certified(Scheme_Object *stx,
int need_cert = 1; int need_cert = 1;
if (need_cert && insp) if (need_cert && insp)
need_cert = scheme_module_protected_wrt(env->insp, insp); need_cert = scheme_module_protected_wrt(env->guard_insp, insp);
if (need_cert && rename_insp) if (need_cert && rename_insp)
need_cert = scheme_module_protected_wrt(env->insp, rename_insp); need_cert = scheme_module_protected_wrt(env->guard_insp, rename_insp);
if (need_cert) { if (need_cert) {
if (_would_complain) { if (_would_complain) {
@ -4322,7 +4323,7 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
&& !memcmp(SCHEME_SYM_VAL(isym), SCHEME_SYM_VAL(symbol), SCHEME_SYM_LEN(isym)))) { && !memcmp(SCHEME_SYM_VAL(isym), SCHEME_SYM_VAL(symbol), SCHEME_SYM_LEN(isym)))) {
if ((position < pt->num_var_provides) if ((position < pt->num_var_provides)
&& scheme_module_protected_wrt(env->insp, prot_insp)) { && scheme_module_protected_wrt(env->guard_insp, prot_insp)) {
char *provide_protects; char *provide_protects;
if ((env->mod_phase >= 0) && (env->mod_phase < env->module->num_phases)) if ((env->mod_phase >= 0) && (env->mod_phase < env->module->num_phases))
@ -4471,7 +4472,7 @@ void scheme_check_unsafe_accessible(Scheme_Object *insp, Scheme_Env *from_env)
for (i = t->count; i--; ) { for (i = t->count; i--; ) {
scheme_hash_tree_index(t, i, &k, &v); scheme_hash_tree_index(t, i, &k, &v);
insp = k; insp = k;
if (scheme_module_protected_wrt(unsafe_env->insp, insp)) { if (scheme_module_protected_wrt(unsafe_env->guard_insp, insp)) {
break; break;
} }
} }
@ -4480,7 +4481,7 @@ void scheme_check_unsafe_accessible(Scheme_Object *insp, Scheme_Env *from_env)
return; return;
} }
if (!insp || scheme_module_protected_wrt(unsafe_env->insp, insp)) { if (!insp || scheme_module_protected_wrt(unsafe_env->guard_insp, insp)) {
scheme_wrong_syntax("link", scheme_wrong_syntax("link",
NULL, NULL, NULL, NULL,
"attempt to access unsafe bindings from an untrusted context"); "attempt to access unsafe bindings from an untrusted context");
@ -5083,8 +5084,9 @@ static Scheme_Env *instantiate_module(Scheme_Module *m, Scheme_Env *env, int res
env2->module = m; env2->module = m;
} }
menv->access_insp = m->insp;
insp = scheme_make_inspector(m->insp); insp = scheme_make_inspector(m->insp);
menv->insp = insp; menv->guard_insp = insp;
/* These three should be set by various "finish"es, but /* These three should be set by various "finish"es, but
we initialize them in case there's an error running a "finish". */ we initialize them in case there's an error running a "finish". */
@ -5212,7 +5214,7 @@ void *scheme_module_exprun_finish(Scheme_Env *menv, int at_phase)
syntax = menv->syntax; syntax = menv->syntax;
rhs_env = scheme_new_comp_env(menv, menv->module->insp, SCHEME_TOPLEVEL_FRAME); rhs_env = scheme_new_comp_env(menv, menv->access_insp, SCHEME_TOPLEVEL_FRAME);
cnt = SCHEME_VEC_SIZE(menv->module->bodies[at_phase]); cnt = SCHEME_VEC_SIZE(menv->module->bodies[at_phase]);
for (i = 0; i < cnt; i++) { for (i = 0; i < cnt; i++) {
@ -5235,7 +5237,7 @@ void *scheme_module_exprun_finish(Scheme_Env *menv, int at_phase)
eval_exptime(names, len, e, exp_env, rhs_env, eval_exptime(names, len, e, exp_env, rhs_env,
rp, let_depth, 1, (for_stx ? NULL : syntax), at_phase, rp, let_depth, 1, (for_stx ? NULL : syntax), at_phase,
scheme_false, menv->module->insp); scheme_false, menv->access_insp);
} }
return NULL; return NULL;
@ -5544,7 +5546,7 @@ void *scheme_module_run_finish(Scheme_Env *menv, Scheme_Env *env)
save_runstack = scheme_push_prefix(menv, m->prefix, save_runstack = scheme_push_prefix(menv, m->prefix,
m->me->src_modidx, menv->link_midx, m->me->src_modidx, menv->link_midx,
0, menv->phase, NULL, 0, menv->phase, NULL,
m->insp); menv->access_insp);
p = scheme_current_thread; p = scheme_current_thread;
save_phase_shift = p->current_phase_shift; save_phase_shift = p->current_phase_shift;
@ -5692,8 +5694,9 @@ Scheme_Env *scheme_primitive_module(Scheme_Object *name, Scheme_Env *for_env)
scheme_hash_set(for_env->module_registry->exports, m->modname, (Scheme_Object *)m->me); scheme_hash_set(for_env->module_registry->exports, m->modname, (Scheme_Object *)m->me);
env->access_insp = insp;
insp = scheme_make_inspector(insp); insp = scheme_make_inspector(insp);
env->insp = insp; env->guard_insp = insp;
scheme_hash_set(for_env->module_registry->loaded, m->modname, (Scheme_Object *)m); scheme_hash_set(for_env->module_registry->loaded, m->modname, (Scheme_Object *)m);
@ -6221,7 +6224,7 @@ static Scheme_Object *do_module_execute(Scheme_Object *data, Scheme_Env *genv,
insp = scheme_get_param(config, MZCONFIG_CODE_INSPECTOR); insp = scheme_get_param(config, MZCONFIG_CODE_INSPECTOR);
if (old_menv) { if (old_menv) {
if (scheme_module_protected_wrt(old_menv->insp, insp) || old_menv->attached) { if (scheme_module_protected_wrt(old_menv->guard_insp, insp) || old_menv->attached) {
scheme_contract_error("module->namespace", scheme_contract_error("module->namespace",
"current code inspector cannot re-declare module", "current code inspector cannot re-declare module",
"module name", 1, m->modname, "module name", 1, m->modname,
@ -6988,8 +6991,9 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
{ {
Scheme_Object *insp; Scheme_Object *insp;
menv->access_insp = env->insp;
insp = scheme_make_inspector(env->insp); insp = scheme_make_inspector(env->insp);
menv->insp = insp; menv->guard_insp = insp;
} }
scheme_prepare_exp_env(menv); scheme_prepare_exp_env(menv);
@ -7703,7 +7707,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
all_defs_out = scheme_make_hash_table_equal(); all_defs_out = scheme_make_hash_table_equal();
rn_set = env->genv->rename_set; rn_set = env->genv->rename_set;
post_ex_rn_set = scheme_make_module_rename_set(mzMOD_RENAME_MARKED, rn_set, env->genv->module->insp); post_ex_rn_set = scheme_make_module_rename_set(mzMOD_RENAME_MARKED, rn_set, env->genv->access_insp);
/* It's possible that #%module-begin expansion introduces /* It's possible that #%module-begin expansion introduces
marked identifiers for definitions. */ marked identifiers for definitions. */
@ -9075,9 +9079,9 @@ static Scheme_Object *expand_all_provides(Scheme_Object *form,
penv = penv->exp_env; penv = penv->exp_env;
} }
if (rec[drec].comp) if (rec[drec].comp)
pcenv = scheme_new_comp_env(penv, penv->insp, SCHEME_TOPLEVEL_FRAME); pcenv = scheme_new_comp_env(penv, penv->access_insp, SCHEME_TOPLEVEL_FRAME);
else else
pcenv = scheme_new_expand_env(penv, penv->insp, SCHEME_TOPLEVEL_FRAME); pcenv = scheme_new_expand_env(penv, penv->access_insp, SCHEME_TOPLEVEL_FRAME);
} else { } else {
pcenv = cenv; pcenv = cenv;
} }

6
src/racket/src/mzmark_type.inc
View File

@ -2193,7 +2193,8 @@ static int namespace_val_MARK(void *p, struct NewGC *gc) {
gcMARK2(e->module, gc); gcMARK2(e->module, gc);
gcMARK2(e->module_registry, gc); gcMARK2(e->module_registry, gc);
gcMARK2(e->module_pre_registry, gc); gcMARK2(e->module_pre_registry, gc);
gcMARK2(e->insp, gc); gcMARK2(e->guard_insp, gc);
gcMARK2(e->access_insp, gc);
gcMARK2(e->rename_set, gc); gcMARK2(e->rename_set, gc);
gcMARK2(e->temp_marked_names, gc); gcMARK2(e->temp_marked_names, gc);
@ -2235,7 +2236,8 @@ static int namespace_val_FIXUP(void *p, struct NewGC *gc) {
gcFIXUP2(e->module, gc); gcFIXUP2(e->module, gc);
gcFIXUP2(e->module_registry, gc); gcFIXUP2(e->module_registry, gc);
gcFIXUP2(e->module_pre_registry, gc); gcFIXUP2(e->module_pre_registry, gc);
gcFIXUP2(e->insp, gc); gcFIXUP2(e->guard_insp, gc);
gcFIXUP2(e->access_insp, gc);
gcFIXUP2(e->rename_set, gc); gcFIXUP2(e->rename_set, gc);
gcFIXUP2(e->temp_marked_names, gc); gcFIXUP2(e->temp_marked_names, gc);

3
src/racket/src/mzmarksrc.c
View File

@ -881,7 +881,8 @@ namespace_val {
gcMARK2(e->module, gc); gcMARK2(e->module, gc);
gcMARK2(e->module_registry, gc); gcMARK2(e->module_registry, gc);
gcMARK2(e->module_pre_registry, gc); gcMARK2(e->module_pre_registry, gc);
gcMARK2(e->insp, gc); gcMARK2(e->guard_insp, gc);
gcMARK2(e->access_insp, gc);
gcMARK2(e->rename_set, gc); gcMARK2(e->rename_set, gc);
gcMARK2(e->temp_marked_names, gc); gcMARK2(e->temp_marked_names, gc);

3
src/racket/src/schpriv.h
View File

@ -3027,8 +3027,9 @@ struct Scheme_Env {
Scheme_Module_Registry *module_registry; Scheme_Module_Registry *module_registry;
Scheme_Module_Registry *module_pre_registry; /* for expanding submodules */ Scheme_Module_Registry *module_pre_registry; /* for expanding submodules */
Scheme_Object *insp; /* instantiation-time inspector, for granting Scheme_Object *guard_insp; /* instantiation-time inspector, for granting
protected access */ protected access */
Scheme_Object *access_insp; /* for graining protected access */
Scheme_Object *rename_set; Scheme_Object *rename_set;
Scheme_Hash_Table *temp_marked_names; /* used to correlate imports with re-exports */ Scheme_Hash_Table *temp_marked_names; /* used to correlate imports with re-exports */