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).
79:- meta_predicate
80 safe_goal(),
81 safe_call().
93safe_call(Goal0) :-
94 expand_goal(Goal0, Goal),
95 safe_goal(Goal),
96 call(Goal).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, []))).
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:, 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(\+(_)).
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).
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).
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).
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, _).
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(_:_).
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 437systemterm_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 ). 443systemterm_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).
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(_)).
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.839safe_assert(C) :- cyclic_term(C), !, fail. 840safe_assert(X) :- var(X), !, fail. 841safe_assert(_Head:-_Body) :- !, fail. 842safe_assert(_:_) :- !, fail. 843safe_assert(_).
851safe_clause(H) :- var(H), !. 852safe_clause(_:_) :- !, fail. 853safe_clause(_).
861safe_global_var(Name) :- 862 var(Name), 863 !, 864 instantiation_error(Name). 865safe_global_var(Name) :- 866 safe_global_variable(Name).
876safe_current_predicate(X) :- 877 nonvar(X), 878 X = _:_, !, 879 fail. 880safe_current_predicate(_).
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 = _:_.
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).
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 ).
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).
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,*)).
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).
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.
1152prologsandbox_allowed_directive(Directive) :- 1153 debug(sandbox(directive), 'Directive: ~p', [Directive]), 1154 fail. 1155prologsandbox_allowed_directive(Directive) :- 1156 safe_directive(Directive), 1157 !. 1158prologsandbox_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)). 1163prologsandbox_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 ). 1171prologsandbox_allowed_directive(_:Directive) :- 1172 safe_source_directive(Directive), 1173 !. 1174prologsandbox_allowed_directive(_:Directive) :- 1175 directive_loads_file(Directive, File), 1176 !, 1177 safe_path(File). 1178prologsandbox_allowed_directive(G) :- 1179 safe_goal(G).
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),
...
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).
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,_).
Our assumption is that external expansion rules are coded safely and we only need to be careful if the sandboxed code defines expansion rules.
1317prologsandbox_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). 1322prologsandbox_allowed_expansion(_,_).
1328prologsandbox_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 1341prologmessage(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 1354prologmessage_context(sandbox(_G, [])) --> !. 1355prologmessage_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 1367prologmessage(bad_safe_declaration(Goal, File, Line)) --> 1368 [ '~w:~d: Invalid safe_primitive/1 declaration: ~p'- 1369 [File, Line, Goal] ]. 1370 1371prologerror_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 ]
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.