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-2020, VU University Amsterdam 7 CWI, Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(sandbox, 37 [ safe_goal/1, % :Goal 38 safe_call/1 % :Goal 39 ]). 40:- use_module(library(apply_macros),[expand_phrase/2]). 41:- use_module(library(apply),[maplist/2]). 42:- use_module(library(assoc),[empty_assoc/1,get_assoc/3,put_assoc/4]). 43:- use_module(library(debug),[debug/3,debugging/1]). 44:- use_module(library(error), 45 [ must_be/2, 46 instantiation_error/1, 47 type_error/2, 48 permission_error/3 49 ]). 50:- use_module(library(lists),[append/3]). 51:- use_module(library(prolog_format),[format_types/2]). 52 53:- multifile 54 safe_primitive/1, % Goal 55 safe_meta_predicate/1, % Name/Arity 56 safe_meta/2, % Goal, Calls 57 safe_meta/3, % Goal, Context, Calls 58 safe_global_variable/1, % Name 59 safe_directive/1. % Module:Goal 60 61% :- debug(sandbox).
77:- meta_predicate
78 safe_goal(),
79 safe_call().
91safe_call(Goal0) :-
92 expand_goal(Goal0, Goal),
93 safe_goal(Goal),
94 call(Goal).118safe_goal(M:Goal) :- 119 empty_assoc(Safe0), 120 catch(safe(Goal, M, [], Safe0, _), E, true), 121 !, 122 nb_delete(sandbox_last_error), 123 ( var(E) 124 -> true 125 ; throw(E) 126 ). 127safe_goal(_) :- 128 nb_current(sandbox_last_error, E), 129 !, 130 nb_delete(sandbox_last_error), 131 throw(E). 132safe_goal(G) :- 133 debug(sandbox(fail), 'safe_goal/1 failed for ~p', [G]), 134 throw(error(instantiation_error, sandbox(G, []))).
141safe(V, _, Parents, _, _) :- 142 var(V), 143 !, 144 Error = error(instantiation_error, sandbox(V, Parents)), 145 nb_setval(sandbox_last_error, Error), 146 throw(Error). 147safe(M:G, _, Parents, Safe0, Safe) :- 148 !, 149 must_be(atom, M), 150 must_be(callable, G), 151 known_module(M:G, Parents), 152 ( predicate_property(M:G, imported_from(M2)) 153 -> true 154 ; M2 = M 155 ), 156 ( ( safe_primitive(M2:G) 157 ; safe_primitive(G), 158 predicate_property(G, iso) 159 ) 160 -> Safe = Safe0 161 ; ( predicate_property(M:G, exported) 162 ; predicate_property(M:G, public) 163 ; predicate_property(M:G, multifile) 164 ; predicate_property(M:G, iso) 165 ; memberchk(M:_, Parents) 166 ) 167 -> safe(G, M, Parents, Safe0, Safe) 168 ; throw(error(permission_error(call, sandboxed, M:G), 169 sandbox(M:G, Parents))) 170 ). 171safe(G, _, Parents, _, _) :- 172 debugging(sandbox(show)), 173 length(Parents, Level), 174 debug(sandbox(show), '[~D] SAFE ~q?', [Level, G]), 175 fail. 176safe(G, _, Parents, Safe, Safe) :- 177 catch(safe_primitive(G), 178 error(instantiation_error, _), 179 rethrow_instantition_error([G|Parents])), 180 predicate_property(G, iso), 181 !. 182safe(G, M, Parents, Safe, Safe) :- 183 known_module(M:G, Parents), 184 ( predicate_property(M:G, imported_from(M2)) 185 -> true 186 ; M2 = M 187 ), 188 ( catch(safe_primitive(M2:G), 189 error(instantiation_error, _), 190 rethrow_instantition_error([M2:G|Parents])) 191 ; predicate_property(M2:G, number_of_rules(0)) 192 ), 193 !. 194safe(G, M, Parents, Safe0, Safe) :- 195 predicate_property(G, iso), 196 safe_meta_call(G, M, Called), 197 !, 198 add_iso_parent(G, Parents, Parents1), 199 safe_list(Called, M, Parents1, Safe0, Safe). 200safe(G, M, Parents, Safe0, Safe) :- 201 ( predicate_property(M:G, imported_from(M2)) 202 -> true 203 ; M2 = M 204 ), 205 safe_meta_call(M2:G, M, Called), 206 !, 207 safe_list(Called, M, Parents, Safe0, Safe). 208safe(G, M, Parents, Safe0, Safe) :- 209 goal_id(M:G, Id, Gen), 210 ( get_assoc(Id, Safe0, _) 211 -> Safe = Safe0 212 ; put_assoc(Id, Safe0, true, Safe1), 213 ( Gen == M:G 214 -> safe_clauses(Gen, M, [Id|Parents], Safe1, Safe) 215 ; catch(safe_clauses(Gen, M, [Id|Parents], Safe1, Safe), 216 error(instantiation_error, Ctx), 217 unsafe(Parents, Ctx)) 218 ) 219 ), 220 !. 221safe(G, M, Parents, _, _) :- 222 debug(sandbox(fail), 223 'safe/1 failed for ~p (parents:~p)', [M:G, Parents]), 224 fail. 225 226unsafe(Parents, Var) :- 227 var(Var), 228 !, 229 nb_setval(sandbox_last_error, 230 error(instantiation_error, sandbox(_, Parents))), 231 fail. 232unsafe(_Parents, Ctx) :- 233 Ctx = sandbox(_,_), 234 nb_setval(sandbox_last_error, 235 error(instantiation_error, Ctx)), 236 fail. 237 238rethrow_instantition_error(Parents) :- 239 throw(error(instantiation_error, sandbox(_, Parents))). 240 241safe_clauses(G, M, Parents, Safe0, Safe) :- 242 predicate_property(M:G, interpreted), 243 def_module(M:G, MD:QG), 244 \+ compiled(MD:QG), 245 !, 246 findall(Ref-Body, clause(MD:, Body, Ref), Bodies), 247 safe_bodies(Bodies, MD, Parents, Safe0, Safe). 248safe_clauses(G, M, [_|Parents], _, _) :- 249 predicate_property(M:G, visible), 250 !, 251 throw(error(permission_error(call, sandboxed, G), 252 sandbox(M:G, Parents))). 253safe_clauses(_, _, [G|Parents], _, _) :- 254 throw(error(existence_error(procedure, G), 255 sandbox(G, Parents))). 256 257compiled(system:(@(_,_))). 258 259known_module(M:_, _) :- 260 current_module(M), 261 !. 262known_module(M:G, Parents) :- 263 throw(error(permission_error(call, sandboxed, M:G), 264 sandbox(M:G, Parents))). 265 266add_iso_parent(G, Parents, Parents) :- 267 is_control(G), 268 !. 269add_iso_parent(G, Parents, [G|Parents]). 270 271is_control((_,_)). 272is_control((_;_)). 273is_control((_->_)). 274is_control((_*->_)). 275is_control(\+(_)).
284safe_bodies([], _, _, Safe, Safe). 285safe_bodies([Ref-H|T], M, Parents, Safe0, Safe) :- 286 ( H = M2:H2, nonvar(M2), 287 clause_property(Ref, module(M2)) 288 -> copy_term(H2, H3), 289 CM = M2 290 ; copy_term(H, H3), 291 CM = M 292 ), 293 safe(H3, CM, Parents, Safe0, Safe1), 294 safe_bodies(T, M, Parents, Safe1, Safe). 295 296def_module(M:G, MD:QG) :- 297 predicate_property(M:G, imported_from(MD)), 298 !, 299 meta_qualify(MD:G, M, QG). 300def_module(M:G, M:QG) :- 301 meta_qualify(M:G, M, QG).
309safe_list([], _, _, Safe, Safe). 310safe_list([H|T], M, Parents, Safe0, Safe) :- 311 ( H = M2:H2, 312 M == M2 % in our context 313 -> copy_term(H2, H3) 314 ; copy_term(H, H3) % cross-module call 315 ), 316 safe(H3, M, Parents, Safe0, Safe1), 317 safe_list(T, M, Parents, Safe1, Safe).
323meta_qualify(MD:G, M, QG) :- 324 predicate_property(MD:G, meta_predicate(Head)), 325 !, 326 G =.. [Name|Args], 327 Head =.. [_|Q], 328 qualify_args(Q, M, Args, QArgs), 329 QG =.. [Name|QArgs]. 330meta_qualify(_:G, _, G). 331 332qualify_args([], _, [], []). 333qualify_args([H|T], M, [A|AT], [Q|QT]) :- 334 qualify_arg(H, M, A, Q), 335 qualify_args(T, M, AT, QT). 336 337qualify_arg(S, M, A, Q) :- 338 q_arg(S), 339 !, 340 qualify(A, M, Q). 341qualify_arg(_, _, A, A). 342 343q_arg(I) :- integer(I), !. 344q_arg(:). 345q_arg(^). 346q_arg(//). 347 348qualify(A, M, MZ:Q) :- 349 strip_module(M:A, MZ, Q).
361goal_id(M:Goal, M:Id, Gen) :- 362 !, 363 goal_id(Goal, Id, Gen). 364goal_id(Var, _, _) :- 365 var(Var), 366 !, 367 instantiation_error(Var). 368goal_id(Atom, Atom, Atom) :- 369 atom(Atom), 370 !. 371goal_id(Term, _, _) :- 372 \+ compound(Term), 373 !, 374 type_error(callable, Term). 375goal_id(Term, Skolem, Gen) :- % most general form 376 compound_name_arity(Term, Name, Arity), 377 compound_name_arity(Skolem, Name, Arity), 378 compound_name_arity(Gen, Name, Arity), 379 copy_goal_args(1, Term, Skolem, Gen), 380 ( Gen =@= Term 381 -> ! % No more specific one; we can commit 382 ; true 383 ), 384 numbervars(Skolem, 0, _). 385goal_id(Term, Skolem, Term) :- % most specific form 386 debug(sandbox(specify), 'Retrying with ~p', [Term]), 387 copy_term(Term, Skolem), 388 numbervars(Skolem, 0, _).
395copy_goal_args(I, Term, Skolem, Gen) :- 396 arg(I, Term, TA), 397 !, 398 arg(I, Skolem, SA), 399 arg(I, Gen, GA), 400 copy_goal_arg(TA, SA, GA), 401 I2 is I + 1, 402 copy_goal_args(I2, Term, Skolem, Gen). 403copy_goal_args(_, _, _, _). 404 405copy_goal_arg(Arg, SArg, Arg) :- 406 copy_goal_arg(Arg), 407 !, 408 copy_term(Arg, SArg). 409copy_goal_arg(_, _, _). 410 411copy_goal_arg(Var) :- var(Var), !, fail. 412copy_goal_arg(_:_).
424term_expansion(safe_primitive(Goal), Term) :- 425 ( verify_safe_declaration(Goal) 426 -> Term = safe_primitive(Goal) 427 ; Term = [] 428 ). 429 430systemterm_expansion(sandbox:safe_primitive(Goal), Term) :- 431 \+ current_prolog_flag(xref, true), 432 ( verify_safe_declaration(Goal) 433 -> Term = sandbox:safe_primitive(Goal) 434 ; Term = [] 435 ). 436 437verify_safe_declaration(Var) :- 438 var(Var), 439 !, 440 instantiation_error(Var). 441verify_safe_declaration(Module:Goal) :- 442 !, 443 must_be(atom, Module), 444 must_be(callable, Goal), 445 ( ok_meta(Module:Goal) 446 -> true 447 ; ( predicate_property(Module:Goal, visible) 448 -> true 449 ; predicate_property(Module:Goal, foreign) 450 ), 451 \+ predicate_property(Module:Goal, imported_from(_)), 452 \+ predicate_property(Module:Goal, meta_predicate(_)) 453 -> true 454 ; permission_error(declare, safe_goal, Module:Goal) 455 ). 456verify_safe_declaration(Goal) :- 457 must_be(callable, Goal), 458 ( predicate_property(system:Goal, iso), 459 \+ predicate_property(system:Goal, meta_predicate()) 460 -> true 461 ; permission_error(declare, safe_goal, Goal) 462 ). 463 464ok_meta(system:assert(_)). 465ok_meta(system:load_files(_,_)). 466ok_meta(system:use_module(_,_)). 467ok_meta(system:use_module(_)). 468 469verify_predefined_safe_declarations :- 470 forall(clause(safe_primitive(Goal), _Body, Ref), 471 ( catch(verify_safe_declaration(Goal), E, true), 472 ( nonvar(E) 473 -> clause_property(Ref, file(File)), 474 clause_property(Ref, line_count(Line)), 475 print_message(error, bad_safe_declaration(Goal, File, Line)) 476 ; true 477 ) 478 )). 479 480:- initialization(verify_predefined_safe_declarations, now).
494% First, all ISO system predicates that are considered safe 495 496safe_primitive(true). 497safe_primitive(fail). 498safe_primitive(system:false). 499safe_primitive(repeat). 500safe_primitive(!). 501 % types 502safe_primitive(var(_)). 503safe_primitive(nonvar(_)). 504safe_primitive(system:attvar(_)). 505safe_primitive(integer(_)). 506safe_primitive(float(_)). 507safe_primitive(system:rational(_)). 508safe_primitive(number(_)). 509safe_primitive(atom(_)). 510safe_primitive(system:blob(_,_)). 511safe_primitive(system:string(_)). 512safe_primitive(atomic(_)). 513safe_primitive(compound(_)). 514safe_primitive(callable(_)). 515safe_primitive(ground(_)). 516safe_primitive(system:nonground(_,_)). 517safe_primitive(system:cyclic_term(_)). 518safe_primitive(acyclic_term(_)). 519safe_primitive(system:is_stream(_)). 520safe_primitive(system:'$is_char'(_)). 521safe_primitive(system:'$is_char_code'(_)). 522safe_primitive(system:'$is_char_list'(_,_)). 523safe_primitive(system:'$is_code_list'(_,_)). 524 % ordering 525safe_primitive(@>(_,_)). 526safe_primitive(@>=(_,_)). 527safe_primitive(==(_,_)). 528safe_primitive(@<(_,_)). 529safe_primitive(@=<(_,_)). 530safe_primitive(compare(_,_,_)). 531safe_primitive(sort(_,_)). 532safe_primitive(keysort(_,_)). 533safe_primitive(system: =@=(_,_)). 534safe_primitive(system:'$btree_find_node'(_,_,_,_,_)). 535 536 % unification and equivalence 537safe_primitive(=(_,_)). 538safe_primitive(\=(_,_)). 539safe_primitive(system:'?='(_,_)). 540safe_primitive(system:unifiable(_,_,_)). 541safe_primitive(unify_with_occurs_check(_,_)). 542safe_primitive(\==(_,_)). 543 % arithmetic 544safe_primitive(is(_,_)). 545safe_primitive(>(_,_)). 546safe_primitive(>=(_,_)). 547safe_primitive(=:=(_,_)). 548safe_primitive(=\=(_,_)). 549safe_primitive(=<(_,_)). 550safe_primitive(<(_,_)). 551:- if(current_prolog_flag(bounded, false)). 552safe_primitive(system:nth_integer_root_and_remainder(_,_,_,_)). 553:- endif. 554 555 % term-handling 556safe_primitive(arg(_,_,_)). 557safe_primitive(system:setarg(_,_,_)). 558safe_primitive(system:nb_setarg(_,_,_)). 559safe_primitive(system:nb_linkarg(_,_,_)). 560safe_primitive(functor(_,_,_)). 561safe_primitive(_ =.. _). 562safe_primitive(system:compound_name_arity(_,_,_)). 563safe_primitive(system:compound_name_arguments(_,_,_)). 564safe_primitive(system:'$filled_array'(_,_,_,_)). 565safe_primitive(copy_term(_,_)). 566safe_primitive(system:duplicate_term(_,_)). 567safe_primitive(system:copy_term_nat(_,_)). 568safe_primitive(system:size_abstract_term(_,_,_)). 569safe_primitive(numbervars(_,_,_)). 570safe_primitive(system:numbervars(_,_,_,_)). 571safe_primitive(subsumes_term(_,_)). 572safe_primitive(system:term_hash(_,_)). 573safe_primitive(system:term_hash(_,_,_,_)). 574safe_primitive(system:variant_sha1(_,_)). 575safe_primitive(system:variant_hash(_,_)). 576safe_primitive(system:'$term_size'(_,_,_)). 577 578 % dicts 579safe_primitive(system:is_dict(_)). 580safe_primitive(system:is_dict(_,_)). 581safe_primitive(system:get_dict(_,_,_)). 582safe_primitive(system:get_dict(_,_,_,_,_)). 583safe_primitive(system:'$get_dict_ex'(_,_,_)). 584safe_primitive(system:dict_create(_,_,_)). 585safe_primitive(system:dict_pairs(_,_,_)). 586safe_primitive(system:put_dict(_,_,_)). 587safe_primitive(system:put_dict(_,_,_,_)). 588safe_primitive(system:del_dict(_,_,_,_)). 589safe_primitive(system:select_dict(_,_,_)). 590safe_primitive(system:b_set_dict(_,_,_)). 591safe_primitive(system:nb_set_dict(_,_,_)). 592safe_primitive(system:nb_link_dict(_,_,_)). 593safe_primitive(system:(:<(_,_))). 594safe_primitive(system:(>:<(_,_))). 595 % atoms 596safe_primitive(atom_chars(_, _)). 597safe_primitive(atom_codes(_, _)). 598safe_primitive(sub_atom(_,_,_,_,_)). 599safe_primitive(atom_concat(_,_,_)). 600safe_primitive(atom_length(_,_)). 601safe_primitive(char_code(_,_)). 602safe_primitive(system:name(_,_)). 603safe_primitive(system:atomic_concat(_,_,_)). 604safe_primitive(system:atomic_list_concat(_,_)). 605safe_primitive(system:atomic_list_concat(_,_,_)). 606safe_primitive(system:downcase_atom(_,_)). 607safe_primitive(system:upcase_atom(_,_)). 608safe_primitive(system:char_type(_,_)). 609safe_primitive(system:normalize_space(_,_)). 610safe_primitive(system:sub_atom_icasechk(_,_,_)). 611 % numbers 612safe_primitive(number_codes(_,_)). 613safe_primitive(number_chars(_,_)). 614safe_primitive(system:atom_number(_,_)). 615safe_primitive(system:code_type(_,_)). 616 % strings 617safe_primitive(system:atom_string(_,_)). 618safe_primitive(system:number_string(_,_)). 619safe_primitive(system:string_chars(_, _)). 620safe_primitive(system:string_codes(_, _)). 621safe_primitive(system:string_code(_,_,_)). 622safe_primitive(system:sub_string(_,_,_,_,_)). 623safe_primitive(system:split_string(_,_,_,_)). 624safe_primitive(system:atomics_to_string(_,_,_)). 625safe_primitive(system:atomics_to_string(_,_)). 626safe_primitive(system:string_concat(_,_,_)). 627safe_primitive(system:string_length(_,_)). 628safe_primitive(system:string_lower(_,_)). 629safe_primitive(system:string_upper(_,_)). 630safe_primitive(system:term_string(_,_)). 631safe_primitive('$syspreds':term_string(_,_,_)). 632 % Lists 633safe_primitive(length(_,_)). 634 % exceptions 635safe_primitive(throw(_)). 636safe_primitive(system:abort). 637 % misc 638safe_primitive(current_prolog_flag(_,_)). 639safe_primitive(current_op(_,_,_)). 640safe_primitive(system:sleep(_)). 641safe_primitive(system:thread_self(_)). 642safe_primitive(system:get_time(_)). 643safe_primitive(system:statistics(_,_)). 644safe_primitive(system:thread_statistics(Id,_,_)) :- 645 ( var(Id) 646 -> instantiation_error(Id) 647 ; thread_self(Id) 648 ). 649safe_primitive(system:thread_property(Id,_)) :- 650 ( var(Id) 651 -> instantiation_error(Id) 652 ; thread_self(Id) 653 ). 654safe_primitive(system:format_time(_,_,_)). 655safe_primitive(system:format_time(_,_,_,_)). 656safe_primitive(system:date_time_stamp(_,_)). 657safe_primitive(system:stamp_date_time(_,_,_)). 658safe_primitive(system:strip_module(_,_,_)). 659safe_primitive('$messages':message_to_string(_,_)). 660safe_primitive(system:import_module(_,_)). 661safe_primitive(system:file_base_name(_,_)). 662safe_primitive(system:file_directory_name(_,_)). 663safe_primitive(system:file_name_extension(_,_,_)). 664 665safe_primitive(clause(H,_)) :- safe_clause(H). 666safe_primitive(asserta(X)) :- safe_assert(X). 667safe_primitive(assertz(X)) :- safe_assert(X). 668safe_primitive(retract(X)) :- safe_assert(X). 669safe_primitive(retractall(X)) :- safe_assert(X). 670 671% We need to do data flow analysis to find the tag of the 672% target key before we can conclude that functions on dicts 673% are safe. 674safe_primitive('$dicts':'.'(_,K,_)) :- atom(K). 675safe_primitive('$dicts':'.'(_,K,_)) :- 676 ( nonvar(K) 677 -> dict_built_in(K) 678 ; instantiation_error(K) 679 ). 680 681dict_built_in(get(_)). 682dict_built_in(put(_)). 683dict_built_in(put(_,_)). 684 685% The non-ISO system predicates. These can be redefined, so we must 686% be careful to ensure the system ones are used. 687 688safe_primitive(system:false). 689safe_primitive(system:cyclic_term(_)). 690safe_primitive(system:msort(_,_)). 691safe_primitive(system:sort(_,_,_,_)). 692safe_primitive(system:between(_,_,_)). 693safe_primitive(system:succ(_,_)). 694safe_primitive(system:plus(_,_,_)). 695safe_primitive(system:float_class(_,_)). 696safe_primitive(system:term_variables(_,_)). 697safe_primitive(system:term_variables(_,_,_)). 698safe_primitive(system:'$term_size'(_,_,_)). 699safe_primitive(system:atom_to_term(_,_,_)). 700safe_primitive(system:term_to_atom(_,_)). 701safe_primitive(system:atomic_list_concat(_,_,_)). 702safe_primitive(system:atomic_list_concat(_,_)). 703safe_primitive(system:downcase_atom(_,_)). 704safe_primitive(system:upcase_atom(_,_)). 705safe_primitive(system:is_list(_)). 706safe_primitive(system:memberchk(_,_)). 707safe_primitive(system:'$skip_list'(_,_,_)). 708 % attributes 709safe_primitive(system:get_attr(_,_,_)). 710safe_primitive(system:get_attrs(_,_)). 711safe_primitive(system:term_attvars(_,_)). 712safe_primitive(system:del_attr(_,_)). 713safe_primitive(system:del_attrs(_)). 714safe_primitive('$attvar':copy_term(_,_,_)). 715 % globals 716safe_primitive(system:b_getval(_,_)). 717safe_primitive(system:b_setval(Var,_)) :- 718 safe_global_var(Var). 719safe_primitive(system:nb_getval(_,_)). 720safe_primitive('$syspreds':nb_setval(Var,_)) :- 721 safe_global_var(Var). 722safe_primitive(system:nb_linkval(Var,_)) :- 723 safe_global_var(Var). 724safe_primitive(system:nb_current(_,_)). 725 % database 726safe_primitive(system:assert(X)) :- 727 safe_assert(X). 728 % Output 729safe_primitive(system:writeln(_)). 730safe_primitive('$messages':print_message(_,_)). 731 732 % Stack limits (down) 733safe_primitive('$syspreds':set_prolog_stack(Stack, limit(ByteExpr))) :- 734 nonvar(Stack), 735 stack_name(Stack), 736 catch(Bytes is ByteExpr, _, fail), 737 prolog_stack_property(Stack, limit(Current)), 738 Bytes =< Current. 739 740stack_name(global). 741stack_name(local). 742stack_name(trail). 743 744safe_primitive('$tabling':abolish_all_tables). 745safe_primitive('$tabling':'$wrap_tabled'(Module:_Head, _Mode)) :- 746 prolog_load_context(module, Module), 747 !. 748safe_primitive('$tabling':'$moded_wrap_tabled'(Module:_Head,_,_,_)) :- 749 prolog_load_context(module, Module), 750 !. 751 752 753% use_module/1. We only allow for .pl files that are loaded from 754% relative paths that do not contain /../ 755 756safe_primitive(system:use_module(Spec, _Import)) :- 757 safe_primitive(system:use_module(Spec)). 758safe_primitive(system:load_files(Spec, Options)) :- 759 safe_primitive(system:use_module(Spec)), 760 maplist(safe_load_file_option, Options). 761safe_primitive(system:use_module(Spec)) :- 762 ground(Spec), 763 ( atom(Spec) 764 -> Path = Spec 765 ; Spec =.. [_Alias, Segments], 766 phrase(segments_to_path(Segments), List), 767 atomic_list_concat(List, Path) 768 ), 769 \+ is_absolute_file_name(Path), 770 \+ sub_atom(Path, _, _, _, '/../'), 771 absolute_file_name(Spec, AbsFile, 772 [ access(read), 773 file_type(prolog), 774 file_errors(fail) 775 ]), 776 file_name_extension(_, Ext, AbsFile), 777 save_extension(Ext). 778 779% support predicates for safe_primitive, validating the safety of 780% arguments to certain goals. 781 782segments_to_path(A/B) --> 783 !, 784 segments_to_path(A), 785 [/], 786 segments_to_path(B). 787segments_to_path(X) --> 788 [X]. 789 790save_extension(pl). 791 792safe_load_file_option(if(changed)). 793safe_load_file_option(if(not_loaded)). 794safe_load_file_option(must_be_module(_)). 795safe_load_file_option(optimise(_)). 796safe_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.805safe_assert(C) :- cyclic_term(C), !, fail. 806safe_assert(X) :- var(X), !, fail. 807safe_assert(_Head:-_Body) :- !, fail. 808safe_assert(_:_) :- !, fail. 809safe_assert(_).
817safe_clause(H) :- var(H), !. 818safe_clause(_:_) :- !, fail. 819safe_clause(_).
827safe_global_var(Name) :- 828 var(Name), 829 !, 830 instantiation_error(Name). 831safe_global_var(Name) :- 832 safe_global_variable(Name).
844safe_meta(system:put_attr(V,M,A), Called) :- 845 !, 846 ( atom(M) 847 -> attr_hook_predicates([ attr_unify_hook(A, _), 848 attribute_goals(V,_,_), 849 project_attributes(_,_) 850 ], M, Called) 851 ; instantiation_error(M) 852 ). 853safe_meta(system:with_output_to(Output, G), [G]) :- 854 safe_output(Output), 855 !. 856safe_meta(system:format(Format, Args), Calls) :- 857 format_calls(Format, Args, Calls). 858safe_meta(system:format(Output, Format, Args), Calls) :- 859 safe_output(Output), 860 format_calls(Format, Args, Calls). 861safe_meta(prolog_debug:debug(_Term, Format, Args), Calls) :- 862 format_calls(Format, Args, Calls). 863safe_meta(system:set_prolog_flag(Flag, Value), []) :- 864 atom(Flag), 865 safe_prolog_flag(Flag, Value). 866safe_meta('$attvar':freeze(_Var,Goal), [Goal]). 867safe_meta(phrase(NT,Xs0,Xs), [Goal]) :- % phrase/2,3 and call_dcg/2,3 868 expand_nt(NT,Xs0,Xs,Goal). 869safe_meta(phrase(NT,Xs0), [Goal]) :- 870 expand_nt(NT,Xs0,[],Goal). 871safe_meta('$dcg':call_dcg(NT,Xs0,Xs), [Goal]) :- 872 expand_nt(NT,Xs0,Xs,Goal). 873safe_meta('$dcg':call_dcg(NT,Xs0), [Goal]) :- 874 expand_nt(NT,Xs0,[],Goal). 875safe_meta('$tabling':abolish_table_subgoals(V), []) :- 876 \+ qualified(V). 877safe_meta('$tabling':current_table(V, _), []) :- 878 \+ qualified(V). 879safe_meta('$tabling':tnot(G), [G]). 880safe_meta('$tabling':not_exists(G), [G]). 881 882qualified(V) :- 883 nonvar(V), 884 V = _:_.
894attr_hook_predicates([], _, []). 895attr_hook_predicates([H|T], M, Called) :- 896 ( predicate_property(M:H, defined) 897 -> Called = [M:H|Rest] 898 ; Called = Rest 899 ), 900 attr_hook_predicates(T, M, Rest).
908expand_nt(NT, _Xs0, _Xs, _NewGoal) :- 909 strip_module(NT, _, Plain), 910 var(Plain), 911 !, 912 instantiation_error(Plain). 913expand_nt(NT, Xs0, Xs, NewGoal) :- 914 dcg_translate_rule((pseudo_nt --> NT), 915 (pseudo_nt(Xs0c,Xsc) :- NewGoal0)), 916 ( var(Xsc), Xsc \== Xs0c 917 -> Xs = Xsc, NewGoal1 = NewGoal0 918 ; NewGoal1 = (NewGoal0, Xsc = Xs) 919 ), 920 ( var(Xs0c) 921 -> Xs0 = Xs0c, 922 NewGoal = NewGoal1 923 ; NewGoal = ( Xs0 = Xs0c, NewGoal1 ) 924 ).
931safe_meta_call(Goal, _, _Called) :- 932 debug(sandbox(meta), 'Safe meta ~p?', [Goal]), 933 fail. 934safe_meta_call(Goal, Context, Called) :- 935 ( safe_meta(Goal, Called) 936 -> true 937 ; safe_meta(Goal, Context, Called) 938 ), 939 !. % call hook 940safe_meta_call(Goal, _, Called) :- 941 Goal = M:Plain, 942 compound(Plain), 943 compound_name_arity(Plain, Name, Arity), 944 safe_meta_predicate(M:Name/Arity), 945 predicate_property(Goal, meta_predicate(Spec)), 946 !, 947 called(Spec, Plain, Called). 948safe_meta_call(M:Goal, _, Called) :- 949 !, 950 generic_goal(Goal, Gen), 951 safe_meta(M:Gen), 952 called(Gen, Goal, Called). 953safe_meta_call(Goal, _, Called) :- 954 generic_goal(Goal, Gen), 955 safe_meta(Gen), 956 called(Gen, Goal, Called). 957 958called(Gen, Goal, Called) :- 959 compound_name_arity(Goal, _, Arity), 960 called(1, Arity, Gen, Goal, Called). 961 962called(I, Arity, Gen, Goal, Called) :- 963 I =< Arity, 964 !, 965 arg(I, Gen, Spec), 966 ( calling_meta_spec(Spec) 967 -> arg(I, Goal, Called0), 968 extend(Spec, Called0, G), 969 Called = [G|Rest] 970 ; Called = Rest 971 ), 972 I2 is I+1, 973 called(I2, Arity, Gen, Goal, Rest). 974called(_, _, _, _, []). 975 976generic_goal(G, Gen) :- 977 functor(G, Name, Arity), 978 functor(Gen, Name, Arity). 979 980calling_meta_spec(V) :- var(V), !, fail. 981calling_meta_spec(I) :- integer(I), !. 982calling_meta_spec(^). 983calling_meta_spec(//). 984 985 986extend(^, G, Plain) :- 987 !, 988 strip_existential(G, Plain). 989extend(//, DCG, Goal) :- 990 !, 991 ( expand_phrase(call_dcg(DCG,_,_), Goal) 992 -> true 993 ; instantiation_error(DCG) % Ask more instantiation. 994 ). % might not help, but does not harm. 995extend(0, G, G) :- !. 996extend(I, M:G0, M:G) :- 997 !, 998 G0 =.. List, 999 length(Extra, I), 1000 append(List, Extra, All), 1001 G =.. All. 1002extend(I, G0, G) :- 1003 G0 =.. List, 1004 length(Extra, I), 1005 append(List, Extra, All), 1006 G =.. All. 1007 1008strip_existential(Var, Var) :- 1009 var(Var), 1010 !. 1011strip_existential(M:G0, M:G) :- 1012 !, 1013 strip_existential(G0, G). 1014strip_existential(_^G0, G) :- 1015 !, 1016 strip_existential(G0, G). 1017strip_existential(G, G).
1021safe_meta((0,0)). 1022safe_meta((0;0)). 1023safe_meta((0->0)). 1024safe_meta(system:(0*->0)). 1025safe_meta(catch(0,*,0)). 1026safe_meta(findall(*,0,*)). 1027safe_meta('$bags':findall(*,0,*,*)). 1028safe_meta(setof(*,^,*)). 1029safe_meta(bagof(*,^,*)). 1030safe_meta('$bags':findnsols(*,*,0,*)). 1031safe_meta('$bags':findnsols(*,*,0,*,*)). 1032safe_meta(system:call_cleanup(0,0)). 1033safe_meta(system:setup_call_cleanup(0,0,0)). 1034safe_meta(system:setup_call_catcher_cleanup(0,0,*,0)). 1035safe_meta('$attvar':call_residue_vars(0,*)). 1036safe_meta('$syspreds':call_with_inference_limit(0,*,*)). 1037safe_meta('$syspreds':call_with_depth_limit(0,*,*)). 1038safe_meta(^(*,0)). 1039safe_meta(\+(0)). 1040safe_meta(call(0)). 1041safe_meta(call(1,*)). 1042safe_meta(call(2,*,*)). 1043safe_meta(call(3,*,*,*)). 1044safe_meta(call(4,*,*,*,*)). 1045safe_meta(call(5,*,*,*,*,*)). 1046safe_meta(call(6,*,*,*,*,*,*)). 1047safe_meta('$tabling':start_tabling(*,0)). 1048safe_meta('$tabling':start_tabling(*,0,*,*)).
1055safe_output(Output) :- 1056 var(Output), 1057 !, 1058 instantiation_error(Output). 1059safe_output(atom(_)). 1060safe_output(string(_)). 1061safe_output(codes(_)). 1062safe_output(codes(_,_)). 1063safe_output(chars(_)). 1064safe_output(chars(_,_)). 1065safe_output(current_output). 1066safe_output(current_error).
1072:- public format_calls/3. % used in pengines_io 1073 1074format_calls(Format, _Args, _Calls) :- 1075 var(Format), 1076 !, 1077 instantiation_error(Format). 1078format_calls(Format, Args, Calls) :- 1079 format_types(Format, Types), 1080 ( format_callables(Types, Args, Calls) 1081 -> true 1082 ; throw(error(format_error(Format, Types, Args), _)) 1083 ). 1084 1085format_callables([], [], []). 1086format_callables([callable|TT], [G|TA], [G|TG]) :- 1087 !, 1088 format_callables(TT, TA, TG). 1089format_callables([_|TT], [_|TA], TG) :- 1090 !, 1091 format_callables(TT, TA, TG). 1092 1093 1094 /******************************* 1095 * SAFE COMPILATION HOOKS * 1096 *******************************/ 1097 1098:- multifile 1099 prolog:sandbox_allowed_directive/1, 1100 prolog:sandbox_allowed_goal/1, 1101 prolog:sandbox_allowed_expansion/1.
1107prologsandbox_allowed_directive(Directive) :- 1108 debug(sandbox(directive), 'Directive: ~p', [Directive]), 1109 fail. 1110prologsandbox_allowed_directive(Directive) :- 1111 safe_directive(Directive), 1112 !. 1113prologsandbox_allowed_directive(M:PredAttr) :- 1114 \+ prolog_load_context(module, M), 1115 !, 1116 debug(sandbox(directive), 'Cross-module directive', []), 1117 permission_error(execute, sandboxed_directive, (:- M:PredAttr)). 1118prologsandbox_allowed_directive(M:PredAttr) :- 1119 safe_pattr(PredAttr), 1120 !, 1121 PredAttr =.. [Attr, Preds], 1122 ( safe_pattr(Preds, Attr) 1123 -> true 1124 ; permission_error(execute, sandboxed_directive, (:- M:PredAttr)) 1125 ). 1126prologsandbox_allowed_directive(_:Directive) :- 1127 safe_source_directive(Directive), 1128 !. 1129prologsandbox_allowed_directive(_:Directive) :- 1130 directive_loads_file(Directive, File), 1131 !, 1132 safe_path(File). 1133prologsandbox_allowed_directive(G) :- 1134 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),
...
1152safe_pattr(dynamic(_)). 1153safe_pattr(thread_local(_)). 1154safe_pattr(volatile(_)). 1155safe_pattr(discontiguous(_)). 1156safe_pattr(multifile(_)). 1157safe_pattr(public(_)). 1158safe_pattr(meta_predicate(_)). 1159safe_pattr(table(_)). 1160safe_pattr(non_terminal(_)). 1161 1162safe_pattr(Var, _) :- 1163 var(Var), 1164 !, 1165 instantiation_error(Var). 1166safe_pattr((A,B), Attr) :- 1167 !, 1168 safe_pattr(A, Attr), 1169 safe_pattr(B, Attr). 1170safe_pattr(M:G, Attr) :- 1171 !, 1172 ( atom(M), 1173 prolog_load_context(module, M) 1174 -> true 1175 ; Goal =.. [Attr,M:G], 1176 permission_error(directive, sandboxed, (:- Goal)) 1177 ). 1178safe_pattr(_, _). 1179 1180safe_source_directive(op(_,_,Name)) :- 1181 !, 1182 ( atom(Name) 1183 -> true 1184 ; is_list(Name), 1185 maplist(atom, Name) 1186 ). 1187safe_source_directive(set_prolog_flag(Flag, Value)) :- 1188 !, 1189 atom(Flag), ground(Value), 1190 safe_prolog_flag(Flag, Value). 1191safe_source_directive(style_check(_)). 1192safe_source_directive(initialization(_)). % Checked at runtime 1193safe_source_directive(initialization(_,_)). % Checked at runtime 1194 1195directive_loads_file(use_module(library(X)), X). 1196directive_loads_file(use_module(library(X), _Imports), X). 1197directive_loads_file(load_files(library(X), _Options), X). 1198directive_loads_file(ensure_loaded(library(X)), X). 1199directive_loads_file(include(X), X). 1200 1201safe_path(X) :- 1202 var(X), 1203 !, 1204 instantiation_error(X). 1205safe_path(X) :- 1206 ( atom(X) 1207 ; string(X) 1208 ), 1209 !, 1210 \+ sub_atom(X, 0, _, 0, '..'), 1211 \+ sub_atom(X, 0, _, _, '/'), 1212 \+ sub_atom(X, 0, _, _, '../'), 1213 \+ sub_atom(X, _, _, 0, '/..'), 1214 \+ sub_atom(X, _, _, _, '/../'). 1215safe_path(A/B) :- 1216 !, 1217 safe_path(A), 1218 safe_path(B).
1230% misc 1231safe_prolog_flag(generate_debug_info, _). 1232safe_prolog_flag(optimise, _). 1233safe_prolog_flag(occurs_check, _). 1234% syntax 1235safe_prolog_flag(var_prefix, _). 1236safe_prolog_flag(double_quotes, _). 1237safe_prolog_flag(back_quotes, _). 1238safe_prolog_flag(rational_syntax, _). 1239% arithmetic 1240safe_prolog_flag(prefer_rationals, _). 1241safe_prolog_flag(float_overflow, _). 1242safe_prolog_flag(float_zero_div, _). 1243safe_prolog_flag(float_undefined, _). 1244safe_prolog_flag(float_underflow, _). 1245safe_prolog_flag(float_rounding, _). 1246safe_prolog_flag(float_rounding, _). 1247safe_prolog_flag(max_rational_size, _). 1248safe_prolog_flag(max_rational_size_action, _). 1249% tabling 1250safe_prolog_flag(max_answers_for_subgoal,_). 1251safe_prolog_flag(max_answers_for_subgoal_action,_). 1252safe_prolog_flag(max_table_answer_size,_). 1253safe_prolog_flag(max_table_answer_size_action,_). 1254safe_prolog_flag(max_table_subgoal_size,_). 1255safe_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.
1271prologsandbox_allowed_expansion(M:G) :- 1272 prolog_load_context(module, M), 1273 !, 1274 debug(sandbox(expansion), 'Expand in ~p: ~p', [M, G]), 1275 safe_goal(M:G). 1276prologsandbox_allowed_expansion(_,_).
1282prologsandbox_allowed_goal(G) :- 1283 safe_goal(G). 1284 1285 1286 /******************************* 1287 * MESSAGES * 1288 *******************************/ 1289 1290:- multifile 1291 prolog:message//1, 1292 prolog:message_context//1, 1293 prolog:error_message//1. 1294 1295prologmessage(error(instantiation_error, Context)) --> 1296 { nonvar(Context), 1297 Context = sandbox(_Goal,Parents), 1298 numbervars(Context, 1, _) 1299 }, 1300 [ 'Sandbox restriction!'-[], nl, 1301 'Could not derive which predicate may be called from'-[] 1302 ], 1303 ( { Parents == [] } 1304 -> [ 'Search space too large'-[] ] 1305 ; callers(Parents, 10) 1306 ). 1307 1308prologmessage_context(sandbox(_G, [])) --> !. 1309prologmessage_context(sandbox(_G, Parents)) --> 1310 [ nl, 'Reachable from:'-[] ], 1311 callers(Parents, 10). 1312 1313callers([], _) --> !. 1314callers(_, 0) --> !. 1315callers([G|Parents], Level) --> 1316 { NextLevel is Level-1 1317 }, 1318 [ nl, '\t ~p'-[G] ], 1319 callers(Parents, NextLevel). 1320 1321prologmessage(bad_safe_declaration(Goal, File, Line)) --> 1322 [ '~w:~d: Invalid safe_primitive/1 declaration: ~p'- 1323 [File, Line, Goal] ]. 1324 1325prologerror_message(format_error(Format, Types, Args)) --> 1326 format_error(Format, Types, Args). 1327 1328format_error(Format, Types, Args) --> 1329 { length(Types, TypeLen), 1330 length(Args, ArgsLen), 1331 ( TypeLen > ArgsLen 1332 -> Problem = 'not enough' 1333 ; Problem = 'too many' 1334 ) 1335 }, 1336 [ 'format(~q): ~w arguments (found ~w, need ~w)'- 1337 [Format, Problem, ArgsLen, TypeLen] 1338 ]
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.