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