diff --git a/library/sandbox.pl b/library/sandbox.pl index 5742fbc54..99aa8079d 100644 --- a/library/sandbox.pl +++ b/library/sandbox.pl @@ -73,6 +73,17 @@ safe_goal/1, which determines whether it is safe to call its argument. @see http://www.swi-prolog.org/pldoc/package/pengines.html */ +:- create_prolog_flag(no_sandbox, false, [type(boolean), keep(true)]). + +do_permission_error(Operation, PermissionType, Culprit) :- + do_permission_error(Operation, PermissionType, Culprit, _). + +do_permission_error(_Operation, _PermissionType, _Culprit, _MoreInfo) :- current_prolog_flag(no_sandbox, true), !. +do_permission_error(Operation, PermissionType, Culprit, MoreInfo) :- + throw(error(permission_error(Operation, + PermissionType, + Culprit), + MoreInfo)). :- meta_predicate safe_goal(:), @@ -144,6 +155,9 @@ safe(V, _, Parents, _, _) :- Error = error(instantiation_error, sandbox(V, Parents)), nb_setval(sandbox_last_error, Error), throw(Error). + +safe(_, _, _Parents, _Safe0, true):- current_prolog_flag(no_sandbox, true), !. + safe(M:G, _, Parents, Safe0, Safe) :- !, must_be(atom, M), @@ -165,8 +179,8 @@ safe(M:G, _, Parents, Safe0, Safe) :- ; memberchk(M:_, Parents) ) -> safe(G, M, Parents, Safe0, Safe) - ; throw(error(permission_error(call, sandboxed, M:G), - sandbox(M:G, Parents))) + ; do_permission_error(call, sandboxed, M:G, + sandbox(M:G, Parents)) ). safe(G, _, Parents, _, _) :- debugging(sandbox(show)), @@ -248,8 +262,9 @@ safe_clauses(G, M, Parents, Safe0, Safe) :- safe_clauses(G, M, [_|Parents], _, _) :- predicate_property(M:G, visible), !, - throw(error(permission_error(call, sandboxed, G), - sandbox(M:G, Parents))). + do_permission_error(call, sandboxed, G, + sandbox(M:G, Parents)). + safe_clauses(_, _, [G|Parents], _, _) :- throw(error(existence_error(procedure, G), sandbox(G, Parents))). @@ -259,9 +274,10 @@ compiled(system:(@(_,_))). known_module(M:_, _) :- current_module(M), !. +known_module(_,_):- current_prolog_flag(no_sandbox, true), !, fail. known_module(M:G, Parents) :- - throw(error(permission_error(call, sandboxed, M:G), - sandbox(M:G, Parents))). + do_permission_error(call, sandboxed, M:G, + sandbox(M:G, Parents). add_iso_parent(G, Parents, Parents) :- is_control(G), @@ -438,6 +454,8 @@ verify_safe_declaration(Var) :- var(Var), !, instantiation_error(Var). + +verify_safe_declaration(_):- current_prolog_flag(no_sandbox, true), !. verify_safe_declaration(Module:Goal) :- !, must_be(atom, Module), @@ -451,14 +469,14 @@ verify_safe_declaration(Module:Goal) :- \+ predicate_property(Module:Goal, imported_from(_)), \+ predicate_property(Module:Goal, meta_predicate(_)) -> true - ; permission_error(declare, safe_goal, Module:Goal) + ; do_permission_error(declare, safe_goal, Module:Goal) ). verify_safe_declaration(Goal) :- must_be(callable, Goal), ( predicate_property(system:Goal, iso), \+ predicate_property(system:Goal, meta_predicate()) -> true - ; permission_error(declare, safe_goal, Goal) + ; do_permission_error(declare, safe_goal, Goal) ). ok_meta(system:assert(_)). @@ -466,6 +484,7 @@ ok_meta(system:load_files(_,_)). ok_meta(system:use_module(_,_)). ok_meta(system:use_module(_)). +verify_predefined_safe_declarations :- current_prolog_flag(no_sandbox, true), !. verify_predefined_safe_declarations :- forall(clause(safe_primitive(Goal), _Body, Ref), ( catch(verify_safe_declaration(Goal), E, true), @@ -815,6 +834,7 @@ safe_assert(_). % private information from other modules. safe_clause(H) :- var(H), !. +safe_clause(_):- current_prolog_flag(no_sandbox, true), !. safe_clause(_:_) :- !, fail. safe_clause(_). @@ -824,6 +844,7 @@ safe_clause(_). % True if Name is a global variable to which assertion is % considered safe. +safe_global_var(_Name):- current_prolog_flag(no_sandbox, true), !. safe_global_var(Name) :- var(Name), !, @@ -931,6 +952,9 @@ expand_nt(NT, Xs0, Xs, NewGoal) :- safe_meta_call(Goal, _, _Called) :- debug(sandbox(meta), 'Safe meta ~p?', [Goal]), fail. + +safe_meta_call(_, _, _):- current_prolog_flag(no_sandbox, true), !. + safe_meta_call(Goal, Context, Called) :- ( safe_meta(Goal, Called) -> true @@ -1110,18 +1134,19 @@ prolog:sandbox_allowed_directive(Directive) :- prolog:sandbox_allowed_directive(Directive) :- safe_directive(Directive), !. +prolog:sandbox_allowed_directive(_):- current_prolog_flag(no_sandbox, true), !. prolog:sandbox_allowed_directive(M:PredAttr) :- \+ prolog_load_context(module, M), !, debug(sandbox(directive), 'Cross-module directive', []), - permission_error(execute, sandboxed_directive, (:- M:PredAttr)). + do_permission_error(execute, sandboxed_directive, (:- M:PredAttr)). prolog:sandbox_allowed_directive(M:PredAttr) :- safe_pattr(PredAttr), !, PredAttr =.. [Attr, Preds], ( safe_pattr(Preds, Attr) -> true - ; permission_error(execute, sandboxed_directive, (:- M:PredAttr)) + ; do_permission_error(execute, sandboxed_directive, (:- M:PredAttr)) ). prolog:sandbox_allowed_directive(_:Directive) :- safe_source_directive(Directive), @@ -1149,6 +1174,7 @@ prolog:sandbox_allowed_directive(G) :- % == +safe_pattr(_):- current_prolog_flag(no_sandbox, true), !. safe_pattr(dynamic(_)). safe_pattr(thread_local(_)). safe_pattr(volatile(_)). @@ -1159,6 +1185,7 @@ safe_pattr(meta_predicate(_)). safe_pattr(table(_)). safe_pattr(non_terminal(_)). +safe_pattr(_, _):- current_prolog_flag(no_sandbox, true), !. safe_pattr(Var, _) :- var(Var), !, @@ -1173,7 +1200,7 @@ safe_pattr(M:G, Attr) :- prolog_load_context(module, M) -> true ; Goal =.. [Attr,M:G], - permission_error(directive, sandboxed, (:- Goal)) + do_permission_error(directive, sandboxed, (:- Goal)) ). safe_pattr(_, _). @@ -1198,6 +1225,7 @@ directive_loads_file(load_files(library(X), _Options), X). directive_loads_file(ensure_loaded(library(X)), X). directive_loads_file(include(X), X). +safe_path(_):- current_prolog_flag(no_sandbox, true), !. safe_path(X) :- var(X), !, @@ -1253,6 +1281,7 @@ safe_prolog_flag(max_table_answer_size,_). safe_prolog_flag(max_table_answer_size_action,_). safe_prolog_flag(max_table_subgoal_size,_). safe_prolog_flag(max_table_subgoal_size_action,_). +safe_prolog_flag(_,_):- current_prolog_flag(no_sandbox, true), !. %! prolog:sandbox_allowed_expansion(:G) is det.