View source with raw comments or as raw
    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).

Sandboxed Prolog code

Prolog is a full-featured Turing complete programming language in which it is easy to write programs that can harm your computer. On the other hand, Prolog is a logic based query language which can be exploited to query data interactively from, e.g., the web. This library provides safe_goal/1, which determines whether it is safe to call its argument.

See also
- http://www.swi-prolog.org/pldoc/package/pengines.html */
To be done
- Handling of ^ and // meta predicates
- Complete set of whitelisted predicates
   70:- meta_predicate
   71    safe_goal(:),
   72    safe_call(0).
 safe_call(:Goal)
Call Goal if it complies with the sandboxing rules. Before calling Goal, it performs expand_goal/2, followed by safe_goal/1. Expanding is done explicitly because situations in which safe_call/1 typically concern goals that are not known at compile time.
See also
- safe_goal/1.
   84safe_call(Goal0) :-
   85    expand_goal(Goal0, Goal),
   86    safe_goal(Goal),
   87    call(Goal).
 safe_goal(:Goal) is det
True if calling Goal provides no security risc. This implies that:
Errors
- instantiation_error if the analysis encounters a term in a callable position that is insufficiently instantiated to determine the predicate called.
- permission_error(call, sandboxed, Goal) if Goal is in the call-tree and not white-listed.
  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, []))).
 safe(+Goal, +Module, +Parents, +Safe0, -Safe) is semidet
Is true if Goal can only call safe code.
  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:(@(_,_))).
 safe_bodies(+Bodies, +Module, +Parents, +Safe0, -Safe)
Verify the safety of bodies. If a clause was compiled with a qualified module, we consider execution of the body in a different module not a cross-module call.
  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).
 safe_list(+Called, +Module, +Parents, +Safe0, -Safe)
Processed objects called through meta predicates. If the called object is in our current context we remove the module qualification to avoid the cross-module check.
  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).
 meta_qualify(:G, +M, -QG) is det
Perform meta-qualification of the goal-argument
  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).
 goal_id(:Goal, -Id, -Gen) is nondet
Generate an identifier for the goal proven to be safe. We first try to prove the most general form of the goal. If this fails, we try to prove more specific versions.
To be done
- Do step-by-step generalisation instead of the current two levels (most general and most specific).
- We could also use variant_sha1 for the goal ids.
  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, _).
 copy_goal_args(+I, +Term, +Skolem, +Gen) is det
Create the most general form, but keep module qualified arguments because they will likely be called anyway.
  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(_:_).
 verify_safe_declaration(+Decl)
See whether a safe declaration makes sense. That is, the predicate must be defined (such that the attacker cannot define the predicate), must be sufficiently instantiated and only ISO declared predicates may omit a module qualification.
To be done
- Verify safe_meta/2 declarations. It is a bit less clear what the rules are.
  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).
 safe_primitive(?Goal) is nondet
True if Goal is safe to call (i.e., cannot access dangerous system-resources and cannot upset other parts of the Prolog process). There are two types of facts. ISO built-ins are declared without a module prefix. This is safe because it is not allowed to (re-)define these primitives (i.e., give them an unsafe implementation) and the way around (redefine_system_predicate/1) is unsafe. The other group are module-qualified and only match if the system infers that the predicate is imported from the given module.
  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).
 safe_assert(+Term) is semidet
True if assert(Term) is safe, which means it asserts in the current module. Cross-module asserts are considered unsafe. We only allow for adding facts. In theory, we could also allow for rules if we prove the safety of the body.
  747safe_assert(C) :- cyclic_term(C), !, fail.
  748safe_assert(X) :- var(X), !, fail.
  749safe_assert(_Head:-_Body) :- !, fail.
  750safe_assert(_:_) :- !, fail.
  751safe_assert(_).
 safe_clause(+Head) is semidet
Consider a call to clause safe if it does not try to cross a module boundary. Cross-module usage of clause/2 can extract private information from other modules.
  759safe_clause(H) :- var(H), !.
  760safe_clause(_:_) :- !, fail.
  761safe_clause(_).
 safe_global_var(+Name) is semidet
True if Name is a global variable to which assertion is considered safe.
  769safe_global_var(Name) :-
  770    var(Name),
  771    !,
  772    instantiation_error(Name).
  773safe_global_var(Name) :-
  774    safe_global_variable(Name).
 safe_global_variable(Name) is semidet
Declare the given global variable safe to write to.
 safe_meta(+Goal, -Called:list(callable)) is semidet
Hook. True if Goal is a meta-predicate that is considered safe iff all elements in Called are safe.
  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).
 attr_hook_predicates(+Hooks0, +Module, -Hooks) is det
Filter the defined hook implementations. This is safe because (1) calling an undefined predicate is not a safety issue, (2) the user an only assert in the current module and only predicates that have a safe body. This avoids the need to define attribute hooks solely for the purpose of making them safe.
  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).
 expand_nt(+NT, ?Xs0, ?Xs, -NewGoal)
Similar to expand_phrase/2, but we do throw errors instead of failing if NT is not sufficiently instantiated.
  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    ).
 safe_meta_call(+Goal, +Context, -Called:list(callable)) is semidet
True if Goal is a meta-predicate that is considered safe iff all elements in Called are safe.
  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).
 safe_meta(?Template)
  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,*,*,*,*,*,*)).
 safe_output(+Output)
True if something is a safe output argument for with_output_to/2 and friends. We do not want writing to streams.
  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).
 format_calls(+Format, +FormatArgs, -Calls)
Find ~@ calls from Format and Args.
  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.
 prolog:sandbox_allowed_directive(:G) is det
Throws an exception if G is not considered a safe directive.
 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).
 safe_directive(:Directive) is semidet
Hook to declare additional directives as safe. The argument is a term Module:Directive (without :- wrapper). In almost all cases, the implementation must verify that the Module is the current load context as illustrated below. This check is not performed by the system to allow for cases where particular cross-module directives are allowed.
sandbox:safe_directive(M:Directive) :-
    prolog_load_context(module, M),
    ...
 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).
 safe_directive_flag(+Flag, +Value) is det
True if it is safe to set the flag Flag in a directive to Value.
To be done
- If we can avoid that files are loaded after changing this flag, we can allow for more flags. The syntax flags are safe because they are registered with the module.
 1143safe_directive_flag(generate_debug_info, _).
 1144safe_directive_flag(var_prefix, _).
 1145safe_directive_flag(double_quotes, _).
 1146safe_directive_flag(back_quotes, _).
 prolog:sandbox_allowed_expansion(:G) is det
Throws an exception if G is not considered a safe expansion goal. This deals with call-backs from the compiler for

Our assumption is that external expansion rules are coded safely and we only need to be careful if the sandboxed code defines expansion rules.

 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(_,_).
 prolog:sandbox_allowed_goal(:G) is det
Throw an exception if it is not safe to call G
 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    ]