1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2013-2023, VU University Amsterdam
    7                              CWI, Amsterdam
    8                              SWI-Prolog Solutions b.v
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(sandbox,
   38          [ safe_goal/1,                % :Goal
   39            safe_call/1                 % :Goal
   40          ]).   41:- use_module(library(apply_macros),[expand_phrase/2]).   42:- use_module(library(apply),[maplist/2]).   43:- use_module(library(assoc),[empty_assoc/1,get_assoc/3,put_assoc/4]).   44:- use_module(library(debug),[debug/3,debugging/1]).   45:- use_module(library(error),
   46              [ must_be/2,
   47                instantiation_error/1,
   48                type_error/2,
   49                permission_error/3
   50              ]).   51:- use_module(library(lists),[append/3]).   52:- use_module(library(prolog_format),[format_types/2]).   53
   54:- multifile
   55    safe_primitive/1,               % Goal
   56    safe_meta_predicate/1,          % Name/Arity
   57    safe_meta/2,                    % Goal, Calls
   58    safe_meta/3,                    % Goal, Context, Calls
   59    safe_global_variable/1,         % Name
   60    safe_directive/1,               % Module:Goal
   61    safe_prolog_flag/2.             % +Name, +Value
   62
   63% :- debug(sandbox).
   64
   65/** <module> Sandboxed Prolog code
   66
   67Prolog is a full-featured Turing complete  programming language in which
   68it is easy to write programs that can   harm your computer. On the other
   69hand, Prolog is a logic based _query language_ which can be exploited to
   70query data interactively from, e.g.,  the   web.  This  library provides
   71safe_goal/1, which determines whether it is safe to call its argument.
   72
   73@tbd    Handling of ^ and // meta predicates
   74@tbd    Complete set of whitelisted predicates
   75@see    http://www.swi-prolog.org/pldoc/package/pengines.html
   76*/
   77
   78
   79:- meta_predicate
   80    safe_goal(:),
   81    safe_call(0).   82
   83%!  safe_call(:Goal)
   84%
   85%   Call Goal if it  complies  with   the  sandboxing  rules. Before
   86%   calling   Goal,   it   performs   expand_goal/2,   followed   by
   87%   safe_goal/1. Expanding is done explicitly  because situations in
   88%   which safe_call/1 typically concern goals that  are not known at
   89%   compile time.
   90%
   91%   @see safe_goal/1.
   92
   93safe_call(Goal0) :-
   94    expand_goal(Goal0, Goal),
   95    safe_goal(Goal),
   96    call(Goal).
   97
   98%!  safe_goal(:Goal) is det.
   99%
  100%   True if calling Goal provides  no   security  risc. This implies
  101%   that:
  102%
  103%     - The call-graph can be fully expanded. Full expansion *stops*
  104%     if a meta-goal is found for   which we cannot determine enough
  105%     details to know which predicate will be called.
  106%
  107%     - All predicates  referenced  from   the  fully  expanded  are
  108%     whitelisted by the predicate safe_primitive/1 and safe_meta/2.
  109%
  110%     - It is not allowed to make explicitly qualified calls into
  111%     modules to predicates that are not exported or declared
  112%     public.
  113%
  114%   @error  instantiation_error if the analysis encounters a term in
  115%           a callable position that is insufficiently instantiated
  116%           to determine the predicate called.
  117%   @error  permission_error(call, sandboxed, Goal) if Goal is in
  118%           the call-tree and not white-listed.
  119
  120safe_goal(M:Goal) :-
  121    empty_assoc(Safe0),
  122    catch(safe(Goal, M, [], Safe0, _), E, true),
  123    !,
  124    nb_delete(sandbox_last_error),
  125    (   var(E)
  126    ->  true
  127    ;   throw(E)
  128    ).
  129safe_goal(_) :-
  130    nb_current(sandbox_last_error, E),
  131    !,
  132    nb_delete(sandbox_last_error),
  133    throw(E).
  134safe_goal(G) :-
  135    debug(sandbox(fail), 'safe_goal/1 failed for ~p', [G]),
  136    throw(error(instantiation_error, sandbox(G, []))).
  137
  138
  139%!  safe(+Goal, +Module, +Parents, +Safe0, -Safe) is semidet.
  140%
  141%   Is true if Goal can only call safe code.
  142
  143safe(V, _, Parents, _, _) :-
  144    var(V),
  145    !,
  146    Error = error(instantiation_error, sandbox(V, Parents)),
  147    nb_setval(sandbox_last_error, Error),
  148    throw(Error).
  149safe(M:G, _, Parents, Safe0, Safe) :-
  150    !,
  151    must_be(atom, M),
  152    must_be(callable, G),
  153    known_module(M:G, Parents),
  154    (   predicate_property(M:G, imported_from(M2))
  155    ->  true
  156    ;   M2 = M
  157    ),
  158    (   (   safe_primitive(M2:G)
  159        ;   safe_primitive(G),
  160            predicate_property(G, iso)
  161        )
  162    ->  Safe = Safe0
  163    ;   (   predicate_property(M:G, exported)
  164        ;   predicate_property(M:G, public)
  165        ;   predicate_property(M:G, multifile)
  166        ;   predicate_property(M:G, iso)
  167        ;   memberchk(M:_, Parents)
  168        )
  169    ->  safe(G, M, Parents, Safe0, Safe)
  170    ;   throw(error(permission_error(call, sandboxed, M:G),
  171                    sandbox(M:G, Parents)))
  172    ).
  173safe(G, _, Parents, _, _) :-
  174    debugging(sandbox(show)),
  175    length(Parents, Level),
  176    debug(sandbox(show), '[~D] SAFE ~q?', [Level, G]),
  177    fail.
  178safe(G, _, Parents, Safe, Safe) :-
  179    catch(safe_primitive(G),
  180          error(instantiation_error, _),
  181          rethrow_instantition_error([G|Parents])),
  182    predicate_property(G, iso),
  183    !.
  184safe(G, M, Parents, Safe, Safe) :-
  185    known_module(M:G, Parents),
  186    (   predicate_property(M:G, imported_from(M2))
  187    ->  true
  188    ;   M2 = M
  189    ),
  190    (   catch(safe_primitive(M2:G),
  191              error(instantiation_error, _),
  192              rethrow_instantition_error([M2:G|Parents]))
  193    ;   predicate_property(M2:G, number_of_rules(0))
  194    ),
  195    !.
  196safe(G, M, Parents, Safe0, Safe) :-
  197    predicate_property(G, iso),
  198    safe_meta_call(G, M, Called),
  199    !,
  200    add_iso_parent(G, Parents, Parents1),
  201    safe_list(Called, M, Parents1, Safe0, Safe).
  202safe(G, M, Parents, Safe0, Safe) :-
  203    (   predicate_property(M:G, imported_from(M2))
  204    ->  true
  205    ;   M2 = M
  206    ),
  207    safe_meta_call(M2:G, M, Called),
  208    !,
  209    safe_list(Called, M, Parents, Safe0, Safe).
  210safe(G, M, Parents, Safe0, Safe) :-
  211    goal_id(M:G, Id, Gen),
  212    (   get_assoc(Id, Safe0, _)
  213    ->  Safe = Safe0
  214    ;   put_assoc(Id, Safe0, true, Safe1),
  215        (   Gen == M:G
  216        ->  safe_clauses(Gen, M, [Id|Parents], Safe1, Safe)
  217        ;   catch(safe_clauses(Gen, M, [Id|Parents], Safe1, Safe),
  218                  error(instantiation_error, Ctx),
  219                  unsafe(Parents, Ctx))
  220        )
  221    ),
  222    !.
  223safe(G, M, Parents, _, _) :-
  224    debug(sandbox(fail),
  225          'safe/1 failed for ~p (parents:~p)', [M:G, Parents]),
  226    fail.
  227
  228unsafe(Parents, Var) :-
  229    var(Var),
  230    !,
  231    nb_setval(sandbox_last_error,
  232              error(instantiation_error, sandbox(_, Parents))),
  233    fail.
  234unsafe(_Parents, Ctx) :-
  235    Ctx = sandbox(_,_),
  236    nb_setval(sandbox_last_error,
  237              error(instantiation_error, Ctx)),
  238    fail.
  239
  240rethrow_instantition_error(Parents) :-
  241    throw(error(instantiation_error, sandbox(_, Parents))).
  242
  243safe_clauses(G, M, Parents, Safe0, Safe) :-
  244    predicate_property(M:G, interpreted),
  245    def_module(M:G, MD:QG),
  246    \+ compiled(MD:QG),
  247    !,
  248    findall(Ref-Body, clause(MD:QG, Body, Ref), Bodies),
  249    safe_bodies(Bodies, MD, Parents, Safe0, Safe).
  250safe_clauses(G, M, [_|Parents], _, _) :-
  251    predicate_property(M:G, visible),
  252    !,
  253    throw(error(permission_error(call, sandboxed, G),
  254                sandbox(M:G, Parents))).
  255safe_clauses(_, _, [G|Parents], _, _) :-
  256    throw(error(existence_error(procedure, G),
  257                sandbox(G, Parents))).
  258
  259compiled(system:(@(_,_))).
  260
  261known_module(M:_, _) :-
  262    current_module(M),
  263    !.
  264known_module(M:G, Parents) :-
  265    throw(error(permission_error(call, sandboxed, M:G),
  266                sandbox(M:G, Parents))).
  267
  268add_iso_parent(G, Parents, Parents) :-
  269    is_control(G),
  270    !.
  271add_iso_parent(G, Parents, [G|Parents]).
  272
  273is_control((_,_)).
  274is_control((_;_)).
  275is_control((_->_)).
  276is_control((_*->_)).
  277is_control(\+(_)).
  278
  279
  280%!  safe_bodies(+Bodies, +Module, +Parents, +Safe0, -Safe)
  281%
  282%   Verify the safety of bodies. If  a   clause  was compiled with a
  283%   qualified module, we  consider  execution  of   the  body  in  a
  284%   different module _not_ a cross-module call.
  285
  286safe_bodies([], _, _, Safe, Safe).
  287safe_bodies([Ref-H|T], M, Parents, Safe0, Safe) :-
  288    (   H = M2:H2, nonvar(M2),
  289        clause_property(Ref, module(M2))
  290    ->  copy_term(H2, H3),
  291        CM = M2
  292    ;   copy_term(H, H3),
  293        CM = M
  294    ),
  295    safe(H3, CM, Parents, Safe0, Safe1),
  296    safe_bodies(T, M, Parents, Safe1, Safe).
  297
  298def_module(M:G, MD:QG) :-
  299    predicate_property(M:G, imported_from(MD)),
  300    !,
  301    meta_qualify(MD:G, M, QG).
  302def_module(M:G, M:QG) :-
  303    meta_qualify(M:G, M, QG).
  304
  305%!  safe_list(+Called, +Module, +Parents, +Safe0, -Safe)
  306%
  307%   Processed objects called through meta  predicates. If the called
  308%   object  is  in  our  current  context    we  remove  the  module
  309%   qualification to avoid the cross-module check.
  310
  311safe_list([], _, _, Safe, Safe).
  312safe_list([H|T], M, Parents, Safe0, Safe) :-
  313    (   H = M2:H2,
  314        M == M2                             % in our context
  315    ->  copy_term(H2, H3)
  316    ;   copy_term(H, H3)                    % cross-module call
  317    ),
  318    safe(H3, M, Parents, Safe0, Safe1),
  319    safe_list(T, M, Parents, Safe1, Safe).
  320
  321%!  meta_qualify(:G, +M, -QG) is det.
  322%
  323%   Perform meta-qualification of the goal-argument
  324
  325meta_qualify(MD:G, M, QG) :-
  326    predicate_property(MD:G, meta_predicate(Head)),
  327    !,
  328    G =.. [Name|Args],
  329    Head =.. [_|Q],
  330    qualify_args(Q, M, Args, QArgs),
  331    QG =.. [Name|QArgs].
  332meta_qualify(_:G, _, G).
  333
  334qualify_args([], _, [], []).
  335qualify_args([H|T], M, [A|AT], [Q|QT]) :-
  336    qualify_arg(H, M, A, Q),
  337    qualify_args(T, M, AT, QT).
  338
  339qualify_arg(S, M, A, Q) :-
  340    q_arg(S),
  341    !,
  342    qualify(A, M, Q).
  343qualify_arg(_, _, A, A).
  344
  345q_arg(I) :- integer(I), !.
  346q_arg(:).
  347q_arg(^).
  348q_arg(//).
  349
  350qualify(A, M, MZ:Q) :-
  351    strip_module(M:A, MZ, Q).
  352
  353%!  goal_id(:Goal, -Id, -Gen) is nondet.
  354%
  355%   Generate an identifier for the goal proven to be safe. We
  356%   first try to prove the most general form of the goal.  If
  357%   this fails, we try to prove more specific versions.
  358%
  359%   @tbd    Do step-by-step generalisation instead of the current
  360%           two levels (most general and most specific).
  361%   @tbd    We could also use variant_sha1 for the goal ids.
  362
  363goal_id(M:Goal, M:Id, Gen) :-
  364    !,
  365    goal_id(Goal, Id, Gen).
  366goal_id(Var, _, _) :-
  367    var(Var),
  368    !,
  369    instantiation_error(Var).
  370goal_id(Atom, Atom, Atom) :-
  371    atom(Atom),
  372    !.
  373goal_id(Term, _, _) :-
  374    \+ compound(Term),
  375    !,
  376    type_error(callable, Term).
  377goal_id(Term, Skolem, Gen) :-           % most general form
  378    compound_name_arity(Term, Name, Arity),
  379    compound_name_arity(Skolem, Name, Arity),
  380    compound_name_arity(Gen, Name, Arity),
  381    copy_goal_args(1, Term, Skolem, Gen),
  382    (   Gen =@= Term
  383    ->  !                           % No more specific one; we can commit
  384    ;   true
  385    ),
  386    numbervars(Skolem, 0, _).
  387goal_id(Term, Skolem, Term) :-          % most specific form
  388    debug(sandbox(specify), 'Retrying with ~p', [Term]),
  389    copy_term(Term, Skolem),
  390    numbervars(Skolem, 0, _).
  391
  392%!  copy_goal_args(+I, +Term, +Skolem, +Gen) is det.
  393%
  394%   Create  the  most  general  form,   but  keep  module  qualified
  395%   arguments because they will likely be called anyway.
  396
  397copy_goal_args(I, Term, Skolem, Gen) :-
  398    arg(I, Term, TA),
  399    !,
  400    arg(I, Skolem, SA),
  401    arg(I, Gen, GA),
  402    copy_goal_arg(TA, SA, GA),
  403    I2 is I + 1,
  404    copy_goal_args(I2, Term, Skolem, Gen).
  405copy_goal_args(_, _, _, _).
  406
  407copy_goal_arg(Arg, SArg, Arg) :-
  408    copy_goal_arg(Arg),
  409    !,
  410    copy_term(Arg, SArg).
  411copy_goal_arg(_, _, _).
  412
  413copy_goal_arg(Var) :- var(Var), !, fail.
  414copy_goal_arg(_:_).
  415
  416%!  verify_safe_declaration(+Decl)
  417%
  418%   See whether a  safe  declaration  makes   sense.  That  is,  the
  419%   predicate must be defined (such that  the attacker cannot define
  420%   the predicate), must be sufficiently   instantiated and only ISO
  421%   declared predicates may omit a module qualification.
  422%
  423%   @tbd    Verify safe_meta/2 declarations.  It is a bit less clear
  424%           what the rules are.
  425
  426term_expansion(safe_primitive(Goal), Term) :-
  427    (   verify_safe_declaration(Goal)
  428    ->  Term = safe_primitive(Goal)
  429    ;   Term = []
  430    ).
  431term_expansion((safe_primitive(Goal) :- Body), Term) :-
  432    (   verify_safe_declaration(Goal)
  433    ->  Term = (safe_primitive(Goal) :- Body)
  434    ;   Term = []
  435    ).
  436
  437system:term_expansion(sandbox:safe_primitive(Goal), Term) :-
  438    \+ current_prolog_flag(xref, true),
  439    (   verify_safe_declaration(Goal)
  440    ->  Term = sandbox:safe_primitive(Goal)
  441    ;   Term = []
  442    ).
  443system:term_expansion((sandbox:safe_primitive(Goal) :- Body), Term) :-
  444    \+ current_prolog_flag(xref, true),
  445    (   verify_safe_declaration(Goal)
  446    ->  Term = (sandbox:safe_primitive(Goal) :- Body)
  447    ;   Term = []
  448    ).
  449
  450verify_safe_declaration(Var) :-
  451    var(Var),
  452    !,
  453    instantiation_error(Var).
  454verify_safe_declaration(Module:Goal) :-
  455    !,
  456    must_be(atom, Module),
  457    must_be(callable, Goal),
  458    (   ok_meta(Module:Goal)
  459    ->  true
  460    ;   (   predicate_property(Module:Goal, visible)
  461        ->  true
  462        ;   predicate_property(Module:Goal, foreign)
  463        ),
  464        \+ predicate_property(Module:Goal, imported_from(_)),
  465        \+ predicate_property(Module:Goal, meta_predicate(_))
  466    ->  true
  467    ;   permission_error(declare, safe_goal, Module:Goal)
  468    ).
  469verify_safe_declaration(Goal) :-
  470    must_be(callable, Goal),
  471    (   predicate_property(system:Goal, iso),
  472        \+ predicate_property(system:Goal, meta_predicate())
  473    ->  true
  474    ;   permission_error(declare, safe_goal, Goal)
  475    ).
  476
  477ok_meta(system:assert(_)).
  478ok_meta(system:load_files(_,_)).
  479ok_meta(system:use_module(_,_)).
  480ok_meta(system:use_module(_)).
  481ok_meta('$syspreds':predicate_property(_,_)).
  482
  483verify_predefined_safe_declarations :-
  484    forall(clause(safe_primitive(Goal), _Body, Ref),
  485           ( E = error(F,_),
  486             catch(verify_safe_declaration(Goal), E, true),
  487             (   nonvar(F)
  488             ->  clause_property(Ref, file(File)),
  489                 clause_property(Ref, line_count(Line)),
  490                 print_message(error, bad_safe_declaration(Goal, File, Line))
  491             ;   true
  492             )
  493           )).
  494
  495:- initialization(verify_predefined_safe_declarations, now).  496
  497%!  safe_primitive(?Goal) is nondet.
  498%
  499%   True if Goal is safe  to   call  (i.e.,  cannot access dangerous
  500%   system-resources and cannot upset  other   parts  of  the Prolog
  501%   process). There are two  types  of   facts.  ISO  built-ins  are
  502%   declared without a module prefix. This is safe because it is not
  503%   allowed to (re-)define these  primitives   (i.e.,  give  them an
  504%   unsafe     implementation)     and     the       way      around
  505%   (redefine_system_predicate/1) is unsafe.  The   other  group are
  506%   module-qualified and only match if the   system  infers that the
  507%   predicate is imported from the given module.
  508
  509% First, all ISO system predicates that are considered safe
  510
  511safe_primitive(true).
  512safe_primitive(fail).
  513safe_primitive(system:false).
  514safe_primitive(repeat).
  515safe_primitive(!).
  516                                        % types
  517safe_primitive(var(_)).
  518safe_primitive(nonvar(_)).
  519safe_primitive(system:attvar(_)).
  520safe_primitive(integer(_)).
  521safe_primitive(float(_)).
  522:- if(current_predicate(rational/1)).  523safe_primitive(system:rational(_)).
  524safe_primitive(system:rational(_,_,_)).
  525:- endif.  526safe_primitive(number(_)).
  527safe_primitive(atom(_)).
  528safe_primitive(system:blob(_,_)).
  529safe_primitive(system:string(_)).
  530safe_primitive(atomic(_)).
  531safe_primitive(compound(_)).
  532safe_primitive(callable(_)).
  533safe_primitive(ground(_)).
  534safe_primitive(system:nonground(_,_)).
  535safe_primitive(system:cyclic_term(_)).
  536safe_primitive(acyclic_term(_)).
  537safe_primitive(system:is_stream(_)).
  538safe_primitive(system:'$is_char'(_)).
  539safe_primitive(system:'$is_char_code'(_)).
  540safe_primitive(system:'$is_char_list'(_,_)).
  541safe_primitive(system:'$is_code_list'(_,_)).
  542                                        % ordering
  543safe_primitive(@>(_,_)).
  544safe_primitive(@>=(_,_)).
  545safe_primitive(==(_,_)).
  546safe_primitive(@<(_,_)).
  547safe_primitive(@=<(_,_)).
  548safe_primitive(compare(_,_,_)).
  549safe_primitive(sort(_,_)).
  550safe_primitive(keysort(_,_)).
  551safe_primitive(system: =@=(_,_)).
  552safe_primitive(system:'$btree_find_node'(_,_,_,_,_)).
  553
  554                                        % unification and equivalence
  555safe_primitive(=(_,_)).
  556safe_primitive(\=(_,_)).
  557safe_primitive(system:'?='(_,_)).
  558safe_primitive(system:unifiable(_,_,_)).
  559safe_primitive(unify_with_occurs_check(_,_)).
  560safe_primitive(\==(_,_)).
  561                                        % arithmetic
  562safe_primitive(is(_,_)).
  563safe_primitive(>(_,_)).
  564safe_primitive(>=(_,_)).
  565safe_primitive(=:=(_,_)).
  566safe_primitive(=\=(_,_)).
  567safe_primitive(=<(_,_)).
  568safe_primitive(<(_,_)).
  569:- if(current_prolog_flag(bounded, false)).  570safe_primitive(system:nth_integer_root_and_remainder(_,_,_,_)).
  571:- endif.  572safe_primitive(system:current_arithmetic_function(_)).
  573safe_primitive(system:bounded_number(_,_,_)).
  574safe_primitive(system:float_class(_,_)).
  575safe_primitive(system:float_parts(_,_,_,_)).
  576
  577                                        % term-handling
  578safe_primitive(arg(_,_,_)).
  579safe_primitive(system:setarg(_,_,_)).
  580safe_primitive(system:nb_setarg(_,_,_)).
  581safe_primitive(system:nb_linkarg(_,_,_)).
  582safe_primitive(functor(_,_,_)).
  583safe_primitive(system:functor(_,_,_,_)).
  584safe_primitive(_ =.. _).
  585safe_primitive(system:compound_name_arity(_,_,_)).
  586safe_primitive(system:compound_name_arguments(_,_,_)).
  587safe_primitive(system:'$filled_array'(_,_,_,_)).
  588safe_primitive(copy_term(_,_)).
  589safe_primitive(system:copy_term(_,_,_,_)).
  590safe_primitive(system:duplicate_term(_,_)).
  591safe_primitive(system:copy_term_nat(_,_)).
  592safe_primitive(system:size_abstract_term(_,_,_)).
  593safe_primitive(numbervars(_,_,_)).
  594safe_primitive(system:numbervars(_,_,_,_)).
  595safe_primitive(subsumes_term(_,_)).
  596safe_primitive(system:term_hash(_,_)).
  597safe_primitive(system:term_hash(_,_,_,_)).
  598safe_primitive(system:variant_sha1(_,_)).
  599safe_primitive(system:variant_hash(_,_)).
  600safe_primitive(system:'$term_size'(_,_,_)).
  601
  602                                        % dicts
  603safe_primitive(system:is_dict(_)).
  604safe_primitive(system:is_dict(_,_)).
  605safe_primitive(system:get_dict(_,_,_)).
  606safe_primitive(system:get_dict(_,_,_,_,_)).
  607safe_primitive(system:'$get_dict_ex'(_,_,_)).
  608safe_primitive(system:dict_create(_,_,_)).
  609safe_primitive(system:dict_pairs(_,_,_)).
  610safe_primitive(system:put_dict(_,_,_)).
  611safe_primitive(system:put_dict(_,_,_,_)).
  612safe_primitive(system:del_dict(_,_,_,_)).
  613safe_primitive(system:select_dict(_,_,_)).
  614safe_primitive(system:b_set_dict(_,_,_)).
  615safe_primitive(system:nb_set_dict(_,_,_)).
  616safe_primitive(system:nb_link_dict(_,_,_)).
  617safe_primitive(system:(:<(_,_))).
  618safe_primitive(system:(>:<(_,_))).
  619                                        % atoms
  620safe_primitive(atom_chars(_, _)).
  621safe_primitive(atom_codes(_, _)).
  622safe_primitive(sub_atom(_,_,_,_,_)).
  623safe_primitive(atom_concat(_,_,_)).
  624safe_primitive(atom_length(_,_)).
  625safe_primitive(char_code(_,_)).
  626safe_primitive(system:name(_,_)).
  627safe_primitive(system:atomic_concat(_,_,_)).
  628safe_primitive(system:atomic_list_concat(_,_)).
  629safe_primitive(system:atomic_list_concat(_,_,_)).
  630safe_primitive(system:downcase_atom(_,_)).
  631safe_primitive(system:upcase_atom(_,_)).
  632safe_primitive(system:char_type(_,_)).
  633safe_primitive(system:normalize_space(_,_)).
  634safe_primitive(system:sub_atom_icasechk(_,_,_)).
  635                                        % numbers
  636safe_primitive(number_codes(_,_)).
  637safe_primitive(number_chars(_,_)).
  638safe_primitive(system:atom_number(_,_)).
  639safe_primitive(system:code_type(_,_)).
  640                                        % strings
  641safe_primitive(system:atom_string(_,_)).
  642safe_primitive(system:number_string(_,_)).
  643safe_primitive(system:string_chars(_, _)).
  644safe_primitive(system:string_codes(_, _)).
  645safe_primitive(system:string_code(_,_,_)).
  646safe_primitive(system:sub_string(_,_,_,_,_)).
  647safe_primitive(system:split_string(_,_,_,_)).
  648safe_primitive(system:atomics_to_string(_,_,_)).
  649safe_primitive(system:atomics_to_string(_,_)).
  650safe_primitive(system:string_concat(_,_,_)).
  651safe_primitive(system:string_length(_,_)).
  652safe_primitive(system:string_lower(_,_)).
  653safe_primitive(system:string_upper(_,_)).
  654safe_primitive(system:term_string(_,_)).
  655safe_primitive('$syspreds':term_string(_,_,_)).
  656                                        % Lists
  657safe_primitive(length(_,_)).
  658                                        % exceptions
  659safe_primitive(throw(_)).
  660safe_primitive(system:abort).
  661                                        % misc
  662safe_primitive(current_prolog_flag(_,_)).
  663safe_primitive(current_op(_,_,_)).
  664safe_primitive(system:sleep(_)).
  665safe_primitive(system:thread_self(_)).
  666safe_primitive(system:get_time(_)).
  667safe_primitive(system:statistics(_,_)).
  668:- if(current_prolog_flag(threads,true)).  669safe_primitive(system:thread_statistics(Id,_,_)) :-
  670    (   var(Id)
  671    ->  instantiation_error(Id)
  672    ;   thread_self(Id)
  673    ).
  674safe_primitive(system:thread_property(Id,_)) :-
  675    (   var(Id)
  676    ->  instantiation_error(Id)
  677    ;   thread_self(Id)
  678    ).
  679:- endif.  680safe_primitive(system:format_time(_,_,_)).
  681safe_primitive(system:format_time(_,_,_,_)).
  682safe_primitive(system:date_time_stamp(_,_)).
  683safe_primitive(system:stamp_date_time(_,_,_)).
  684safe_primitive(system:strip_module(_,_,_)).
  685safe_primitive('$messages':message_to_string(_,_)).
  686safe_primitive(system:import_module(_,_)).
  687safe_primitive(system:file_base_name(_,_)).
  688safe_primitive(system:file_directory_name(_,_)).
  689safe_primitive(system:file_name_extension(_,_,_)).
  690
  691safe_primitive(clause(H,_)) :- safe_clause(H).
  692safe_primitive(asserta(X)) :- safe_assert(X).
  693safe_primitive(assertz(X)) :- safe_assert(X).
  694safe_primitive(retract(X)) :- safe_assert(X).
  695safe_primitive(retractall(X)) :- safe_assert(X).
  696safe_primitive(current_predicate(X)) :- safe_current_predicate(X).
  697safe_primitive('$dcg':dcg_translate_rule(_,_)).
  698safe_primitive('$syspreds':predicate_property(Pred, _)) :-
  699    nonvar(Pred),
  700    Pred \= (_:_).
  701
  702% We need to do data flow analysis to find the tag of the
  703% target key before we can conclude that functions on dicts
  704% are safe.
  705safe_primitive('$dicts':'.'(_,K,_)) :- atom(K).
  706safe_primitive('$dicts':'.'(_,K,_)) :-
  707    (   nonvar(K)
  708    ->  dict_built_in(K)
  709    ;   instantiation_error(K)
  710    ).
  711
  712dict_built_in(get(_)).
  713dict_built_in(get(_,_)).
  714dict_built_in(put(_)).
  715dict_built_in(put(_,_)).
  716
  717% The non-ISO system predicates.  These can be redefined, so we must
  718% be careful to ensure the system ones are used.
  719
  720safe_primitive(system:false).
  721safe_primitive(system:cyclic_term(_)).
  722safe_primitive(system:msort(_,_)).
  723safe_primitive(system:sort(_,_,_,_)).
  724safe_primitive(system:between(_,_,_)).
  725safe_primitive(system:succ(_,_)).
  726safe_primitive(system:plus(_,_,_)).
  727safe_primitive(system:float_class(_,_)).
  728safe_primitive(system:term_singletons(_,_)).
  729safe_primitive(system:term_variables(_,_)).
  730safe_primitive(system:term_variables(_,_,_)).
  731safe_primitive(system:'$term_size'(_,_,_)).
  732safe_primitive(system:atom_to_term(_,_,_)).
  733safe_primitive(system:term_to_atom(_,_)).
  734safe_primitive(system:atomic_list_concat(_,_,_)).
  735safe_primitive(system:atomic_list_concat(_,_)).
  736safe_primitive(system:downcase_atom(_,_)).
  737safe_primitive(system:upcase_atom(_,_)).
  738safe_primitive(system:is_list(_)).
  739safe_primitive(system:memberchk(_,_)).
  740safe_primitive(system:'$skip_list'(_,_,_)).
  741safe_primitive(system:'$seek_list'(_, _, _, _)).
  742                                        % attributes
  743safe_primitive(system:get_attr(_,_,_)).
  744safe_primitive(system:get_attrs(_,_)).
  745safe_primitive(system:term_attvars(_,_)).
  746safe_primitive(system:del_attr(_,_)).
  747safe_primitive(system:del_attrs(_)).
  748safe_primitive('$attvar':copy_term(_,_,_)).
  749                                        % globals
  750safe_primitive(system:b_getval(_,_)).
  751safe_primitive(system:b_setval(Var,_)) :-
  752    safe_global_var(Var).
  753safe_primitive(system:nb_getval(_,_)).
  754safe_primitive('$syspreds':nb_setval(Var,_)) :-
  755    safe_global_var(Var).
  756safe_primitive(system:nb_linkval(Var,_)) :-
  757    safe_global_var(Var).
  758safe_primitive(system:nb_current(_,_)).
  759                                        % database
  760safe_primitive(system:assert(X)) :-
  761    safe_assert(X).
  762                                        % Output
  763safe_primitive(system:writeln(_)).
  764safe_primitive('$messages':print_message(_,_)).
  765
  766                                        % Stack limits (down)
  767safe_primitive('$syspreds':set_prolog_stack(Stack, limit(ByteExpr))) :-
  768    nonvar(Stack),
  769    stack_name(Stack),
  770    catch(Bytes is ByteExpr, _, fail),
  771    prolog_stack_property(Stack, limit(Current)),
  772    Bytes =< Current.
  773
  774stack_name(global).
  775stack_name(local).
  776stack_name(trail).
  777
  778safe_primitive('$tabling':abolish_all_tables).
  779safe_primitive('$tabling':'$wrap_tabled'(Module:_Head, _Mode)) :-
  780    prolog_load_context(module, Module),
  781    !.
  782safe_primitive('$tabling':'$moded_wrap_tabled'(Module:_Head,_,_,_,_)) :-
  783    prolog_load_context(module, Module),
  784    !.
  785
  786
  787% use_module/1.  We only allow for .pl files that are loaded from
  788% relative paths that do not contain /../
  789
  790safe_primitive(system:use_module(Spec, _Import)) :-
  791    safe_primitive(system:use_module(Spec)).
  792safe_primitive(system:load_files(Spec, Options)) :-
  793    safe_primitive(system:use_module(Spec)),
  794    maplist(safe_load_file_option, Options).
  795safe_primitive(system:use_module(Spec)) :-
  796    ground(Spec),
  797    (   atom(Spec)
  798    ->  Path = Spec
  799    ;   Spec =.. [_Alias, Segments],
  800        phrase(segments_to_path(Segments), List),
  801        atomic_list_concat(List, Path)
  802    ),
  803    \+ is_absolute_file_name(Path),
  804    \+ sub_atom(Path, _, _, _, '/../'),
  805    absolute_file_name(Spec, AbsFile,
  806                       [ access(read),
  807                         file_type(prolog),
  808                         file_errors(fail)
  809                       ]),
  810    file_name_extension(_, Ext, AbsFile),
  811    save_extension(Ext).
  812
  813% support predicates for safe_primitive, validating the safety of
  814% arguments to certain goals.
  815
  816segments_to_path(A/B) -->
  817    !,
  818    segments_to_path(A),
  819    [/],
  820    segments_to_path(B).
  821segments_to_path(X) -->
  822    [X].
  823
  824save_extension(pl).
  825
  826safe_load_file_option(if(changed)).
  827safe_load_file_option(if(not_loaded)).
  828safe_load_file_option(must_be_module(_)).
  829safe_load_file_option(optimise(_)).
  830safe_load_file_option(silent(_)).
  831
  832%!  safe_assert(+Term) is semidet.
  833%
  834%   True if assert(Term) is safe,  which   means  it  asserts in the
  835%   current module. Cross-module asserts are   considered unsafe. We
  836%   only allow for adding facts. In theory,  we could also allow for
  837%   rules if we prove the safety of the body.
  838
  839safe_assert(C) :- cyclic_term(C), !, fail.
  840safe_assert(X) :- var(X), !, fail.
  841safe_assert(_Head:-_Body) :- !, fail.
  842safe_assert(_:_) :- !, fail.
  843safe_assert(_).
  844
  845%!  safe_clause(+Head) is semidet.
  846%
  847%   Consider a call to clause safe if  it   does  not try to cross a
  848%   module boundary. Cross-module usage  of   clause/2  can  extract
  849%   private information from other modules.
  850
  851safe_clause(H) :- var(H), !.
  852safe_clause(_:_) :- !, fail.
  853safe_clause(_).
  854
  855
  856%!  safe_global_var(+Name) is semidet.
  857%
  858%   True if Name  is  a  global   variable  to  which  assertion  is
  859%   considered safe.
  860
  861safe_global_var(Name) :-
  862    var(Name),
  863    !,
  864    instantiation_error(Name).
  865safe_global_var(Name) :-
  866    safe_global_variable(Name).
  867
  868%!  safe_global_variable(Name) is semidet.
  869%
  870%   Declare the given global variable safe to write to.
  871
  872%!  safe_current_predicate(+X)
  873%
  874%   current_predicate/1 is safe when not used with qualification.
  875
  876safe_current_predicate(X) :-
  877    nonvar(X),
  878    X = _:_, !,
  879    fail.
  880safe_current_predicate(_).
  881
  882%!  safe_meta(+Goal, -Called:list(callable)) is semidet.
  883%
  884%   Hook. True if Goal is a   meta-predicate that is considered safe
  885%   iff all elements in Called are safe.
  886
  887safe_meta(system:put_attr(V,M,A), Called) :-
  888    !,
  889    (   atom(M)
  890    ->  attr_hook_predicates([ attr_unify_hook(A, _),
  891                               attribute_goals(V,_,_),
  892                               project_attributes(_,_)
  893                             ], M, Called)
  894    ;   instantiation_error(M)
  895    ).
  896safe_meta(system:with_output_to(Output, G), [G]) :-
  897    safe_output(Output),
  898    !.
  899safe_meta(system:format(Format, Args), Calls) :-
  900    format_calls(Format, Args, Calls).
  901safe_meta(system:format(Output, Format, Args), Calls) :-
  902    safe_output(Output),
  903    format_calls(Format, Args, Calls).
  904safe_meta(prolog_debug:debug(_Term, Format, Args), Calls) :-
  905    format_calls(Format, Args, Calls).
  906safe_meta(system:set_prolog_flag(Flag, Value), []) :-
  907    atom(Flag),
  908    safe_prolog_flag(Flag, Value).
  909safe_meta('$attvar':freeze(_Var,Goal), [Goal]).
  910safe_meta(phrase(NT,Xs0,Xs), [Goal]) :- % phrase/2,3 and call_dcg/2,3
  911    expand_nt(NT,Xs0,Xs,Goal).
  912safe_meta(phrase(NT,Xs0), [Goal]) :-
  913    expand_nt(NT,Xs0,[],Goal).
  914safe_meta('$dcg':call_dcg(NT,Xs0,Xs), [Goal]) :-
  915    expand_nt(NT,Xs0,Xs,Goal).
  916safe_meta('$dcg':call_dcg(NT,Xs0), [Goal]) :-
  917    expand_nt(NT,Xs0,[],Goal).
  918safe_meta('$tabling':abolish_table_subgoals(V), []) :-
  919    \+ qualified(V).
  920safe_meta('$tabling':current_table(V, _), []) :-
  921    \+ qualified(V).
  922safe_meta('$tabling':tnot(G), [G]).
  923safe_meta('$tabling':not_exists(G), [G]).
  924
  925qualified(V) :-
  926    nonvar(V),
  927    V = _:_.
  928
  929%!  attr_hook_predicates(+Hooks0, +Module, -Hooks) is det.
  930%
  931%   Filter the defined hook implementations.   This  is safe because
  932%   (1) calling an undefined predicate is   not  a safety issue, (2)
  933%   the  user  an  only  assert  in  the  current  module  and  only
  934%   predicates that have a safe body. This avoids the need to define
  935%   attribute hooks solely for the purpose of making them safe.
  936
  937attr_hook_predicates([], _, []).
  938attr_hook_predicates([H|T], M, Called) :-
  939    (   predicate_property(M:H, defined)
  940    ->  Called = [M:H|Rest]
  941    ;   Called = Rest
  942    ),
  943    attr_hook_predicates(T, M, Rest).
  944
  945
  946%!  expand_nt(+NT, ?Xs0, ?Xs, -NewGoal)
  947%
  948%   Similar to expand_phrase/2, but we do   throw  errors instead of
  949%   failing if NT is not sufficiently instantiated.
  950
  951expand_nt(NT, _Xs0, _Xs, _NewGoal) :-
  952    strip_module(NT, _, Plain),
  953    var(Plain),
  954    !,
  955    instantiation_error(Plain).
  956expand_nt(NT, Xs0, Xs, NewGoal) :-
  957    dcg_translate_rule((pseudo_nt --> NT),
  958                       (pseudo_nt(Xs0c,Xsc) :- NewGoal0)),
  959    (   var(Xsc), Xsc \== Xs0c
  960    ->  Xs = Xsc, NewGoal1 = NewGoal0
  961    ;   NewGoal1 = (NewGoal0, Xsc = Xs)
  962    ),
  963    (   var(Xs0c)
  964    ->  Xs0 = Xs0c,
  965        NewGoal = NewGoal1
  966    ;   NewGoal = ( Xs0 = Xs0c, NewGoal1 )
  967    ).
  968
  969%!  safe_meta_call(+Goal, +Context, -Called:list(callable)) is semidet.
  970%
  971%   True if Goal is a   meta-predicate that is considered safe
  972%   iff all elements in Called are safe.
  973
  974safe_meta_call(Goal, _, _Called) :-
  975    debug(sandbox(meta), 'Safe meta ~p?', [Goal]),
  976    fail.
  977safe_meta_call(Goal, Context, Called) :-
  978    (   safe_meta(Goal, Called)
  979    ->  true
  980    ;   safe_meta(Goal, Context, Called)
  981    ),
  982    !.     % call hook
  983safe_meta_call(Goal, _, Called) :-
  984    Goal = M:Plain,
  985    compound(Plain),
  986    compound_name_arity(Plain, Name, Arity),
  987    safe_meta_predicate(M:Name/Arity),
  988    predicate_property(Goal, meta_predicate(Spec)),
  989    !,
  990    called(Spec, Plain, Called).
  991safe_meta_call(M:Goal, _, Called) :-
  992    !,
  993    generic_goal(Goal, Gen),
  994    safe_meta(M:Gen),
  995    called(Gen, Goal, Called).
  996safe_meta_call(Goal, _, Called) :-
  997    generic_goal(Goal, Gen),
  998    safe_meta(Gen),
  999    called(Gen, Goal, Called).
 1000
 1001called(Gen, Goal, Called) :-
 1002    compound_name_arity(Goal, _, Arity),
 1003    called(1, Arity, Gen, Goal, Called).
 1004
 1005called(I, Arity, Gen, Goal, Called) :-
 1006    I =< Arity,
 1007    !,
 1008    arg(I, Gen, Spec),
 1009    (   calling_meta_spec(Spec)
 1010    ->  arg(I, Goal, Called0),
 1011        extend(Spec, Called0, G),
 1012        Called = [G|Rest]
 1013    ;   Called = Rest
 1014    ),
 1015    I2 is I+1,
 1016    called(I2, Arity, Gen, Goal, Rest).
 1017called(_, _, _, _, []).
 1018
 1019generic_goal(G, Gen) :-
 1020    functor(G, Name, Arity),
 1021    functor(Gen, Name, Arity).
 1022
 1023calling_meta_spec(V) :- var(V), !, fail.
 1024calling_meta_spec(I) :- integer(I), !.
 1025calling_meta_spec(^).
 1026calling_meta_spec(//).
 1027
 1028
 1029extend(^, G, Plain) :-
 1030    !,
 1031    strip_existential(G, Plain).
 1032extend(//, DCG, Goal) :-
 1033    !,
 1034    (   expand_phrase(call_dcg(DCG,_,_), Goal)
 1035    ->  true
 1036    ;   instantiation_error(DCG)    % Ask more instantiation.
 1037    ).                              % might not help, but does not harm.
 1038extend(0, G, G) :- !.
 1039extend(I, M:G0, M:G) :-
 1040    !,
 1041    G0 =.. List,
 1042    length(Extra, I),
 1043    append(List, Extra, All),
 1044    G =.. All.
 1045extend(I, G0, G) :-
 1046    G0 =.. List,
 1047    length(Extra, I),
 1048    append(List, Extra, All),
 1049    G =.. All.
 1050
 1051strip_existential(Var, Var) :-
 1052    var(Var),
 1053    !.
 1054strip_existential(M:G0, M:G) :-
 1055    !,
 1056    strip_existential(G0, G).
 1057strip_existential(_^G0, G) :-
 1058    !,
 1059    strip_existential(G0, G).
 1060strip_existential(G, G).
 1061
 1062%!  safe_meta(?Template).
 1063
 1064safe_meta((0,0)).
 1065safe_meta((0;0)).
 1066safe_meta((0->0)).
 1067safe_meta(system:(0*->0)).
 1068safe_meta(catch(0,*,0)).
 1069safe_meta(findall(*,0,*)).
 1070safe_meta('$bags':findall(*,0,*,*)).
 1071safe_meta(setof(*,^,*)).
 1072safe_meta(bagof(*,^,*)).
 1073safe_meta('$bags':findnsols(*,*,0,*)).
 1074safe_meta('$bags':findnsols(*,*,0,*,*)).
 1075safe_meta(system:call_cleanup(0,0)).
 1076safe_meta(system:setup_call_cleanup(0,0,0)).
 1077safe_meta(system:setup_call_catcher_cleanup(0,0,*,0)).
 1078safe_meta('$attvar':call_residue_vars(0,*)).
 1079safe_meta('$syspreds':call_with_inference_limit(0,*,*)).
 1080safe_meta('$syspreds':call_with_depth_limit(0,*,*)).
 1081safe_meta('$syspreds':undo(0)).
 1082safe_meta(^(*,0)).
 1083safe_meta(\+(0)).
 1084safe_meta(call(0)).
 1085safe_meta(call(1,*)).
 1086safe_meta(call(2,*,*)).
 1087safe_meta(call(3,*,*,*)).
 1088safe_meta(call(4,*,*,*,*)).
 1089safe_meta(call(5,*,*,*,*,*)).
 1090safe_meta(call(6,*,*,*,*,*,*)).
 1091safe_meta('$tabling':start_tabling(*,0)).
 1092safe_meta('$tabling':start_tabling(*,0,*,*)).
 1093safe_meta(wfs:call_delays(0,*)).
 1094
 1095%!  safe_output(+Output)
 1096%
 1097%   True if something is a safe output argument for with_output_to/2
 1098%   and friends. We do not want writing to streams.
 1099
 1100safe_output(Output) :-
 1101    var(Output),
 1102    !,
 1103    instantiation_error(Output).
 1104safe_output(atom(_)).
 1105safe_output(string(_)).
 1106safe_output(codes(_)).
 1107safe_output(codes(_,_)).
 1108safe_output(chars(_)).
 1109safe_output(chars(_,_)).
 1110safe_output(current_output).
 1111safe_output(current_error).
 1112
 1113%!  format_calls(+Format, +FormatArgs, -Calls)
 1114%
 1115%   Find ~@ calls from Format and Args.
 1116
 1117:- public format_calls/3.                       % used in pengines_io
 1118
 1119format_calls(Format, Args, Calls) :-
 1120    is_list(Args),
 1121    !,
 1122    format_types(Format, Types),
 1123    (   format_callables(Types, Args, Calls)
 1124    ->  true
 1125    ;   throw(error(format_error(Format, Types, Args), _))
 1126    ).
 1127format_calls(Format, Arg, Calls) :-
 1128    format_calls(Format, [Arg], Calls).
 1129
 1130format_callables([], [], []).
 1131format_callables([callable|TT], [G|TA], [G|TG]) :-
 1132    !,
 1133    format_callables(TT, TA, TG).
 1134format_callables([_|TT], [_|TA], TG) :-
 1135    !,
 1136    format_callables(TT, TA, TG).
 1137
 1138
 1139                 /*******************************
 1140                 *    SAFE COMPILATION HOOKS    *
 1141                 *******************************/
 1142
 1143:- multifile
 1144    prolog:sandbox_allowed_directive/1,
 1145    prolog:sandbox_allowed_goal/1,
 1146    prolog:sandbox_allowed_expansion/1. 1147
 1148%!  prolog:sandbox_allowed_directive(:G) is det.
 1149%
 1150%   Throws an exception if G is not considered a safe directive.
 1151
 1152prolog:sandbox_allowed_directive(Directive) :-
 1153    debug(sandbox(directive), 'Directive: ~p', [Directive]),
 1154    fail.
 1155prolog:sandbox_allowed_directive(Directive) :-
 1156    safe_directive(Directive),
 1157    !.
 1158prolog:sandbox_allowed_directive(M:PredAttr) :-
 1159    \+ prolog_load_context(module, M),
 1160    !,
 1161    debug(sandbox(directive), 'Cross-module directive', []),
 1162    permission_error(execute, sandboxed_directive, (:- M:PredAttr)).
 1163prolog:sandbox_allowed_directive(M:PredAttr) :-
 1164    safe_pattr(PredAttr),
 1165    !,
 1166    PredAttr =.. [Attr, Preds],
 1167    (   safe_pattr(Preds, Attr)
 1168    ->  true
 1169    ;   permission_error(execute, sandboxed_directive, (:- M:PredAttr))
 1170    ).
 1171prolog:sandbox_allowed_directive(_:Directive) :-
 1172    safe_source_directive(Directive),
 1173    !.
 1174prolog:sandbox_allowed_directive(_:Directive) :-
 1175    directive_loads_file(Directive, File),
 1176    !,
 1177    safe_path(File).
 1178prolog:sandbox_allowed_directive(G) :-
 1179    safe_goal(G).
 1180
 1181%!  safe_directive(:Directive) is semidet.
 1182%
 1183%   Hook to declare additional directives as safe. The argument is a
 1184%   term `Module:Directive` (without =|:-|= wrapper).  In almost all
 1185%   cases, the implementation must verify that   the `Module` is the
 1186%   current load context as illustrated  below.   This  check is not
 1187%   performed by the system to  allow   for  cases  where particular
 1188%   cross-module directives are allowed.
 1189%
 1190%     ==
 1191%     sandbox:safe_directive(M:Directive) :-
 1192%         prolog_load_context(module, M),
 1193%         ...
 1194%     ==
 1195
 1196
 1197safe_pattr(dynamic(_)).
 1198safe_pattr(thread_local(_)).
 1199safe_pattr(volatile(_)).
 1200safe_pattr(discontiguous(_)).
 1201safe_pattr(multifile(_)).
 1202safe_pattr(public(_)).
 1203safe_pattr(meta_predicate(_)).
 1204safe_pattr(table(_)).
 1205safe_pattr(non_terminal(_)).
 1206
 1207safe_pattr(Var, _) :-
 1208    var(Var),
 1209    !,
 1210    instantiation_error(Var).
 1211safe_pattr((A,B), Attr) :-
 1212    !,
 1213    safe_pattr(A, Attr),
 1214    safe_pattr(B, Attr).
 1215safe_pattr(M:G, Attr) :-
 1216    !,
 1217    (   atom(M),
 1218        prolog_load_context(module, M)
 1219    ->  true
 1220    ;   Goal =.. [Attr,M:G],
 1221        permission_error(directive, sandboxed, (:- Goal))
 1222    ).
 1223safe_pattr(_, _).
 1224
 1225safe_source_directive(op(_,_,Name)) :-
 1226    !,
 1227    (   atom(Name)
 1228    ->  true
 1229    ;   is_list(Name),
 1230        maplist(atom, Name)
 1231    ).
 1232safe_source_directive(set_prolog_flag(Flag, Value)) :-
 1233    !,
 1234    atom(Flag), ground(Value),
 1235    safe_prolog_flag(Flag, Value).
 1236safe_source_directive(style_check(_)).
 1237safe_source_directive(initialization(_)).   % Checked at runtime
 1238safe_source_directive(initialization(_,_)). % Checked at runtime
 1239
 1240directive_loads_file(use_module(library(X)), X).
 1241directive_loads_file(use_module(library(X), _Imports), X).
 1242directive_loads_file(load_files(library(X), _Options), X).
 1243directive_loads_file(ensure_loaded(library(X)), X).
 1244directive_loads_file(include(X), X).
 1245
 1246safe_path(X) :-
 1247    var(X),
 1248    !,
 1249    instantiation_error(X).
 1250safe_path(X) :-
 1251    (   atom(X)
 1252    ;   string(X)
 1253    ),
 1254    !,
 1255    \+ sub_atom(X, 0, _, 0, '..'),
 1256    \+ sub_atom(X, 0, _, _, '/'),
 1257    \+ sub_atom(X, 0, _, _, '../'),
 1258    \+ sub_atom(X, _, _, 0, '/..'),
 1259    \+ sub_atom(X, _, _, _, '/../').
 1260safe_path(A/B) :-
 1261    !,
 1262    safe_path(A),
 1263    safe_path(B).
 1264
 1265
 1266%!  safe_prolog_flag(+Flag, +Value) is det.
 1267%
 1268%   True if it is safe to set the flag Flag to Value.
 1269%
 1270%   @tbd    If we can avoid that files are loaded after changing
 1271%           this flag, we can allow for more flags.  The syntax
 1272%           flags are safe because they are registered with the
 1273%           module.
 1274
 1275% misc
 1276safe_prolog_flag(generate_debug_info, _).
 1277safe_prolog_flag(optimise, _).
 1278safe_prolog_flag(occurs_check, _).
 1279safe_prolog_flag(write_attributes, _).
 1280% syntax
 1281safe_prolog_flag(var_prefix, _).
 1282safe_prolog_flag(double_quotes, _).
 1283safe_prolog_flag(back_quotes, _).
 1284safe_prolog_flag(rational_syntax, _).
 1285% arithmetic
 1286safe_prolog_flag(prefer_rationals, _).
 1287safe_prolog_flag(float_overflow, _).
 1288safe_prolog_flag(float_zero_div, _).
 1289safe_prolog_flag(float_undefined, _).
 1290safe_prolog_flag(float_underflow, _).
 1291safe_prolog_flag(float_rounding, _).
 1292safe_prolog_flag(float_rounding, _).
 1293safe_prolog_flag(max_rational_size, _).
 1294safe_prolog_flag(max_rational_size_action, _).
 1295% tabling
 1296safe_prolog_flag(max_answers_for_subgoal,_).
 1297safe_prolog_flag(max_answers_for_subgoal_action,_).
 1298safe_prolog_flag(max_table_answer_size,_).
 1299safe_prolog_flag(max_table_answer_size_action,_).
 1300safe_prolog_flag(max_table_subgoal_size,_).
 1301safe_prolog_flag(max_table_subgoal_size_action,_).
 1302
 1303
 1304%!  prolog:sandbox_allowed_expansion(:G) is det.
 1305%
 1306%   Throws an exception if G  is   not  considered  a safe expansion
 1307%   goal. This deals with call-backs from the compiler for
 1308%
 1309%     - goal_expansion/2
 1310%     - term_expansion/2
 1311%     - Quasi quotations.
 1312%
 1313%   Our assumption is that external expansion rules are coded safely
 1314%   and we only need to be  careful   if  the sandboxed code defines
 1315%   expansion rules.
 1316
 1317prolog:sandbox_allowed_expansion(M:G) :-
 1318    prolog_load_context(module, M),
 1319    !,
 1320    debug(sandbox(expansion), 'Expand in ~p: ~p', [M, G]),
 1321    safe_goal(M:G).
 1322prolog:sandbox_allowed_expansion(_,_).
 1323
 1324%!  prolog:sandbox_allowed_goal(:G) is det.
 1325%
 1326%   Throw an exception if it is not safe to call G
 1327
 1328prolog:sandbox_allowed_goal(G) :-
 1329    safe_goal(G).
 1330
 1331
 1332                 /*******************************
 1333                 *            MESSAGES          *
 1334                 *******************************/
 1335
 1336:- multifile
 1337    prolog:message//1,
 1338    prolog:message_context//1,
 1339    prolog:error_message//1. 1340
 1341prolog:message(error(instantiation_error, Context)) -->
 1342    { nonvar(Context),
 1343      Context = sandbox(_Goal,Parents),
 1344      numbervars(Context, 1, _)
 1345    },
 1346    [ 'Sandbox restriction!'-[], nl,
 1347      'Could not derive which predicate may be called from'-[]
 1348    ],
 1349    (   { Parents == [] }
 1350    ->  [ 'Search space too large'-[] ]
 1351    ;   callers(Parents, 10)
 1352    ).
 1353
 1354prolog:message_context(sandbox(_G, [])) --> !.
 1355prolog:message_context(sandbox(_G, Parents)) -->
 1356    [ nl, 'Reachable from:'-[] ],
 1357    callers(Parents, 10).
 1358
 1359callers([], _) --> !.
 1360callers(_,  0) --> !.
 1361callers([G|Parents], Level) -->
 1362    { NextLevel is Level-1
 1363    },
 1364    [ nl, '\t  ~p'-[G] ],
 1365    callers(Parents, NextLevel).
 1366
 1367prolog:message(bad_safe_declaration(Goal, File, Line)) -->
 1368    [ '~w:~d: Invalid safe_primitive/1 declaration: ~p'-
 1369      [File, Line, Goal] ].
 1370
 1371prolog:error_message(format_error(Format, Types, Args)) -->
 1372    format_error(Format, Types, Args).
 1373
 1374format_error(Format, Types, Args) -->
 1375    { length(Types, TypeLen),
 1376      length(Args, ArgsLen),
 1377      (   TypeLen > ArgsLen
 1378      ->  Problem = 'not enough'
 1379      ;   Problem = 'too many'
 1380      )
 1381    },
 1382    [ 'format(~q): ~w arguments (found ~w, need ~w)'-
 1383      [Format, Problem, ArgsLen, TypeLen]
 1384    ]