summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--eval.c1
-rw-r--r--lib.c22
-rw-r--r--lib.h5
-rw-r--r--txr.168
4 files changed, 84 insertions, 12 deletions
diff --git a/eval.c b/eval.c
index 420e58a1..8b2ec9a2 100644
--- a/eval.c
+++ b/eval.c
@@ -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));
diff --git a/lib.c b/lib.c
index 358bda30..5d2724fe 100644
--- a/lib.c
+++ b/lib.c
@@ -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();
diff --git a/lib.h b/lib.h
index 1f9537cf..87b23465 100644
--- a/lib.h
+++ b/lib.h
@@ -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));
diff --git a/txr.1 b/txr.1
index 7510506d..012d9686 100644
--- a/txr.1
+++ b/txr.1
@@ -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 )