From 2eceec689bdf4d54acd1459d3aa10c4f08f93e2c Mon Sep 17 00:00:00 2001
From: Douglas R Miles <logicmoo@gmail.com>
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 <stream>(%p,%p)",
+ PL_warning("Cannot save reference to <stream>(%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