diff options
-rw-r--r-- | eval.c | 1 | ||||
-rw-r--r-- | lib.c | 22 | ||||
-rw-r--r-- | lib.h | 5 | ||||
-rw-r--r-- | txr.1 | 68 |
4 files changed, 84 insertions, 12 deletions
@@ -5866,6 +5866,7 @@ void eval_init(void) reg_fun(intern(lit("make-sym"), user_package), func_n1(make_sym)); reg_fun(intern(lit("gensym"), user_package), func_n1o(gensym, 0)); reg_var(gensym_counter_s = intern(lit("*gensym-counter*"), user_package), zero); + reg_var(package_alist_s = intern(lit("*package-alist*"), user_package), packages); reg_var(package_s = intern(lit("*package*"), user_package), user_package_var); reg_fun(intern(lit("make-package"), user_package), func_n1(make_package)); reg_fun(intern(lit("find-package"), user_package), func_n1(find_package)); @@ -79,6 +79,7 @@ int async_sig_enabled = 0; val packages; val system_package_var, keyword_package_var, user_package_var; +val package_alist_s; val package_s, system_package_s, keyword_package_s, user_package_s; val null_s, t, cons_s, str_s, chr_s, fixnum_s, sym_s, pkg_s, fun_s, vec_s; @@ -4840,7 +4841,7 @@ val make_package(val name) obj->pk.symhash = make_hash(nil, nil, lit("t")); /* don't have t yet! */ obj->pk.hidhash = make_hash(nil, nil, lit("t")); - push(cons(name, obj), &packages); + mpush(cons(name, obj), cur_package_alist_loc); return obj; } } @@ -4852,7 +4853,7 @@ val packagep(val obj) static val lookup_package(val name) { - return cdr(assoc(name, packages)); + return cdr(assoc(name, deref(cur_package_alist_loc))); } val find_package(val package) @@ -4883,15 +4884,16 @@ val delete_package(val package_in) { val package = get_package(lit("delete-package"), package_in, nil); val iter; - packages = alist_nremove1(packages, package->pk.name); - for (iter = packages; iter; iter = cdr(iter)) + loc cpll = cur_package_alist_loc; + set(cpll, alist_nremove1(deref(cpll), package->pk.name)); + for (iter = deref(cpll); iter; iter = cdr(iter)) unuse_package(package, cdar(iter)); return nil; } val package_alist(void) { - return packages; + return deref(cur_package_alist_loc); } val package_name(val package) @@ -5253,6 +5255,16 @@ val get_current_package(void) return pkg; } +loc get_current_package_alist_loc(void) +{ + if (package_alist_s) { + loc var_loc = lookup_var_l(nil, package_alist_s); + if (!nullocp(var_loc)) + return var_loc; + } + return mkcloc(packages); +} + val func_f0(val env, val (*fun)(val)) { val obj = make_obj(); @@ -417,8 +417,10 @@ INLINE val chr(wchar_t ch) #define user_package user_package_var #define system_package system_package_var #define cur_package (get_current_package()) +#define cur_package_alist_loc (get_current_package_alist_loc()) -extern val system_package_var, keyword_package_var, user_package_var; +extern val packages, system_package_var, keyword_package_var, user_package_var; +extern val package_alist_s; extern val package_s, keyword_package_s, system_package_s, user_package_s; extern val null_s, t, cons_s, str_s, chr_s, fixnum_sl; extern val sym_s, pkg_s, fun_s, vec_s; @@ -811,6 +813,7 @@ val symbol_name(val sym); val symbol_package(val sym); val keywordp(val sym); val get_current_package(void); +loc get_current_package_alist_loc(void); val func_f0(val, val (*fun)(val env)); val func_f1(val, val (*fun)(val env, val)); val func_f2(val, val (*fun)(val env, val, val)); @@ -42352,14 +42352,11 @@ then it is returned. Otherwise .code nil is returned. -.coNP Function @ package-alist -.synb -.mets (package-alist) -.syne +.coNP Special variable @ *package-alist* .desc The -.code package-alist -function returns an association list +.code *package-alist* +variable contains the master association list which contains an entry about each existing package. @@ -42370,6 +42367,65 @@ field is the name of a package and whose .code cdr is a package object. +Note: the \*(TL application can overwrite or re-bind this +variable to manipulate the active package list. This is +very useful for +.IR sandboxing : +safely evaluating code that is obtained as an input +from an untrusted source, or calculated from such an input. + +The contents of +.code *package-alist* +have security implications because textual source code +can refer to any symbol in any package by invoking +a package prefix. For instance, even if the +.code open +function's name is not available in the current package +(established by the +.code *package* +variable) that symbol can easily be obtained using the +syntax +.codn usr:open . + +However, the entire +.code usr +package itself can be removed from +.codn *package-alist* . +In that situation, the syntax +.code usr:open +is no longer valid. + +At the same time, selected symbols from the original +.code usr +can be nevertheless made available via some intermediate +package, which is present in +.code *package-alist* +and which contains a subset of the +.code usr +symbols that has been curated for safety. That curated package may even +be called +.codn usr , +so that if for instance +.code cons +is present in that package, it may be referred to as +.code usr:cons +in the usual way. + +.coNP Function @ package-alist +.synb +.mets (package-alist) +.syne +.desc +The +.code package-alist +function retrieves the value of +.codn *package-alist* . + +Note: this function is obsolescent. There is no reason to use it +in new code instead of just accessing +.code *package-alist* +directly. + .coNP Function @ package-name .synb .mets (package-name << package ) |