From 2eceec689bdf4d54acd1459d3aa10c4f08f93e2c Mon Sep 17 00:00:00 2001 From: Douglas R Miles Date: Sat, 25 Sep 2021 00:04:55 -0700 Subject: [PATCH 1/2] dmiles --- boot/autoload.pl | 5 +++- boot/init.pl | 1 + library/edit.pl | 4 +++ library/prolog_debug.pl | 12 ++++---- library/qsave.pl | 2 +- library/sandbox.pl | 62 +++++++++++++++++++++++++++++++++-------- library/threadutil.pl | 16 ++++------- src/os/pl-file.c | 4 ++- src/pl-attvar.c | 38 +++++++++++++++++++++++++ src/pl-comp.c | 2 +- src/pl-trace.c | 1 + 11 files changed, 116 insertions(+), 31 deletions(-) mode change 100644 => 100755 boot/autoload.pl mode change 100644 => 100755 boot/init.pl mode change 100644 => 100755 library/qsave.pl mode change 100644 => 100755 library/sandbox.pl diff --git a/boot/autoload.pl b/boot/autoload.pl old mode 100644 new mode 100755 index 26e609bca..c2fd15499 --- a/boot/autoload.pl +++ b/boot/autoload.pl @@ -514,7 +514,7 @@ system:term_expansion((:- autoload_path(Alias)), '$autoload2'(PI) :- setup_call_cleanup( leave_sandbox(Old), - '$autoload3'(PI), + safe_autoload3(PI), restore_sandbox(Old)). leave_sandbox(Sandboxed) :- @@ -523,6 +523,9 @@ leave_sandbox(Sandboxed) :- restore_sandbox(Sandboxed) :- set_prolog_flag(sandboxed_load, Sandboxed). +safe_autoload3(M:_/_):- \+ ground(M),!. +safe_autoload3(PI) :- '$autoload3'(PI). + '$autoload3'(PI) :- autoload_from(PI, LoadModule, FullFile), do_autoload(FullFile, PI, LoadModule). diff --git a/boot/init.pl b/boot/init.pl old mode 100644 new mode 100755 index 0b0c22784..e35cc2b7b --- a/boot/init.pl +++ b/boot/init.pl @@ -2977,6 +2977,7 @@ load_files(Module:Files, Options) :- % Test that a non-module file is not loaded into multiple % contexts. +'$check_load_non_module'(_, _) :- !. '$check_load_non_module'(File, _) :- '$current_module'(_, File), !. % File is a module file diff --git a/library/edit.pl b/library/edit.pl index 3153602e0..d9dc6efc8 100644 --- a/library/edit.pl +++ b/library/edit.pl @@ -39,8 +39,12 @@ ]). :- autoload(library(lists),[member/2,append/3,nth1/3]). :- autoload(library(make),[make/0]). +:- if(exists_source(library(pce))). :- autoload(library(pce),[in_pce_thread/1]). +:- endif. +:- if(exists_source(library(pce_emacs))). :- autoload(library(pce_emacs),[emacs/1]). +:- endif. :- autoload(library(prolog_breakpoints),[breakpoint_property/2]). diff --git a/library/prolog_debug.pl b/library/prolog_debug.pl index addef4a6f..6cd202a81 100644 --- a/library/prolog_debug.pl +++ b/library/prolog_debug.pl @@ -33,12 +33,12 @@ */ :- module(prolog_debug_tools, - [ spy/1, % :Spec - nospy/1, % :Spec - nospyall/0, - debugging/0, - trap/1, % +Exception - notrap/1 % +Exception + [ (spy)/1, % :Spec + (nospy)/1, % :Spec + (nospyall)/0, + (debugging)/0, + (trap)/1, % +Exception + (notrap)/1 % +Exception ]). :- use_module(library(broadcast), [broadcast/1]). :- autoload(library(edinburgh), [debug/0]). diff --git a/library/qsave.pl b/library/qsave.pl old mode 100644 new mode 100755 index e79615136..24be13ea2 --- a/library/qsave.pl +++ b/library/qsave.pl @@ -634,7 +634,7 @@ save_autoload(Options) :- !, setup_call_cleanup( current_prolog_flag(autoload, Old), - autoload_all(Options), + prolog_autoload:autoload_all(Options), set_prolog_flag(autoload, Old)). save_autoload(_). diff --git a/library/sandbox.pl b/library/sandbox.pl old mode 100644 new mode 100755 index bbac12633..dc9c3272b --- a/library/sandbox.pl +++ b/library/sandbox.pl @@ -74,6 +74,20 @@ 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(:), @@ -145,6 +159,13 @@ 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(_, _, _Parents, _Safe0, true):- current_prolog_flag(no_sandbox, true), !. +>>>>>>> + safe(M:G, _, Parents, Safe0, Safe) :- !, must_be(atom, M), @@ -166,8 +187,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)), @@ -249,8 +270,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))). @@ -260,9 +282,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), @@ -450,6 +473,11 @@ 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), @@ -463,14 +491,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(_)). @@ -478,6 +506,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), ( E = error(F,_), @@ -831,6 +860,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(_). @@ -840,6 +870,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), !, @@ -947,6 +978,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 @@ -1124,21 +1158,23 @@ format_callables([_|TT], [_|TA], TG) :- prolog:sandbox_allowed_directive(Directive) :- debug(sandbox(directive), 'Directive: ~p', [Directive]), fail. +prolog:sandbox_allowed_directive(_):- current_prolog_flag(no_sandbox, true), !. 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), @@ -1166,6 +1202,7 @@ prolog:sandbox_allowed_directive(G) :- % == +safe_pattr(_):- current_prolog_flag(no_sandbox, true), !. safe_pattr(dynamic(_)). safe_pattr(thread_local(_)). safe_pattr(volatile(_)). @@ -1176,6 +1213,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), !, @@ -1190,7 +1228,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(_, _). @@ -1215,6 +1253,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), !, @@ -1270,6 +1309,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. diff --git a/library/threadutil.pl b/library/threadutil.pl index dd720501a..967cdaf3e 100644 --- a/library/threadutil.pl +++ b/library/threadutil.pl @@ -56,21 +56,19 @@ :- autoload(library(apply),[maplist/3]). :- autoload(library(backcomp),[thread_at_exit/1]). :- autoload(library(edinburgh),[nodebug/0]). +:- if(exists_source(library(gui_tracer))). +:- autoload(library(gui_tracer),[gdebug/0]). +:- endif. :- autoload(library(lists),[max_list/2,append/2]). :- autoload(library(option),[merge_options/3,option/3]). +:- if(exists_source(library(pce))). +:- autoload(library(pce),[send/2]). +:- endif. :- autoload(library(prolog_stack), [print_prolog_backtrace/2,get_prolog_backtrace/3]). :- autoload(library(statistics),[thread_statistics/2,show_profile/1]). :- autoload(library(thread),[call_in_thread/2]). -:- if(exists_source(library(pce))). -:- autoload(library(gui_tracer),[gdebug/0]). -:- autoload(library(pce),[send/2]). -:- else. -gdebug :- - debug. -:- endif. - :- set_prolog_flag(generate_debug_info, false). @@ -429,12 +427,10 @@ tprofile(Thread) :- % Make sure XPCE is running if it is attached, so we can use the % graphical display using in_pce_thread/1. -:- if(exists_source(library(pce))). init_pce :- current_prolog_flag(gui, true), !, call(send(@(display), open)). % avoid autoloading -:- endif. init_pce. diff --git a/src/os/pl-file.c b/src/os/pl-file.c index 45b7f5081..9c9eb90ce 100644 --- a/src/os/pl-file.c +++ b/src/os/pl-file.c @@ -584,8 +584,10 @@ save_stream_ref(atom_t aref, IOSTREAM *fd) { stream_ref *ref = PL_blob_data(aref, NULL, NULL); (void)fd; - return PL_warning("Cannot save reference to (%p,%p)", + PL_warning("Cannot save reference to (%p,%p)", ref->read, ref->write); + return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_stream, aref); + } diff --git a/src/pl-attvar.c b/src/pl-attvar.c index 8186af7b1..b2ed61b49 100644 --- a/src/pl-attvar.c +++ b/src/pl-attvar.c @@ -193,6 +193,17 @@ assignAttVar(DECL_LD Word av, Word value) a = valPAttVar(*av); registerWakeup(a, value); + /* When first attribute is $VAR$ skip binding (allows to be done elsewhere) */ + { Word l = a; + deRef(l); + if ( isTerm(*l) ) + { Functor f = valueTerm(*l); + if ( f->definition == FUNCTOR_att3 ) + { Word n; + deRef2(&f->arguments[0], n); + if ( *n == ATOM_dvard ) return; + }}} + TrailAssignment(av); if ( isAttVar(*value) ) { DEBUG(1, Sdprintf("Unifying two attvars\n")); @@ -611,6 +622,32 @@ restoreWakeup(DECL_LD wakeup_state *state) } + +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + attv_bind(+AttVar, +Value) is det. + Binds AttVar with Value without calling wakeup + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ +static +PRED_IMPL("attv_bind", 2, attv_bind, 0) +{ PRED_LD + Word av; + + if ( !hasGlobalSpace(0) ) + { int rc; + if ( (rc=ensureGlobalSpace(0, ALLOW_GC)) != TRUE ) + return raiseStackOverflow(rc); + } + + deRef2(valTermRef(A1), av); + if (!isAttVar(*av) ) + { return PL_error("attv_bind", 2, NULL, ERR_UNINSTANTIATION, 1, A1); + } + + TrailAssignment(av); + *av = linkValI(valTermRef(A2)); + return TRUE; +} + /******************************* * PREDICATES * *******************************/ @@ -1421,6 +1458,7 @@ BeginPredDefs(attvar) PRED_DEF("del_attr", 2, del_attr2, 0) PRED_DEF("del_attrs", 1, del_attrs, 0) PRED_DEF("get_attrs", 2, get_attrs, 0) + PRED_DEF("attv_bind", 2, attv_bind, 0) PRED_DEF("put_attrs", 2, put_attrs, 0) PRED_DEF("$freeze", 2, freeze, 0) PRED_DEF("$eval_when_condition", 2, eval_when_condition, 0) diff --git a/src/pl-comp.c b/src/pl-comp.c index c1b30b697..ca243ac5c 100644 --- a/src/pl-comp.c +++ b/src/pl-comp.c @@ -4344,7 +4344,7 @@ record_clause(DECL_LD term_t term, term_t owner, term_t source, term_t ref) if ( PL_get_atom(source, &a) && a == ATOM_minus ) { loc.file = source_file_name; loc.line = source_line_no; - assert(source_line_no != -1); + //assert(source_line_no != -1); } else if ( PL_is_functor(source, FUNCTOR_colon2) ) { term_t arg = PL_new_term_ref(); /* file:line */ diff --git a/src/pl-trace.c b/src/pl-trace.c index 99bf4e602..e81704e89 100644 --- a/src/pl-trace.c +++ b/src/pl-trace.c @@ -1800,6 +1800,7 @@ interruptHandler(int sig) Sreset(); again: + safe = TRUE; if ( safe ) { if ( !printMessage(ATOM_debug, PL_FUNCTOR, FUNCTOR_interrupt1, PL_ATOM, ATOM_begin) ) -- 2.33.0