From 649ccc9e494cfb121cd20fad0c7bdd9121ddcace Mon Sep 17 00:00:00 2001
From: Jan Wielemaker <J.Wielemaker@cs.vu.nl>
Date: Sun, 16 Jul 2017 17:40:05 +0200
Subject: [PATCH] FIXED: sandbox handling of @/2. Vladislav Zorov and Anne
Ogborn.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Petr Písař: Ported to 7.2.3.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
library/sandbox.pl | 6 +++++-
src/Tests/library/test_sandbox.pl | 2 ++
2 files changed, 7 insertions(+), 1 deletion(-)
diff --git a/library/sandbox.pl b/library/sandbox.pl
index f84b8d3..bb970cb 100644
--- a/library/sandbox.pl
+++ b/library/sandbox.pl
@@ -198,8 +198,10 @@ safe(G, M, Parents, _, _) :-
fail.
safe_clauses(G, M, Parents, Safe0, Safe) :-
- predicate_property(M:G, interpreted), !,
+ predicate_property(M:G, interpreted),
def_module(M:G, MD:QG),
+ \+ compiled(MD:QG),
+ !,
findall(Ref-Body, clause(MD:QG, Body, Ref), Bodies),
safe_bodies(Bodies, MD, Parents, Safe0, Safe).
safe_clauses(G, M, [_|Parents], _, _) :-
@@ -210,6 +212,8 @@ safe_clauses(_, _, [G|Parents], _, _) :-
throw(error(existence_error(procedure, G),
sandbox(G, Parents))).
+compiled(system:(@(_,_))).
+
%% safe_bodies(+Bodies, +Module, +Parents, +Safe0, -Safe)
%
% Verify the safety of bodies. If a clause was compiled with a
diff --git a/src/Tests/library/test_sandbox.pl b/src/Tests/library/test_sandbox.pl
index 4c737e8..1e14e85 100644
--- a/src/Tests/library/test_sandbox.pl
+++ b/src/Tests/library/test_sandbox.pl
@@ -66,5 +66,7 @@ test(aggregate) :-
safe_goal(aggregate(sum(I), X^between(1,X,I), _Count)).
test(dcg, error(permission_error(call, sandboxed, open(_,_,_)))) :-
safe_goal(my_call(open(_,_,_))).
+test(contexr, error(permission_error(call, sandboxed, @(_,_)))) :-
+ safe_goal(@(open(_,_,_), user)).
:- end_tests(sandbox).
--
2.13.6