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-2021, 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 62% :- debug(sandbox).
78:- meta_predicate
79 safe_goal(),
80 safe_call().
92safe_call(Goal0) :-
93 expand_goal(Goal0, Goal),
94 safe_goal(Goal),
95 call(Goal).119safe_goal(M:Goal) :- 120 empty_assoc(Safe0), 121 catch(safe(Goal, M, [], Safe0, _), E, true), 122 !, 123 nb_delete(sandbox_last_error), 124 ( var(E) 125 -> true 126 ; throw(E) 127 ). 128safe_goal(_) :- 129 nb_current(sandbox_last_error, E), 130 !, 131 nb_delete(sandbox_last_error), 132 throw(E). 133safe_goal(G) :- 134 debug(sandbox(fail), 'safe_goal/1 failed for ~p', [G]), 135 throw(error(instantiation_error, sandbox(G, []))).
142safe(V, _, Parents, _, _) :- 143 var(V), 144 !, 145 Error = error(instantiation_error, sandbox(V, Parents)), 146 nb_setval(sandbox_last_error, Error), 147 throw(Error). 148safe(M:G, _, Parents, Safe0, Safe) :- 149 !, 150 must_be(atom, M), 151 must_be(callable, G), 152 known_module(M:G, Parents), 153 ( predicate_property(M:G, imported_from(M2)) 154 -> true 155 ; M2 = M 156 ), 157 ( ( safe_primitive(M2:G) 158 ; safe_primitive(G), 159 predicate_property(G, iso) 160 ) 161 -> Safe = Safe0 162 ; ( predicate_property(M:G, exported) 163 ; predicate_property(M:G, public) 164 ; predicate_property(M:G, multifile) 165 ; predicate_property(M:G, iso) 166 ; memberchk(M:_, Parents) 167 ) 168 -> safe(G, M, Parents, Safe0, Safe) 169 ; throw(error(permission_error(call, sandboxed, M:G), 170 sandbox(M:G, Parents))) 171 ). 172safe(G, _, Parents, _, _) :- 173 debugging(sandbox(show)), 174 length(Parents, Level), 175 debug(sandbox(show), '[~D] SAFE ~q?', [Level, G]), 176 fail. 177safe(G, _, Parents, Safe, Safe) :- 178 catch(safe_primitive(G), 179 error(instantiation_error, _), 180 rethrow_instantition_error([G|Parents])), 181 predicate_property(G, iso), 182 !. 183safe(G, M, Parents, Safe, Safe) :- 184 known_module(M:G, Parents), 185 ( predicate_property(M:G, imported_from(M2)) 186 -> true 187 ; M2 = M 188 ), 189 ( catch(safe_primitive(M2:G), 190 error(instantiation_error, _), 191 rethrow_instantition_error([M2:G|Parents])) 192 ; predicate_property(M2:G, number_of_rules(0)) 193 ), 194 !. 195safe(G, M, Parents, Safe0, Safe) :- 196 predicate_property(G, iso), 197 safe_meta_call(G, M, Called), 198 !, 199 add_iso_parent(G, Parents, Parents1), 200 safe_list(Called, M, Parents1, Safe0, Safe). 201safe(G, M, Parents, Safe0, Safe) :- 202 ( predicate_property(M:G, imported_from(M2)) 203 -> true 204 ; M2 = M 205 ), 206 safe_meta_call(M2:G, M, Called), 207 !, 208 safe_list(Called, M, Parents, Safe0, Safe). 209safe(G, M, Parents, Safe0, Safe) :- 210 goal_id(M:G, Id, Gen), 211 ( get_assoc(Id, Safe0, _) 212 -> Safe = Safe0 213 ; put_assoc(Id, Safe0, true, Safe1), 214 ( Gen == M:G 215 -> safe_clauses(Gen, M, [Id|Parents], Safe1, Safe) 216 ; catch(safe_clauses(Gen, M, [Id|Parents], Safe1, Safe), 217 error(instantiation_error, Ctx), 218 unsafe(Parents, Ctx)) 219 ) 220 ), 221 !. 222safe(G, M, Parents, _, _) :- 223 debug(sandbox(fail), 224 'safe/1 failed for ~p (parents:~p)', [M:G, Parents]), 225 fail. 226 227unsafe(Parents, Var) :- 228 var(Var), 229 !, 230 nb_setval(sandbox_last_error, 231 error(instantiation_error, sandbox(_, Parents))), 232 fail. 233unsafe(_Parents, Ctx) :- 234 Ctx = sandbox(_,_), 235 nb_setval(sandbox_last_error, 236 error(instantiation_error, Ctx)), 237 fail. 238 239rethrow_instantition_error(Parents) :- 240 throw(error(instantiation_error, sandbox(_, Parents))). 241 242safe_clauses(G, M, Parents, Safe0, Safe) :- 243 predicate_property(M:G, interpreted), 244 def_module(M:G, MD:QG), 245 \+ compiled(MD:QG), 246 !, 247 findall(Ref-Body, clause(MD:, Body, Ref), Bodies), 248 safe_bodies(Bodies, MD, Parents, Safe0, Safe). 249safe_clauses(G, M, [_|Parents], _, _) :- 250 predicate_property(M:G, visible), 251 !, 252 throw(error(permission_error(call, sandboxed, G), 253 sandbox(M:G, Parents))). 254safe_clauses(_, _, [G|Parents], _, _) :- 255 throw(error(existence_error(procedure, G), 256 sandbox(G, Parents))). 257 258compiled(system:(@(_,_))). 259 260known_module(M:_, _) :- 261 current_module(M), 262 !. 263known_module(M:G, Parents) :- 264 throw(error(permission_error(call, sandboxed, M:G), 265 sandbox(M:G, Parents))). 266 267add_iso_parent(G, Parents, Parents) :- 268 is_control(G), 269 !. 270add_iso_parent(G, Parents, [G|Parents]). 271 272is_control((_,_)). 273is_control((_;_)). 274is_control((_->_)). 275is_control((_*->_)). 276is_control(\+(_)).
285safe_bodies([], _, _, Safe, Safe). 286safe_bodies([Ref-H|T], M, Parents, Safe0, Safe) :- 287 ( H = M2:H2, nonvar(M2), 288 clause_property(Ref, module(M2)) 289 -> copy_term(H2, H3), 290 CM = M2 291 ; copy_term(H, H3), 292 CM = M 293 ), 294 safe(H3, CM, Parents, Safe0, Safe1), 295 safe_bodies(T, M, Parents, Safe1, Safe). 296 297def_module(M:G, MD:QG) :- 298 predicate_property(M:G, imported_from(MD)), 299 !, 300 meta_qualify(MD:G, M, QG). 301def_module(M:G, M:QG) :- 302 meta_qualify(M:G, M, QG).
310safe_list([], _, _, Safe, Safe). 311safe_list([H|T], M, Parents, Safe0, Safe) :- 312 ( H = M2:H2, 313 M == M2 % in our context 314 -> copy_term(H2, H3) 315 ; copy_term(H, H3) % cross-module call 316 ), 317 safe(H3, M, Parents, Safe0, Safe1), 318 safe_list(T, M, Parents, Safe1, Safe).
324meta_qualify(MD:G, M, QG) :- 325 predicate_property(MD:G, meta_predicate(Head)), 326 !, 327 G =.. [Name|Args], 328 Head =.. [_|Q], 329 qualify_args(Q, M, Args, QArgs), 330 QG =.. [Name|QArgs]. 331meta_qualify(_:G, _, G). 332 333qualify_args([], _, [], []). 334qualify_args([H|T], M, [A|AT], [Q|QT]) :- 335 qualify_arg(H, M, A, Q), 336 qualify_args(T, M, AT, QT). 337 338qualify_arg(S, M, A, Q) :- 339 q_arg(S), 340 !, 341 qualify(A, M, Q). 342qualify_arg(_, _, A, A). 343 344q_arg(I) :- integer(I), !. 345q_arg(:). 346q_arg(^). 347q_arg(//). 348 349qualify(A, M, MZ:Q) :- 350 strip_module(M:A, MZ, Q).
362goal_id(M:Goal, M:Id, Gen) :- 363 !, 364 goal_id(Goal, Id, Gen). 365goal_id(Var, _, _) :- 366 var(Var), 367 !, 368 instantiation_error(Var). 369goal_id(Atom, Atom, Atom) :- 370 atom(Atom), 371 !. 372goal_id(Term, _, _) :- 373 \+ compound(Term), 374 !, 375 type_error(callable, Term). 376goal_id(Term, Skolem, Gen) :- % most general form 377 compound_name_arity(Term, Name, Arity), 378 compound_name_arity(Skolem, Name, Arity), 379 compound_name_arity(Gen, Name, Arity), 380 copy_goal_args(1, Term, Skolem, Gen), 381 ( Gen =@= Term 382 -> ! % No more specific one; we can commit 383 ; true 384 ), 385 numbervars(Skolem, 0, _). 386goal_id(Term, Skolem, Term) :- % most specific form 387 debug(sandbox(specify), 'Retrying with ~p', [Term]), 388 copy_term(Term, Skolem), 389 numbervars(Skolem, 0, _).
396copy_goal_args(I, Term, Skolem, Gen) :- 397 arg(I, Term, TA), 398 !, 399 arg(I, Skolem, SA), 400 arg(I, Gen, GA), 401 copy_goal_arg(TA, SA, GA), 402 I2 is I + 1, 403 copy_goal_args(I2, Term, Skolem, Gen). 404copy_goal_args(_, _, _, _). 405 406copy_goal_arg(Arg, SArg, Arg) :- 407 copy_goal_arg(Arg), 408 !, 409 copy_term(Arg, SArg). 410copy_goal_arg(_, _, _). 411 412copy_goal_arg(Var) :- var(Var), !, fail. 413copy_goal_arg(_:_).
425term_expansion(safe_primitive(Goal), Term) :- 426 ( verify_safe_declaration(Goal) 427 -> Term = safe_primitive(Goal) 428 ; Term = [] 429 ). 430term_expansion((safe_primitive(Goal) :- _), Term) :- 431 ( verify_safe_declaration(Goal) 432 -> Term = safe_primitive(Goal) 433 ; Term = [] 434 ). 435 436systemterm_expansion(sandbox:safe_primitive(Goal), Term) :- 437 \+ current_prolog_flag(xref, true), 438 ( verify_safe_declaration(Goal) 439 -> Term = sandbox:safe_primitive(Goal) 440 ; Term = [] 441 ). 442systemterm_expansion((sandbox:safe_primitive(Goal) :- _), Term) :- 443 \+ current_prolog_flag(xref, true), 444 ( verify_safe_declaration(Goal) 445 -> Term = sandbox:safe_primitive(Goal) 446 ; Term = [] 447 ). 448 449verify_safe_declaration(Var) :- 450 var(Var), 451 !, 452 instantiation_error(Var). 453verify_safe_declaration(Module:Goal) :- 454 !, 455 must_be(atom, Module), 456 must_be(callable, Goal), 457 ( ok_meta(Module:Goal) 458 -> true 459 ; ( predicate_property(Module:Goal, visible) 460 -> true 461 ; predicate_property(Module:Goal, foreign) 462 ), 463 \+ predicate_property(Module:Goal, imported_from(_)), 464 \+ predicate_property(Module:Goal, meta_predicate(_)) 465 -> true 466 ; permission_error(declare, safe_goal, Module:Goal) 467 ). 468verify_safe_declaration(Goal) :- 469 must_be(callable, Goal), 470 ( predicate_property(system:Goal, iso), 471 \+ predicate_property(system:Goal, meta_predicate()) 472 -> true 473 ; permission_error(declare, safe_goal, Goal) 474 ). 475 476ok_meta(system:assert(_)). 477ok_meta(system:load_files(_,_)). 478ok_meta(system:use_module(_,_)). 479ok_meta(system:use_module(_)). 480 481verify_predefined_safe_declarations :- 482 forall(clause(safe_primitive(Goal), _Body, Ref), 483 ( E = error(F,_), 484 catch(verify_safe_declaration(Goal), E, true), 485 ( nonvar(F) 486 -> clause_property(Ref, file(File)), 487 clause_property(Ref, line_count(Line)), 488 print_message(error, bad_safe_declaration(Goal, File, Line)) 489 ; true 490 ) 491 )). 492 493:- initialization(verify_predefined_safe_declarations, now).
507% First, all ISO system predicates that are considered safe 508 509safe_primitive(true). 510safe_primitive(fail). 511safe_primitive(system:false). 512safe_primitive(repeat). 513safe_primitive(!). 514 % types 515safe_primitive(var(_)). 516safe_primitive(nonvar(_)). 517safe_primitive(system:attvar(_)). 518safe_primitive(integer(_)). 519safe_primitive(float(_)). 520:- if(current_predicate(rational/1)). 521safe_primitive(system:rational(_)). 522safe_primitive(system:rational(_,_,_)). 523:- endif. 524safe_primitive(number(_)). 525safe_primitive(atom(_)). 526safe_primitive(system:blob(_,_)). 527safe_primitive(system:string(_)). 528safe_primitive(atomic(_)). 529safe_primitive(compound(_)). 530safe_primitive(callable(_)). 531safe_primitive(ground(_)). 532safe_primitive(system:nonground(_,_)). 533safe_primitive(system:cyclic_term(_)). 534safe_primitive(acyclic_term(_)). 535safe_primitive(system:is_stream(_)). 536safe_primitive(system:'$is_char'(_)). 537safe_primitive(system:'$is_char_code'(_)). 538safe_primitive(system:'$is_char_list'(_,_)). 539safe_primitive(system:'$is_code_list'(_,_)). 540 % ordering 541safe_primitive(@>(_,_)). 542safe_primitive(@>=(_,_)). 543safe_primitive(==(_,_)). 544safe_primitive(@<(_,_)). 545safe_primitive(@=<(_,_)). 546safe_primitive(compare(_,_,_)). 547safe_primitive(sort(_,_)). 548safe_primitive(keysort(_,_)). 549safe_primitive(system: =@=(_,_)). 550safe_primitive(system:'$btree_find_node'(_,_,_,_,_)). 551 552 % unification and equivalence 553safe_primitive(=(_,_)). 554safe_primitive(\=(_,_)). 555safe_primitive(system:'?='(_,_)). 556safe_primitive(system:unifiable(_,_,_)). 557safe_primitive(unify_with_occurs_check(_,_)). 558safe_primitive(\==(_,_)). 559 % arithmetic 560safe_primitive(is(_,_)). 561safe_primitive(>(_,_)). 562safe_primitive(>=(_,_)). 563safe_primitive(=:=(_,_)). 564safe_primitive(=\=(_,_)). 565safe_primitive(=<(_,_)). 566safe_primitive(<(_,_)). 567:- if(current_prolog_flag(bounded, false)). 568safe_primitive(system:nth_integer_root_and_remainder(_,_,_,_)). 569:- endif. 570 571 % term-handling 572safe_primitive(arg(_,_,_)). 573safe_primitive(system:setarg(_,_,_)). 574safe_primitive(system:nb_setarg(_,_,_)). 575safe_primitive(system:nb_linkarg(_,_,_)). 576safe_primitive(functor(_,_,_)). 577safe_primitive(_ =.. _). 578safe_primitive(system:compound_name_arity(_,_,_)). 579safe_primitive(system:compound_name_arguments(_,_,_)). 580safe_primitive(system:'$filled_array'(_,_,_,_)). 581safe_primitive(copy_term(_,_)). 582safe_primitive(system:duplicate_term(_,_)). 583safe_primitive(system:copy_term_nat(_,_)). 584safe_primitive(system:size_abstract_term(_,_,_)). 585safe_primitive(numbervars(_,_,_)). 586safe_primitive(system:numbervars(_,_,_,_)). 587safe_primitive(subsumes_term(_,_)). 588safe_primitive(system:term_hash(_,_)). 589safe_primitive(system:term_hash(_,_,_,_)). 590safe_primitive(system:variant_sha1(_,_)). 591safe_primitive(system:variant_hash(_,_)). 592safe_primitive(system:'$term_size'(_,_,_)). 593 594 % dicts 595safe_primitive(system:is_dict(_)). 596safe_primitive(system:is_dict(_,_)). 597safe_primitive(system:get_dict(_,_,_)). 598safe_primitive(system:get_dict(_,_,_,_,_)). 599safe_primitive(system:'$get_dict_ex'(_,_,_)). 600safe_primitive(system:dict_create(_,_,_)). 601safe_primitive(system:dict_pairs(_,_,_)). 602safe_primitive(system:put_dict(_,_,_)). 603safe_primitive(system:put_dict(_,_,_,_)). 604safe_primitive(system:del_dict(_,_,_,_)). 605safe_primitive(system:select_dict(_,_,_)). 606safe_primitive(system:b_set_dict(_,_,_)). 607safe_primitive(system:nb_set_dict(_,_,_)). 608safe_primitive(system:nb_link_dict(_,_,_)). 609safe_primitive(system:(:<(_,_))). 610safe_primitive(system:(>:<(_,_))). 611 % atoms 612safe_primitive(atom_chars(_, _)). 613safe_primitive(atom_codes(_, _)). 614safe_primitive(sub_atom(_,_,_,_,_)). 615safe_primitive(atom_concat(_,_,_)). 616safe_primitive(atom_length(_,_)). 617safe_primitive(char_code(_,_)). 618safe_primitive(system:name(_,_)). 619safe_primitive(system:atomic_concat(_,_,_)). 620safe_primitive(system:atomic_list_concat(_,_)). 621safe_primitive(system:atomic_list_concat(_,_,_)). 622safe_primitive(system:downcase_atom(_,_)). 623safe_primitive(system:upcase_atom(_,_)). 624safe_primitive(system:char_type(_,_)). 625safe_primitive(system:normalize_space(_,_)). 626safe_primitive(system:sub_atom_icasechk(_,_,_)). 627 % numbers 628safe_primitive(number_codes(_,_)). 629safe_primitive(number_chars(_,_)). 630safe_primitive(system:atom_number(_,_)). 631safe_primitive(system:code_type(_,_)). 632 % strings 633safe_primitive(system:atom_string(_,_)). 634safe_primitive(system:number_string(_,_)). 635safe_primitive(system:string_chars(_, _)). 636safe_primitive(system:string_codes(_, _)). 637safe_primitive(system:string_code(_,_,_)). 638safe_primitive(system:sub_string(_,_,_,_,_)). 639safe_primitive(system:split_string(_,_,_,_)). 640safe_primitive(system:atomics_to_string(_,_,_)). 641safe_primitive(system:atomics_to_string(_,_)). 642safe_primitive(system:string_concat(_,_,_)). 643safe_primitive(system:string_length(_,_)). 644safe_primitive(system:string_lower(_,_)). 645safe_primitive(system:string_upper(_,_)). 646safe_primitive(system:term_string(_,_)). 647safe_primitive('$syspreds':term_string(_,_,_)). 648 % Lists 649safe_primitive(length(_,_)). 650 % exceptions 651safe_primitive(throw(_)). 652safe_primitive(system:abort). 653 % misc 654safe_primitive(current_prolog_flag(_,_)). 655safe_primitive(current_op(_,_,_)). 656safe_primitive(system:sleep(_)). 657safe_primitive(system:thread_self(_)). 658safe_primitive(system:get_time(_)). 659safe_primitive(system:statistics(_,_)). 660safe_primitive(system:thread_statistics(Id,_,_)) :- 661 ( var(Id) 662 -> instantiation_error(Id) 663 ; thread_self(Id) 664 ). 665safe_primitive(system:thread_property(Id,_)) :- 666 ( var(Id) 667 -> instantiation_error(Id) 668 ; thread_self(Id) 669 ). 670safe_primitive(system:format_time(_,_,_)). 671safe_primitive(system:format_time(_,_,_,_)). 672safe_primitive(system:date_time_stamp(_,_)). 673safe_primitive(system:stamp_date_time(_,_,_)). 674safe_primitive(system:strip_module(_,_,_)). 675safe_primitive('$messages':message_to_string(_,_)). 676safe_primitive(system:import_module(_,_)). 677safe_primitive(system:file_base_name(_,_)). 678safe_primitive(system:file_directory_name(_,_)). 679safe_primitive(system:file_name_extension(_,_,_)). 680 681safe_primitive(clause(H,_)) :- safe_clause(H). 682safe_primitive(asserta(X)) :- safe_assert(X). 683safe_primitive(assertz(X)) :- safe_assert(X). 684safe_primitive(retract(X)) :- safe_assert(X). 685safe_primitive(retractall(X)) :- safe_assert(X). 686safe_primitive('$dcg':dcg_translate_rule(_,_)). 687 688% We need to do data flow analysis to find the tag of the 689% target key before we can conclude that functions on dicts 690% are safe. 691safe_primitive('$dicts':'.'(_,K,_)) :- atom(K). 692safe_primitive('$dicts':'.'(_,K,_)) :- 693 ( nonvar(K) 694 -> dict_built_in(K) 695 ; instantiation_error(K) 696 ). 697 698dict_built_in(get(_)). 699dict_built_in(put(_)). 700dict_built_in(put(_,_)). 701 702% The non-ISO system predicates. These can be redefined, so we must 703% be careful to ensure the system ones are used. 704 705safe_primitive(system:false). 706safe_primitive(system:cyclic_term(_)). 707safe_primitive(system:msort(_,_)). 708safe_primitive(system:sort(_,_,_,_)). 709safe_primitive(system:between(_,_,_)). 710safe_primitive(system:succ(_,_)). 711safe_primitive(system:plus(_,_,_)). 712safe_primitive(system:float_class(_,_)). 713safe_primitive(system:term_variables(_,_)). 714safe_primitive(system:term_variables(_,_,_)). 715safe_primitive(system:'$term_size'(_,_,_)). 716safe_primitive(system:atom_to_term(_,_,_)). 717safe_primitive(system:term_to_atom(_,_)). 718safe_primitive(system:atomic_list_concat(_,_,_)). 719safe_primitive(system:atomic_list_concat(_,_)). 720safe_primitive(system:downcase_atom(_,_)). 721safe_primitive(system:upcase_atom(_,_)). 722safe_primitive(system:is_list(_)). 723safe_primitive(system:memberchk(_,_)). 724safe_primitive(system:'$skip_list'(_,_,_)). 725 % attributes 726safe_primitive(system:get_attr(_,_,_)). 727safe_primitive(system:get_attrs(_,_)). 728safe_primitive(system:term_attvars(_,_)). 729safe_primitive(system:del_attr(_,_)). 730safe_primitive(system:del_attrs(_)). 731safe_primitive('$attvar':copy_term(_,_,_)). 732 % globals 733safe_primitive(system:b_getval(_,_)). 734safe_primitive(system:b_setval(Var,_)) :- 735 safe_global_var(Var). 736safe_primitive(system:nb_getval(_,_)). 737safe_primitive('$syspreds':nb_setval(Var,_)) :- 738 safe_global_var(Var). 739safe_primitive(system:nb_linkval(Var,_)) :- 740 safe_global_var(Var). 741safe_primitive(system:nb_current(_,_)). 742 % database 743safe_primitive(system:assert(X)) :- 744 safe_assert(X). 745 % Output 746safe_primitive(system:writeln(_)). 747safe_primitive('$messages':print_message(_,_)). 748 749 % Stack limits (down) 750safe_primitive('$syspreds':set_prolog_stack(Stack, limit(ByteExpr))) :- 751 nonvar(Stack), 752 stack_name(Stack), 753 catch(Bytes is ByteExpr, _, fail), 754 prolog_stack_property(Stack, limit(Current)), 755 Bytes =< Current. 756 757stack_name(global). 758stack_name(local). 759stack_name(trail). 760 761safe_primitive('$tabling':abolish_all_tables). 762safe_primitive('$tabling':'$wrap_tabled'(Module:_Head, _Mode)) :- 763 prolog_load_context(module, Module), 764 !. 765safe_primitive('$tabling':'$moded_wrap_tabled'(Module:_Head,_,_,_,_)) :- 766 prolog_load_context(module, Module), 767 !. 768 769 770% use_module/1. We only allow for .pl files that are loaded from 771% relative paths that do not contain /../ 772 773safe_primitive(system:use_module(Spec, _Import)) :- 774 safe_primitive(system:use_module(Spec)). 775safe_primitive(system:load_files(Spec, Options)) :- 776 safe_primitive(system:use_module(Spec)), 777 maplist(safe_load_file_option, Options). 778safe_primitive(system:use_module(Spec)) :- 779 ground(Spec), 780 ( atom(Spec) 781 -> Path = Spec 782 ; Spec =.. [_Alias, Segments], 783 phrase(segments_to_path(Segments), List), 784 atomic_list_concat(List, Path) 785 ), 786 \+ is_absolute_file_name(Path), 787 \+ sub_atom(Path, _, _, _, '/../'), 788 absolute_file_name(Spec, AbsFile, 789 [ access(read), 790 file_type(prolog), 791 file_errors(fail) 792 ]), 793 file_name_extension(_, Ext, AbsFile), 794 save_extension(Ext). 795 796% support predicates for safe_primitive, validating the safety of 797% arguments to certain goals. 798 799segments_to_path(A/B) --> 800 !, 801 segments_to_path(A), 802 [/], 803 segments_to_path(B). 804segments_to_path(X) --> 805 [X]. 806 807save_extension(pl). 808 809safe_load_file_option(if(changed)). 810safe_load_file_option(if(not_loaded)). 811safe_load_file_option(must_be_module(_)). 812safe_load_file_option(optimise(_)). 813safe_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.822safe_assert(C) :- cyclic_term(C), !, fail. 823safe_assert(X) :- var(X), !, fail. 824safe_assert(_Head:-_Body) :- !, fail. 825safe_assert(_:_) :- !, fail. 826safe_assert(_).
834safe_clause(H) :- var(H), !. 835safe_clause(_:_) :- !, fail. 836safe_clause(_).
844safe_global_var(Name) :- 845 var(Name), 846 !, 847 instantiation_error(Name). 848safe_global_var(Name) :- 849 safe_global_variable(Name).
861safe_meta(system:put_attr(V,M,A), Called) :- 862 !, 863 ( atom(M) 864 -> attr_hook_predicates([ attr_unify_hook(A, _), 865 attribute_goals(V,_,_), 866 project_attributes(_,_) 867 ], M, Called) 868 ; instantiation_error(M) 869 ). 870safe_meta(system:with_output_to(Output, G), [G]) :- 871 safe_output(Output), 872 !. 873safe_meta(system:format(Format, Args), Calls) :- 874 format_calls(Format, Args, Calls). 875safe_meta(system:format(Output, Format, Args), Calls) :- 876 safe_output(Output), 877 format_calls(Format, Args, Calls). 878safe_meta(prolog_debug:debug(_Term, Format, Args), Calls) :- 879 format_calls(Format, Args, Calls). 880safe_meta(system:set_prolog_flag(Flag, Value), []) :- 881 atom(Flag), 882 safe_prolog_flag(Flag, Value). 883safe_meta('$attvar':freeze(_Var,Goal), [Goal]). 884safe_meta(phrase(NT,Xs0,Xs), [Goal]) :- % phrase/2,3 and call_dcg/2,3 885 expand_nt(NT,Xs0,Xs,Goal). 886safe_meta(phrase(NT,Xs0), [Goal]) :- 887 expand_nt(NT,Xs0,[],Goal). 888safe_meta('$dcg':call_dcg(NT,Xs0,Xs), [Goal]) :- 889 expand_nt(NT,Xs0,Xs,Goal). 890safe_meta('$dcg':call_dcg(NT,Xs0), [Goal]) :- 891 expand_nt(NT,Xs0,[],Goal). 892safe_meta('$tabling':abolish_table_subgoals(V), []) :- 893 \+ qualified(V). 894safe_meta('$tabling':current_table(V, _), []) :- 895 \+ qualified(V). 896safe_meta('$tabling':tnot(G), [G]). 897safe_meta('$tabling':not_exists(G), [G]). 898 899qualified(V) :- 900 nonvar(V), 901 V = _:_.
911attr_hook_predicates([], _, []). 912attr_hook_predicates([H|T], M, Called) :- 913 ( predicate_property(M:H, defined) 914 -> Called = [M:H|Rest] 915 ; Called = Rest 916 ), 917 attr_hook_predicates(T, M, Rest).
925expand_nt(NT, _Xs0, _Xs, _NewGoal) :- 926 strip_module(NT, _, Plain), 927 var(Plain), 928 !, 929 instantiation_error(Plain). 930expand_nt(NT, Xs0, Xs, NewGoal) :- 931 dcg_translate_rule((pseudo_nt --> NT), 932 (pseudo_nt(Xs0c,Xsc) :- NewGoal0)), 933 ( var(Xsc), Xsc \== Xs0c 934 -> Xs = Xsc, NewGoal1 = NewGoal0 935 ; NewGoal1 = (NewGoal0, Xsc = Xs) 936 ), 937 ( var(Xs0c) 938 -> Xs0 = Xs0c, 939 NewGoal = NewGoal1 940 ; NewGoal = ( Xs0 = Xs0c, NewGoal1 ) 941 ).
948safe_meta_call(Goal, _, _Called) :- 949 debug(sandbox(meta), 'Safe meta ~p?', [Goal]), 950 fail. 951safe_meta_call(Goal, Context, Called) :- 952 ( safe_meta(Goal, Called) 953 -> true 954 ; safe_meta(Goal, Context, Called) 955 ), 956 !. % call hook 957safe_meta_call(Goal, _, Called) :- 958 Goal = M:Plain, 959 compound(Plain), 960 compound_name_arity(Plain, Name, Arity), 961 safe_meta_predicate(M:Name/Arity), 962 predicate_property(Goal, meta_predicate(Spec)), 963 !, 964 called(Spec, Plain, Called). 965safe_meta_call(M:Goal, _, Called) :- 966 !, 967 generic_goal(Goal, Gen), 968 safe_meta(M:Gen), 969 called(Gen, Goal, Called). 970safe_meta_call(Goal, _, Called) :- 971 generic_goal(Goal, Gen), 972 safe_meta(Gen), 973 called(Gen, Goal, Called). 974 975called(Gen, Goal, Called) :- 976 compound_name_arity(Goal, _, Arity), 977 called(1, Arity, Gen, Goal, Called). 978 979called(I, Arity, Gen, Goal, Called) :- 980 I =< Arity, 981 !, 982 arg(I, Gen, Spec), 983 ( calling_meta_spec(Spec) 984 -> arg(I, Goal, Called0), 985 extend(Spec, Called0, G), 986 Called = [G|Rest] 987 ; Called = Rest 988 ), 989 I2 is I+1, 990 called(I2, Arity, Gen, Goal, Rest). 991called(_, _, _, _, []). 992 993generic_goal(G, Gen) :- 994 functor(G, Name, Arity), 995 functor(Gen, Name, Arity). 996 997calling_meta_spec(V) :- var(V), !, fail. 998calling_meta_spec(I) :- integer(I), !. 999calling_meta_spec(^). 1000calling_meta_spec(//). 1001 1002 1003extend(^, G, Plain) :- 1004 !, 1005 strip_existential(G, Plain). 1006extend(//, DCG, Goal) :- 1007 !, 1008 ( expand_phrase(call_dcg(DCG,_,_), Goal) 1009 -> true 1010 ; instantiation_error(DCG) % Ask more instantiation. 1011 ). % might not help, but does not harm. 1012extend(0, G, G) :- !. 1013extend(I, M:G0, M:G) :- 1014 !, 1015 G0 =.. List, 1016 length(Extra, I), 1017 append(List, Extra, All), 1018 G =.. All. 1019extend(I, G0, G) :- 1020 G0 =.. List, 1021 length(Extra, I), 1022 append(List, Extra, All), 1023 G =.. All. 1024 1025strip_existential(Var, Var) :- 1026 var(Var), 1027 !. 1028strip_existential(M:G0, M:G) :- 1029 !, 1030 strip_existential(G0, G). 1031strip_existential(_^G0, G) :- 1032 !, 1033 strip_existential(G0, G). 1034strip_existential(G, G).
1038safe_meta((0,0)). 1039safe_meta((0;0)). 1040safe_meta((0->0)). 1041safe_meta(system:(0*->0)). 1042safe_meta(catch(0,*,0)). 1043safe_meta(findall(*,0,*)). 1044safe_meta('$bags':findall(*,0,*,*)). 1045safe_meta(setof(*,^,*)). 1046safe_meta(bagof(*,^,*)). 1047safe_meta('$bags':findnsols(*,*,0,*)). 1048safe_meta('$bags':findnsols(*,*,0,*,*)). 1049safe_meta(system:call_cleanup(0,0)). 1050safe_meta(system:setup_call_cleanup(0,0,0)). 1051safe_meta(system:setup_call_catcher_cleanup(0,0,*,0)). 1052safe_meta('$attvar':call_residue_vars(0,*)). 1053safe_meta('$syspreds':call_with_inference_limit(0,*,*)). 1054safe_meta('$syspreds':call_with_depth_limit(0,*,*)). 1055safe_meta('$syspreds':undo(0)). 1056safe_meta(^(*,0)). 1057safe_meta(\+(0)). 1058safe_meta(call(0)). 1059safe_meta(call(1,*)). 1060safe_meta(call(2,*,*)). 1061safe_meta(call(3,*,*,*)). 1062safe_meta(call(4,*,*,*,*)). 1063safe_meta(call(5,*,*,*,*,*)). 1064safe_meta(call(6,*,*,*,*,*,*)). 1065safe_meta('$tabling':start_tabling(*,0)). 1066safe_meta('$tabling':start_tabling(*,0,*,*)). 1067safe_meta(wfs:call_delays(0,*)).
1074safe_output(Output) :- 1075 var(Output), 1076 !, 1077 instantiation_error(Output). 1078safe_output(atom(_)). 1079safe_output(string(_)). 1080safe_output(codes(_)). 1081safe_output(codes(_,_)). 1082safe_output(chars(_)). 1083safe_output(chars(_,_)). 1084safe_output(current_output). 1085safe_output(current_error).
1091:- public format_calls/3. % used in pengines_io 1092 1093format_calls(Format, _Args, _Calls) :- 1094 var(Format), 1095 !, 1096 instantiation_error(Format). 1097format_calls(Format, Args, Calls) :- 1098 format_types(Format, Types), 1099 ( format_callables(Types, Args, Calls) 1100 -> true 1101 ; throw(error(format_error(Format, Types, Args), _)) 1102 ). 1103 1104format_callables([], [], []). 1105format_callables([callable|TT], [G|TA], [G|TG]) :- 1106 !, 1107 format_callables(TT, TA, TG). 1108format_callables([_|TT], [_|TA], TG) :- 1109 !, 1110 format_callables(TT, TA, TG). 1111 1112 1113 /******************************* 1114 * SAFE COMPILATION HOOKS * 1115 *******************************/ 1116 1117:- multifile 1118 prolog:sandbox_allowed_directive/1, 1119 prolog:sandbox_allowed_goal/1, 1120 prolog:sandbox_allowed_expansion/1.
1126prologsandbox_allowed_directive(Directive) :- 1127 debug(sandbox(directive), 'Directive: ~p', [Directive]), 1128 fail. 1129prologsandbox_allowed_directive(Directive) :- 1130 safe_directive(Directive), 1131 !. 1132prologsandbox_allowed_directive(M:PredAttr) :- 1133 \+ prolog_load_context(module, M), 1134 !, 1135 debug(sandbox(directive), 'Cross-module directive', []), 1136 permission_error(execute, sandboxed_directive, (:- M:PredAttr)). 1137prologsandbox_allowed_directive(M:PredAttr) :- 1138 safe_pattr(PredAttr), 1139 !, 1140 PredAttr =.. [Attr, Preds], 1141 ( safe_pattr(Preds, Attr) 1142 -> true 1143 ; permission_error(execute, sandboxed_directive, (:- M:PredAttr)) 1144 ). 1145prologsandbox_allowed_directive(_:Directive) :- 1146 safe_source_directive(Directive), 1147 !. 1148prologsandbox_allowed_directive(_:Directive) :- 1149 directive_loads_file(Directive, File), 1150 !, 1151 safe_path(File). 1152prologsandbox_allowed_directive(G) :- 1153 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),
...
1171safe_pattr(dynamic(_)). 1172safe_pattr(thread_local(_)). 1173safe_pattr(volatile(_)). 1174safe_pattr(discontiguous(_)). 1175safe_pattr(multifile(_)). 1176safe_pattr(public(_)). 1177safe_pattr(meta_predicate(_)). 1178safe_pattr(table(_)). 1179safe_pattr(non_terminal(_)). 1180 1181safe_pattr(Var, _) :- 1182 var(Var), 1183 !, 1184 instantiation_error(Var). 1185safe_pattr((A,B), Attr) :- 1186 !, 1187 safe_pattr(A, Attr), 1188 safe_pattr(B, Attr). 1189safe_pattr(M:G, Attr) :- 1190 !, 1191 ( atom(M), 1192 prolog_load_context(module, M) 1193 -> true 1194 ; Goal =.. [Attr,M:G], 1195 permission_error(directive, sandboxed, (:- Goal)) 1196 ). 1197safe_pattr(_, _). 1198 1199safe_source_directive(op(_,_,Name)) :- 1200 !, 1201 ( atom(Name) 1202 -> true 1203 ; is_list(Name), 1204 maplist(atom, Name) 1205 ). 1206safe_source_directive(set_prolog_flag(Flag, Value)) :- 1207 !, 1208 atom(Flag), ground(Value), 1209 safe_prolog_flag(Flag, Value). 1210safe_source_directive(style_check(_)). 1211safe_source_directive(initialization(_)). % Checked at runtime 1212safe_source_directive(initialization(_,_)). % Checked at runtime 1213 1214directive_loads_file(use_module(library(X)), X). 1215directive_loads_file(use_module(library(X), _Imports), X). 1216directive_loads_file(load_files(library(X), _Options), X). 1217directive_loads_file(ensure_loaded(library(X)), X). 1218directive_loads_file(include(X), X). 1219 1220safe_path(X) :- 1221 var(X), 1222 !, 1223 instantiation_error(X). 1224safe_path(X) :- 1225 ( atom(X) 1226 ; string(X) 1227 ), 1228 !, 1229 \+ sub_atom(X, 0, _, 0, '..'), 1230 \+ sub_atom(X, 0, _, _, '/'), 1231 \+ sub_atom(X, 0, _, _, '../'), 1232 \+ sub_atom(X, _, _, 0, '/..'), 1233 \+ sub_atom(X, _, _, _, '/../'). 1234safe_path(A/B) :- 1235 !, 1236 safe_path(A), 1237 safe_path(B).
1249% misc 1250safe_prolog_flag(generate_debug_info, _). 1251safe_prolog_flag(optimise, _). 1252safe_prolog_flag(occurs_check, _). 1253% syntax 1254safe_prolog_flag(var_prefix, _). 1255safe_prolog_flag(double_quotes, _). 1256safe_prolog_flag(back_quotes, _). 1257safe_prolog_flag(rational_syntax, _). 1258% arithmetic 1259safe_prolog_flag(prefer_rationals, _). 1260safe_prolog_flag(float_overflow, _). 1261safe_prolog_flag(float_zero_div, _). 1262safe_prolog_flag(float_undefined, _). 1263safe_prolog_flag(float_underflow, _). 1264safe_prolog_flag(float_rounding, _). 1265safe_prolog_flag(float_rounding, _). 1266safe_prolog_flag(max_rational_size, _). 1267safe_prolog_flag(max_rational_size_action, _). 1268% tabling 1269safe_prolog_flag(max_answers_for_subgoal,_). 1270safe_prolog_flag(max_answers_for_subgoal_action,_). 1271safe_prolog_flag(max_table_answer_size,_). 1272safe_prolog_flag(max_table_answer_size_action,_). 1273safe_prolog_flag(max_table_subgoal_size,_). 1274safe_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.
1290prologsandbox_allowed_expansion(M:G) :- 1291 prolog_load_context(module, M), 1292 !, 1293 debug(sandbox(expansion), 'Expand in ~p: ~p', [M, G]), 1294 safe_goal(M:G). 1295prologsandbox_allowed_expansion(_,_).
1301prologsandbox_allowed_goal(G) :- 1302 safe_goal(G). 1303 1304 1305 /******************************* 1306 * MESSAGES * 1307 *******************************/ 1308 1309:- multifile 1310 prolog:message//1, 1311 prolog:message_context//1, 1312 prolog:error_message//1. 1313 1314prologmessage(error(instantiation_error, Context)) --> 1315 { nonvar(Context), 1316 Context = sandbox(_Goal,Parents), 1317 numbervars(Context, 1, _) 1318 }, 1319 [ 'Sandbox restriction!'-[], nl, 1320 'Could not derive which predicate may be called from'-[] 1321 ], 1322 ( { Parents == [] } 1323 -> [ 'Search space too large'-[] ] 1324 ; callers(Parents, 10) 1325 ). 1326 1327prologmessage_context(sandbox(_G, [])) --> !. 1328prologmessage_context(sandbox(_G, Parents)) --> 1329 [ nl, 'Reachable from:'-[] ], 1330 callers(Parents, 10). 1331 1332callers([], _) --> !. 1333callers(_, 0) --> !. 1334callers([G|Parents], Level) --> 1335 { NextLevel is Level-1 1336 }, 1337 [ nl, '\t ~p'-[G] ], 1338 callers(Parents, NextLevel). 1339 1340prologmessage(bad_safe_declaration(Goal, File, Line)) --> 1341 [ '~w:~d: Invalid safe_primitive/1 declaration: ~p'- 1342 [File, Line, Goal] ]. 1343 1344prologerror_message(format_error(Format, Types, Args)) --> 1345 format_error(Format, Types, Args). 1346 1347format_error(Format, Types, Args) --> 1348 { length(Types, TypeLen), 1349 length(Args, ArgsLen), 1350 ( TypeLen > ArgsLen 1351 -> Problem = 'not enough' 1352 ; Problem = 'too many' 1353 ) 1354 }, 1355 [ 'format(~q): ~w arguments (found ~w, need ~w)'- 1356 [Format, Problem, ArgsLen, TypeLen] 1357 ]
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.