1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2013-2016, VU University Amsterdam 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(sandbox, 36 [ safe_goal/1, % :Goal 37 safe_call/1 % :Goal 38 ]). 39:- use_module(library(assoc)). 40:- use_module(library(lists)). 41:- use_module(library(debug)). 42:- use_module(library(error)). 43:- use_module(library(prolog_format)). 44:- use_module(library(apply)). 45 46:- multifile 47 safe_primitive/1, % Goal 48 safe_meta_predicate/1, % Name/Arity 49 safe_meta/2, % Goal, Calls 50 safe_meta/3, % Goal, Context, Calls 51 safe_global_variable/1, % Name 52 safe_directive/1. % Module:Goal 53 54% :- debug(sandbox).
70:- meta_predicate
71 safe_goal(),
72 safe_call().
84safe_call(Goal0) :-
85 expand_goal(Goal0, Goal),
86 safe_goal(Goal),
87 call().111safe_goal(M:Goal) :- 112 empty_assoc(Safe0), 113 catch(safe(Goal, M, [], Safe0, _), E, true), 114 !, 115 nb_delete(sandbox_last_error), 116 ( var(E) 117 -> true 118 ; throw(E) 119 ). 120safe_goal(_) :- 121 nb_current(sandbox_last_error, E), 122 !, 123 nb_delete(sandbox_last_error), 124 throw(E). 125safe_goal(G) :- 126 debug(sandbox(fail), 'safe_goal/1 failed for ~p', [G]), 127 throw(error(instantiation_error, sandbox(G, []))).
134safe(V, _, Parents, _, _) :- 135 var(V), 136 !, 137 Error = error(instantiation_error, sandbox(V, Parents)), 138 nb_setval(sandbox_last_error, Error), 139 throw(Error). 140safe(M:G, _, Parents, Safe0, Safe) :- 141 !, 142 must_be(atom, M), 143 must_be(callable, G), 144 ( predicate_property(M:G, imported_from(M2)) 145 -> true 146 ; M2 = M 147 ), 148 ( ( safe_primitive(M2:G) 149 ; safe_primitive(G), 150 predicate_property(G, iso) 151 ) 152 -> Safe = Safe0 153 ; ( predicate_property(M:G, exported) 154 ; predicate_property(M:G, public) 155 ; predicate_property(M:G, multifile) 156 ; predicate_property(M:G, iso) 157 ; memberchk(M:_, Parents) 158 ) 159 -> safe(G, M, Parents, Safe0, Safe) 160 ; throw(error(permission_error(call, sandboxed, M:G), 161 sandbox(M:G, Parents))) 162 ). 163safe(G, _, Parents, _, _) :- 164 debugging(sandbox(show)), 165 length(Parents, Level), 166 debug(sandbox(show), '[~D] SAFE ~q?', [Level, G]), 167 fail. 168safe(G, _, Parents, Safe, Safe) :- 169 catch(safe_primitive(G), 170 error(instantiation_error, _), 171 rethrow_instantition_error([G|Parents])), 172 predicate_property(G, iso), 173 !. 174safe(G, M, Parents, Safe, Safe) :- 175 ( predicate_property(M:G, imported_from(M2)) 176 -> true 177 ; M2 = M 178 ), 179 ( catch(safe_primitive(M2:G), 180 error(instantiation_error, _), 181 rethrow_instantition_error([M2:G|Parents])) 182 ; predicate_property(M2:G, number_of_rules(0)) 183 ), 184 !. 185safe(G, M, Parents, Safe0, Safe) :- 186 predicate_property(G, iso), 187 safe_meta_call(G, M, Called), 188 !, 189 safe_list(Called, M, Parents, Safe0, Safe). 190safe(G, M, Parents, Safe0, Safe) :- 191 ( predicate_property(M:G, imported_from(M2)) 192 -> true 193 ; M2 = M 194 ), 195 safe_meta_call(M2:G, M, Called), 196 !, 197 safe_list(Called, M, Parents, Safe0, Safe). 198safe(G, M, Parents, Safe0, Safe) :- 199 goal_id(M:G, Id, Gen), 200 ( get_assoc(Id, Safe0, _) 201 -> Safe = Safe0 202 ; put_assoc(Id, Safe0, true, Safe1), 203 ( Gen == M:G 204 -> safe_clauses(Gen, M, [Id|Parents], Safe1, Safe) 205 ; catch(safe_clauses(Gen, M, [Id|Parents], Safe1, Safe), 206 error(instantiation_error, Ctx), 207 unsafe(Parents, Ctx)) 208 ) 209 ), 210 !. 211safe(G, M, Parents, _, _) :- 212 debug(sandbox(fail), 213 'safe/1 failed for ~p (parents:~p)', [M:G, Parents]), 214 fail. 215 216unsafe(Parents, Var) :- 217 var(Var), 218 !, 219 nb_setval(sandbox_last_error, 220 error(instantiation_error, sandbox(_, Parents))), 221 fail. 222unsafe(_Parents, Ctx) :- 223 Ctx = sandbox(_,_), 224 nb_setval(sandbox_last_error, 225 error(instantiation_error, Ctx)), 226 fail. 227 228rethrow_instantition_error(Parents) :- 229 throw(error(instantiation_error, sandbox(_, Parents))). 230 231safe_clauses(G, M, Parents, Safe0, Safe) :- 232 predicate_property(M:G, interpreted), 233 def_module(M:G, MD:QG), 234 \+ compiled(MD:QG), 235 !, 236 findall(Ref-Body, clause(MD:, Body, Ref), Bodies), 237 safe_bodies(Bodies, MD, Parents, Safe0, Safe). 238safe_clauses(G, M, [_|Parents], _, _) :- 239 predicate_property(M:G, visible), 240 !, 241 throw(error(permission_error(call, sandboxed, G), 242 sandbox(M:G, Parents))). 243safe_clauses(_, _, [G|Parents], _, _) :- 244 throw(error(existence_error(procedure, G), 245 sandbox(G, Parents))). 246 247compiled(system:(@(_,_))).
255safe_bodies([], _, _, Safe, Safe). 256safe_bodies([Ref-H|T], M, Parents, Safe0, Safe) :- 257 ( H = M2:H2, nonvar(M2), 258 clause_property(Ref, module(M2)) 259 -> copy_term(H2, H3), 260 CM = M2 261 ; copy_term(H, H3), 262 CM = M 263 ), 264 safe(H3, CM, Parents, Safe0, Safe1), 265 safe_bodies(T, M, Parents, Safe1, Safe). 266 267def_module(M:G, MD:QG) :- 268 predicate_property(M:G, imported_from(MD)), 269 !, 270 meta_qualify(MD:G, M, QG). 271def_module(M:G, M:QG) :- 272 meta_qualify(M:G, M, QG).
280safe_list([], _, _, Safe, Safe). 281safe_list([H|T], M, Parents, Safe0, Safe) :- 282 ( H = M2:H2, 283 M == M2 % in our context 284 -> copy_term(H2, H3) 285 ; copy_term(H, H3) % cross-module call 286 ), 287 safe(H3, M, Parents, Safe0, Safe1), 288 safe_list(T, M, Parents, Safe1, Safe).
294meta_qualify(MD:G, M, QG) :- 295 predicate_property(MD:G, meta_predicate(Head)), 296 !, 297 G =.. [Name|Args], 298 Head =.. [_|Q], 299 qualify_args(Q, M, Args, QArgs), 300 QG =.. [Name|QArgs]. 301meta_qualify(_:G, _, G). 302 303qualify_args([], _, [], []). 304qualify_args([H|T], M, [A|AT], [Q|QT]) :- 305 qualify_arg(H, M, A, Q), 306 qualify_args(T, M, AT, QT). 307 308qualify_arg(S, M, A, Q) :- 309 q_arg(S), 310 !, 311 qualify(A, M, Q). 312qualify_arg(_, _, A, A). 313 314q_arg(I) :- integer(I), !. 315q_arg(:). 316q_arg(^). 317q_arg(//). 318 319qualify(A, M, MZ:Q) :- 320 strip_module(M:A, MZ, Q).
332goal_id(M:Goal, M:Id, Gen) :- 333 !, 334 goal_id(Goal, Id, Gen). 335goal_id(Var, _, _) :- 336 var(Var), 337 !, 338 instantiation_error(Var). 339goal_id(Atom, Atom, Atom) :- 340 atom(Atom), 341 !. 342goal_id(Term, _, _) :- 343 \+ compound(Term), 344 !, 345 type_error(callable, Term). 346goal_id(Term, Skolem, Gen) :- % most general form 347 compound_name_arity(Term, Name, Arity), 348 compound_name_arity(Skolem, Name, Arity), 349 compound_name_arity(Gen, Name, Arity), 350 copy_goal_args(1, Term, Skolem, Gen), 351 ( Gen =@= Term 352 -> ! % No more specific one; we can commit 353 ; true 354 ), 355 numbervars(Skolem, 0, _). 356goal_id(Term, Skolem, Term) :- % most specific form 357 debug(sandbox(specify), 'Retrying with ~p', [Term]), 358 copy_term(Term, Skolem), 359 numbervars(Skolem, 0, _).
366copy_goal_args(I, Term, Skolem, Gen) :- 367 arg(I, Term, TA), 368 !, 369 arg(I, Skolem, SA), 370 arg(I, Gen, GA), 371 copy_goal_arg(TA, SA, GA), 372 I2 is I + 1, 373 copy_goal_args(I2, Term, Skolem, Gen). 374copy_goal_args(_, _, _, _). 375 376copy_goal_arg(Arg, SArg, Arg) :- 377 copy_goal_arg(Arg), 378 !, 379 copy_term(Arg, SArg). 380copy_goal_arg(_, _, _). 381 382copy_goal_arg(Var) :- var(Var), !, fail. 383copy_goal_arg(_:_).
395term_expansion(safe_primitive(Goal), Term) :- 396 ( verify_safe_declaration(Goal) 397 -> Term = safe_primitive(Goal) 398 ; Term = [] 399 ). 400 401systemterm_expansion(sandbox:safe_primitive(Goal), Term) :- 402 \+ current_prolog_flag(xref, true), 403 ( verify_safe_declaration(Goal) 404 -> Term = sandbox:safe_primitive(Goal) 405 ; Term = [] 406 ). 407 408verify_safe_declaration(Var) :- 409 var(Var), 410 !, 411 instantiation_error(Var). 412verify_safe_declaration(Module:Goal) :- 413 must_be(atom, Module), 414 must_be(callable, Goal), 415 ( ok_meta(Module:Goal) 416 -> true 417 ; ( predicate_property(Module:Goal, visible) 418 -> true 419 ; predicate_property(Module:Goal, foreign) 420 ), 421 \+ predicate_property(Module:Goal, imported_from(_)), 422 \+ predicate_property(Module:Goal, meta_predicate(_)) 423 -> true 424 ; permission_error(declare, safe_goal, Module:Goal) 425 ). 426verify_safe_declaration(Goal) :- 427 must_be(callable, Goal), 428 ( predicate_property(system:Goal, iso), 429 \+ predicate_property(system:Goal, meta_predicate()) 430 -> true 431 ; permission_error(declare, safe_goal, Goal) 432 ). 433 434ok_meta(system:assert(_)). 435ok_meta(system:use_module(_,_)). 436ok_meta(system:use_module(_)). 437 438verify_predefined_safe_declarations :- 439 forall(clause(safe_primitive(Goal), _Body, Ref), 440 ( catch(verify_safe_declaration(Goal), E, true), 441 ( nonvar(E) 442 -> clause_property(Ref, file(File)), 443 clause_property(Ref, line_count(Line)), 444 print_message(error, bad_safe_declaration(Goal, File, Line)) 445 ; true 446 ) 447 )). 448 449:- initialization(verify_predefined_safe_declarations, now).
463% First, all ISO system predicates that are considered safe 464 465safe_primitive(true). 466safe_primitive(fail). 467safe_primitive(system:false). 468safe_primitive(repeat). 469safe_primitive(!). 470 % types 471safe_primitive(var(_)). 472safe_primitive(nonvar(_)). 473safe_primitive(system:attvar(_)). 474safe_primitive(integer(_)). 475safe_primitive(float(_)). 476safe_primitive(system:rational(_)). 477safe_primitive(number(_)). 478safe_primitive(atom(_)). 479safe_primitive(system:blob(_,_)). 480safe_primitive(system:string(_)). 481safe_primitive(atomic(_)). 482safe_primitive(compound(_)). 483safe_primitive(callable(_)). 484safe_primitive(ground(_)). 485safe_primitive(system:cyclic_term(_)). 486safe_primitive(acyclic_term(_)). 487safe_primitive(system:is_stream(_)). 488safe_primitive(system:'$is_char'(_)). 489safe_primitive(system:'$is_char_code'(_)). 490safe_primitive(system:'$is_char_list'(_,_)). 491safe_primitive(system:'$is_code_list'(_,_)). 492 % ordering 493safe_primitive(@>(_,_)). 494safe_primitive(@>=(_,_)). 495safe_primitive(==(_,_)). 496safe_primitive(@<(_,_)). 497safe_primitive(@=<(_,_)). 498safe_primitive(compare(_,_,_)). 499safe_primitive(sort(_,_)). 500safe_primitive(keysort(_,_)). 501safe_primitive(system: =@=(_,_)). 502safe_primitive(system:'$btree_find_node'(_,_,_,_)). 503 504 % unification and equivalence 505safe_primitive(=(_,_)). 506safe_primitive(\=(_,_)). 507safe_primitive(system:'?='(_,_)). 508safe_primitive(system:unifiable(_,_,_)). 509safe_primitive(unify_with_occurs_check(_,_)). 510safe_primitive(\==(_,_)). 511 % arithmetic 512safe_primitive(is(_,_)). 513safe_primitive(>(_,_)). 514safe_primitive(>=(_,_)). 515safe_primitive(=:=(_,_)). 516safe_primitive(=\=(_,_)). 517safe_primitive(=<(_,_)). 518safe_primitive(<(_,_)). 519 % term-handling 520safe_primitive(arg(_,_,_)). 521safe_primitive(system:setarg(_,_,_)). 522safe_primitive(system:nb_setarg(_,_,_)). 523safe_primitive(system:nb_linkarg(_,_,_)). 524safe_primitive(functor(_,_,_)). 525safe_primitive(_ =.. _). 526safe_primitive(system:compound_name_arity(_,_,_)). 527safe_primitive(system:compound_name_arguments(_,_,_)). 528safe_primitive(system:'$filled_array'(_,_,_,_)). 529safe_primitive(copy_term(_,_)). 530safe_primitive(system:duplicate_term(_,_)). 531safe_primitive(system:copy_term_nat(_,_)). 532safe_primitive(numbervars(_,_,_)). 533safe_primitive(subsumes_term(_,_)). 534safe_primitive(system:term_hash(_,_)). 535safe_primitive(system:term_hash(_,_,_,_)). 536safe_primitive(system:variant_sha1(_,_)). 537safe_primitive(system:variant_hash(_,_)). 538safe_primitive(system:'$term_size'(_,_,_)). 539 540 % dicts 541safe_primitive(system:is_dict(_)). 542safe_primitive(system:is_dict(_,_)). 543safe_primitive(system:get_dict(_,_,_)). 544safe_primitive(system:get_dict(_,_,_,_,_)). 545safe_primitive(system:'$get_dict_ex'(_,_,_)). 546safe_primitive(system:dict_create(_,_,_)). 547safe_primitive(system:dict_pairs(_,_,_)). 548safe_primitive(system:put_dict(_,_,_)). 549safe_primitive(system:put_dict(_,_,_,_)). 550safe_primitive(system:del_dict(_,_,_,_)). 551safe_primitive(system:select_dict(_,_,_)). 552safe_primitive(system:b_set_dict(_,_,_)). 553safe_primitive(system:nb_set_dict(_,_,_)). 554safe_primitive(system:nb_link_dict(_,_,_)). 555safe_primitive(system:(:<(_,_))). 556safe_primitive(system:(>:<(_,_))). 557 % atoms 558safe_primitive(atom_chars(_, _)). 559safe_primitive(atom_codes(_, _)). 560safe_primitive(sub_atom(_,_,_,_,_)). 561safe_primitive(atom_concat(_,_,_)). 562safe_primitive(atom_length(_,_)). 563safe_primitive(char_code(_,_)). 564safe_primitive(system:name(_,_)). 565safe_primitive(system:atomic_concat(_,_,_)). 566safe_primitive(system:atomic_list_concat(_,_)). 567safe_primitive(system:atomic_list_concat(_,_,_)). 568safe_primitive(system:downcase_atom(_,_)). 569safe_primitive(system:upcase_atom(_,_)). 570safe_primitive(system:char_type(_,_)). 571safe_primitive(system:normalize_space(_,_)). 572safe_primitive(system:sub_atom_icasechk(_,_,_)). 573 % numbers 574safe_primitive(number_codes(_,_)). 575safe_primitive(number_chars(_,_)). 576safe_primitive(system:atom_number(_,_)). 577safe_primitive(system:code_type(_,_)). 578 % strings 579safe_primitive(system:atom_string(_,_)). 580safe_primitive(system:number_string(_,_)). 581safe_primitive(system:string_chars(_, _)). 582safe_primitive(system:string_codes(_, _)). 583safe_primitive(system:string_code(_,_,_)). 584safe_primitive(system:sub_string(_,_,_,_,_)). 585safe_primitive(system:split_string(_,_,_,_)). 586safe_primitive(system:atomics_to_string(_,_,_)). 587safe_primitive(system:atomics_to_string(_,_)). 588safe_primitive(system:string_concat(_,_,_)). 589safe_primitive(system:string_length(_,_)). 590safe_primitive(system:string_lower(_,_)). 591safe_primitive(system:string_upper(_,_)). 592safe_primitive(system:term_string(_,_)). 593safe_primitive('$syspreds':term_string(_,_,_)). 594 % Lists 595safe_primitive(length(_,_)). 596 % exceptions 597safe_primitive(throw(_)). 598safe_primitive(system:abort). 599 % misc 600safe_primitive(current_prolog_flag(_,_)). 601safe_primitive(current_op(_,_,_)). 602safe_primitive(system:sleep(_)). 603safe_primitive(system:thread_self(_)). 604safe_primitive(system:get_time(_)). 605safe_primitive(system:statistics(_,_)). 606safe_primitive(system:thread_statistics(Id,_,_)) :- 607 ( var(Id) 608 -> instantiation_error(Id) 609 ; thread_self(Id) 610 ). 611safe_primitive(system:thread_property(Id,_)) :- 612 ( var(Id) 613 -> instantiation_error(Id) 614 ; thread_self(Id) 615 ). 616safe_primitive(system:format_time(_,_,_)). 617safe_primitive(system:format_time(_,_,_,_)). 618safe_primitive(system:date_time_stamp(_,_)). 619safe_primitive(system:stamp_date_time(_,_,_)). 620safe_primitive(system:strip_module(_,_,_)). 621safe_primitive('$messages':message_to_string(_,_)). 622safe_primitive(system:import_module(_,_)). 623safe_primitive(system:file_base_name(_,_)). 624safe_primitive(system:file_directory_name(_,_)). 625safe_primitive(system:file_name_extension(_,_,_)). 626 627safe_primitive(clause(H,_)) :- safe_clause(H). 628safe_primitive(asserta(X)) :- safe_assert(X). 629safe_primitive(assertz(X)) :- safe_assert(X). 630safe_primitive(retract(X)) :- safe_assert(X). 631safe_primitive(retractall(X)) :- safe_assert(X). 632 633% We need to do data flow analysis to find the tag of the 634% target key before we can conclude that functions on dicts 635% are safe. 636safe_primitive('$dicts':'.'(_,K,_)) :- atom(K). 637safe_primitive('$dicts':'.'(_,K,_)) :- 638 ( nonvar(K) 639 -> dict_built_in(K) 640 ; instantiation_error(K) 641 ). 642 643dict_built_in(get(_)). 644dict_built_in(put(_)). 645dict_built_in(put(_,_)). 646 647% The non-ISO system predicates. These can be redefined, so we must 648% be careful to ensure the system ones are used. 649 650safe_primitive(system:false). 651safe_primitive(system:cyclic_term(_)). 652safe_primitive(system:msort(_,_)). 653safe_primitive(system:sort(_,_,_,_)). 654safe_primitive(system:between(_,_,_)). 655safe_primitive(system:succ(_,_)). 656safe_primitive(system:plus(_,_,_)). 657safe_primitive(system:term_variables(_,_)). 658safe_primitive(system:term_variables(_,_,_)). 659safe_primitive(system:'$term_size'(_,_,_)). 660safe_primitive(system:atom_to_term(_,_,_)). 661safe_primitive(system:term_to_atom(_,_)). 662safe_primitive(system:atomic_list_concat(_,_,_)). 663safe_primitive(system:atomic_list_concat(_,_)). 664safe_primitive(system:downcase_atom(_,_)). 665safe_primitive(system:upcase_atom(_,_)). 666safe_primitive(system:is_list(_)). 667safe_primitive(system:memberchk(_,_)). 668safe_primitive(system:'$skip_list'(_,_,_)). 669 % attributes 670safe_primitive(system:get_attr(_,_,_)). 671safe_primitive(system:get_attrs(_,_)). 672safe_primitive(system:term_attvars(_,_)). 673safe_primitive(system:del_attr(_,_)). 674safe_primitive(system:del_attrs(_)). 675safe_primitive('$attvar':copy_term(_,_,_)). 676 % globals 677safe_primitive(system:b_getval(_,_)). 678safe_primitive(system:b_setval(Var,_)) :- 679 safe_global_var(Var). 680safe_primitive(system:nb_getval(_,_)). 681safe_primitive('$syspreds':nb_setval(Var,_)) :- 682 safe_global_var(Var). 683safe_primitive(system:nb_current(_,_)). 684 % database 685safe_primitive(system:assert(X)) :- 686 safe_assert(X). 687 % Output 688safe_primitive(system:writeln(_)). 689safe_primitive('$messages':print_message(_,_)). 690 691 % Stack limits (down) 692safe_primitive('$syspreds':set_prolog_stack(Stack, limit(ByteExpr))) :- 693 nonvar(Stack), 694 stack_name(Stack), 695 catch(Bytes is ByteExpr, _, fail), 696 prolog_stack_property(Stack, limit(Current)), 697 Bytes =< Current. 698 699stack_name(global). 700stack_name(local). 701stack_name(trail). 702 703 704% use_module/1. We only allow for .pl files that are loaded from 705% relative paths that do not contain /../ 706 707safe_primitive(system:use_module(Spec, _Import)) :- 708 safe_primitive(system:use_module(Spec)). 709safe_primitive(system:use_module(Spec)) :- 710 ground(Spec), 711 ( atom(Spec) 712 -> Path = Spec 713 ; Spec =.. [_Alias, Segments], 714 phrase(segments_to_path(Segments), List), 715 atomic_list_concat(List, Path) 716 ), 717 \+ is_absolute_file_name(Path), 718 \+ sub_atom(Path, _, _, _, '/../'), 719 absolute_file_name(Spec, AbsFile, 720 [ access(read), 721 file_type(prolog), 722 file_errors(fail) 723 ]), 724 file_name_extension(_, Ext, AbsFile), 725 save_extension(Ext). 726 727% support predicates for safe_primitive, validating the safety of 728% arguments to certain goals. 729 730segments_to_path(A/B) --> 731 !, 732 segments_to_path(A), 733 [/], 734 segments_to_path(B). 735segments_to_path(X) --> 736 [X]. 737 738save_extension(pl).
assert(Term) is safe, which means it asserts in the
current module. Cross-module asserts are considered unsafe. We
only allow for adding facts. In theory, we could also allow for
rules if we prove the safety of the body.747safe_assert(C) :- cyclic_term(C), !, fail. 748safe_assert(X) :- var(X), !, fail. 749safe_assert(_Head:-_Body) :- !, fail. 750safe_assert(_:_) :- !, fail. 751safe_assert(_).
759safe_clause(H) :- var(H), !. 760safe_clause(_:_) :- !, fail. 761safe_clause(_).
769safe_global_var(Name) :- 770 var(Name), 771 !, 772 instantiation_error(Name). 773safe_global_var(Name) :- 774 safe_global_variable(Name).
786safe_meta(system:put_attr(V,M,A), Called) :- 787 !, 788 ( atom(M) 789 -> attr_hook_predicates([ attr_unify_hook(A, _), 790 attribute_goals(V,_,_), 791 project_attributes(_,_) 792 ], M, Called) 793 ; instantiation_error(M) 794 ). 795safe_meta(system:with_output_to(Output, G), [G]) :- 796 safe_output(Output), 797 !. 798safe_meta(system:format(Format, Args), Calls) :- 799 format_calls(Format, Args, Calls). 800safe_meta(system:format(Output, Format, Args), Calls) :- 801 safe_output(Output), 802 format_calls(Format, Args, Calls). 803safe_meta(prolog_debug:debug(_Term, Format, Args), Calls) :- 804 format_calls(Format, Args, Calls). 805safe_meta('$attvar':freeze(_Var,Goal), [Goal]). 806safe_meta(phrase(NT,Xs0,Xs), [Goal]) :- % phrase/2,3 and call_dcg/2,3 807 expand_nt(NT,Xs0,Xs,Goal). 808safe_meta(phrase(NT,Xs0), [Goal]) :- 809 expand_nt(NT,Xs0,[],Goal). 810safe_meta('$dcg':call_dcg(NT,Xs0,Xs), [Goal]) :- 811 expand_nt(NT,Xs0,Xs,Goal). 812safe_meta('$dcg':call_dcg(NT,Xs0), [Goal]) :- 813 expand_nt(NT,Xs0,[],Goal).
823attr_hook_predicates([], _, []). 824attr_hook_predicates([H|T], M, Called) :- 825 ( predicate_property(M:H, defined) 826 -> Called = [M:H|Rest] 827 ; Called = Rest 828 ), 829 attr_hook_predicates(T, M, Rest).
837expand_nt(NT, _Xs0, _Xs, _NewGoal) :- 838 strip_module(NT, _, Plain), 839 var(Plain), 840 !, 841 instantiation_error(Plain). 842expand_nt(NT, Xs0, Xs, NewGoal) :- 843 dcg_translate_rule((pseudo_nt --> NT), 844 (pseudo_nt(Xs0c,Xsc) :- NewGoal0)), 845 ( var(Xsc), Xsc \== Xs0c 846 -> Xs = Xsc, NewGoal1 = NewGoal0 847 ; NewGoal1 = (NewGoal0, Xsc = Xs) 848 ), 849 ( var(Xs0c) 850 -> Xs0 = Xs0c, 851 NewGoal = NewGoal1 852 ; NewGoal = ( Xs0 = Xs0c, NewGoal1 ) 853 ).
860safe_meta_call(Goal, _, _Called) :- 861 debug(sandbox(meta), 'Safe meta ~p?', [Goal]), 862 fail. 863safe_meta_call(Goal, Context, Called) :- 864 ( safe_meta(Goal, Called) 865 -> true 866 ; safe_meta(Goal, Context, Called) 867 ), 868 !. % call hook 869safe_meta_call(Goal, _, Called) :- 870 Goal = M:Plain, 871 compound(Plain), 872 compound_name_arity(Plain, Name, Arity), 873 safe_meta_predicate(M:Name/Arity), 874 predicate_property(Goal, meta_predicate(Spec)), 875 !, 876 findall(C, called(Spec, Plain, C), Called). 877safe_meta_call(M:Goal, _, Called) :- 878 !, 879 generic_goal(Goal, Gen), 880 safe_meta(M:Gen), 881 findall(C, called(Gen, Goal, C), Called). 882safe_meta_call(Goal, _, Called) :- 883 generic_goal(Goal, Gen), 884 safe_meta(Gen), 885 findall(C, called(Gen, Goal, C), Called). 886 887called(Gen, Goal, Called) :- 888 arg(I, Gen, Spec), 889 calling_meta_spec(Spec), 890 arg(I, Goal, Called0), 891 extend(Spec, Called0, Called). 892 893generic_goal(G, Gen) :- 894 functor(G, Name, Arity), 895 functor(Gen, Name, Arity). 896 897calling_meta_spec(V) :- var(V), !, fail. 898calling_meta_spec(I) :- integer(I), !. 899calling_meta_spec(^). 900calling_meta_spec(//). 901 902 903extend(^, G, Plain) :- 904 !, 905 strip_existential(G, Plain). 906extend(//, DCG, Goal) :- 907 !, 908 ( expand_phrase(call_dcg(DCG,_,_), Goal) 909 -> true 910 ; instantiation_error(DCG) % Ask more instantiation. 911 ). % might not help, but does not harm. 912extend(0, G, G) :- !. 913extend(I, M:G0, M:G) :- 914 !, 915 G0 =.. List, 916 length(Extra, I), 917 append(List, Extra, All), 918 G =.. All. 919extend(I, G0, G) :- 920 G0 =.. List, 921 length(Extra, I), 922 append(List, Extra, All), 923 G =.. All. 924 925strip_existential(Var, Var) :- 926 var(Var), 927 !. 928strip_existential(M:G0, M:G) :- 929 !, 930 strip_existential(G0, G). 931strip_existential(_^G0, G) :- 932 !, 933 strip_existential(G0, G). 934strip_existential(G, G).
938safe_meta((0,0)). 939safe_meta((0;0)). 940safe_meta((0->0)). 941safe_meta(system:(0*->0)). 942safe_meta(catch(0,*,0)). 943safe_meta(findall(*,0,*)). 944safe_meta('$bags':findall(*,0,*,*)). 945safe_meta(setof(*,^,*)). 946safe_meta(bagof(*,^,*)). 947safe_meta('$bags':findnsols(*,*,0,*)). 948safe_meta('$bags':findnsols(*,*,0,*,*)). 949safe_meta(system:call_cleanup(0,0)). 950safe_meta(system:setup_call_cleanup(0,0,0)). 951safe_meta(system:setup_call_catcher_cleanup(0,0,*,0)). 952safe_meta('$attvar':call_residue_vars(0,*)). 953safe_meta('$syspreds':call_with_inference_limit(0,*,*)). 954safe_meta('$syspreds':call_with_depth_limit(0,*,*)). 955safe_meta(^(*,0)). 956safe_meta(\+(0)). 957safe_meta(call(0)). 958safe_meta(call(1,*)). 959safe_meta(call(2,*,*)). 960safe_meta(call(3,*,*,*)). 961safe_meta(call(4,*,*,*,*)). 962safe_meta(call(5,*,*,*,*,*)). 963safe_meta(call(6,*,*,*,*,*,*)).
971safe_output(Output) :- 972 var(Output), 973 !, 974 instantiation_error(Output). 975safe_output(atom(_)). 976safe_output(string(_)). 977safe_output(codes(_)). 978safe_output(codes(_,_)). 979safe_output(chars(_)). 980safe_output(chars(_,_)). 981safe_output(current_output). 982safe_output(current_error).
988:- public format_calls/3. % used in pengines_io 989 990format_calls(Format, _Args, _Calls) :- 991 var(Format), 992 !, 993 instantiation_error(Format). 994format_calls(Format, Args, Calls) :- 995 format_types(Format, Types), 996 ( format_callables(Types, Args, Calls) 997 -> true 998 ; throw(error(format_error(Format, Types, Args), _)) 999 ). 1000 1001format_callables([], [], []). 1002format_callables([callable|TT], [G|TA], [G|TG]) :- 1003 !, 1004 format_callables(TT, TA, TG). 1005format_callables([_|TT], [_|TA], TG) :- 1006 !, 1007 format_callables(TT, TA, TG). 1008 1009 1010 /******************************* 1011 * SAFE COMPILATION HOOKS * 1012 *******************************/ 1013 1014:- multifile 1015 prolog:sandbox_allowed_directive/1, 1016 prolog:sandbox_allowed_goal/1, 1017 prolog:sandbox_allowed_expansion/1.
1023prologsandbox_allowed_directive(Directive) :- 1024 debug(sandbox(directive), 'Directive: ~p', [Directive]), 1025 fail. 1026prologsandbox_allowed_directive(Directive) :- 1027 safe_directive(Directive), 1028 !. 1029prologsandbox_allowed_directive(M:PredAttr) :- 1030 \+ prolog_load_context(module, M), 1031 !, 1032 debug(sandbox(directive), 'Cross-module directive', []), 1033 permission_error(execute, sandboxed_directive, (:- M:PredAttr)). 1034prologsandbox_allowed_directive(M:PredAttr) :- 1035 safe_pattr(PredAttr), 1036 !, 1037 PredAttr =.. [Attr, Preds], 1038 ( safe_pattr(Preds, Attr) 1039 -> true 1040 ; permission_error(execute, sandboxed_directive, (:- M:PredAttr)) 1041 ). 1042prologsandbox_allowed_directive(_:Directive) :- 1043 safe_source_directive(Directive), 1044 !. 1045prologsandbox_allowed_directive(_:Directive) :- 1046 directive_loads_file(Directive, File), 1047 !, 1048 safe_path(File). 1049prologsandbox_allowed_directive(G) :- 1050 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),
...
1068safe_pattr(dynamic(_)). 1069safe_pattr(thread_local(_)). 1070safe_pattr(volatile(_)). 1071safe_pattr(discontiguous(_)). 1072safe_pattr(multifile(_)). 1073safe_pattr(public(_)). 1074safe_pattr(meta_predicate(_)). 1075 1076safe_pattr(Var, _) :- 1077 var(Var), 1078 !, 1079 instantiation_error(Var). 1080safe_pattr((A,B), Attr) :- 1081 !, 1082 safe_pattr(A, Attr), 1083 safe_pattr(B, Attr). 1084safe_pattr(M:G, Attr) :- 1085 !, 1086 ( atom(M), 1087 prolog_load_context(module, M) 1088 -> true 1089 ; Goal =.. [Attr,M:G], 1090 permission_error(directive, sandboxed, (:- Goal)) 1091 ). 1092safe_pattr(_, _). 1093 1094safe_source_directive(op(_,_,Name)) :- 1095 !, 1096 ( atom(Name) 1097 -> true 1098 ; is_list(Name), 1099 maplist(atom, Name) 1100 ). 1101safe_source_directive(set_prolog_flag(Flag, Value)) :- 1102 !, 1103 atom(Flag), ground(Value), 1104 safe_directive_flag(Flag, Value). 1105safe_source_directive(style_check(_)). 1106safe_source_directive(initialization(_)). % Checked at runtime 1107safe_source_directive(initialization(_,_)). % Checked at runtime 1108 1109directive_loads_file(use_module(library(X)), X). 1110directive_loads_file(use_module(library(X), _Imports), X). 1111directive_loads_file(ensure_loaded(library(X)), X). 1112directive_loads_file(include(X), X). 1113 1114safe_path(X) :- 1115 var(X), 1116 !, 1117 instantiation_error(X). 1118safe_path(X) :- 1119 ( atom(X) 1120 ; string(X) 1121 ), 1122 !, 1123 \+ sub_atom(X, 0, _, 0, '..'), 1124 \+ sub_atom(X, 0, _, _, '/'), 1125 \+ sub_atom(X, 0, _, _, '../'), 1126 \+ sub_atom(X, _, _, 0, '/..'), 1127 \+ sub_atom(X, _, _, _, '/../'). 1128safe_path(A/B) :- 1129 !, 1130 safe_path(A), 1131 safe_path(B).
1143safe_directive_flag(generate_debug_info, _). 1144safe_directive_flag(var_prefix, _). 1145safe_directive_flag(double_quotes, _). 1146safe_directive_flag(back_quotes, _).
Our assumption is that external expansion rules are coded safely and we only need to be careful if the sandboxed code defines expansion rules.
1161prologsandbox_allowed_expansion(Directive) :- 1162 prolog_load_context(module, M), 1163 debug(sandbox(expansion), 'Expand in ~p: ~p', [M, Directive]), 1164 fail. 1165prologsandbox_allowed_expansion(M:G) :- 1166 prolog_load_context(module, M), 1167 !, 1168 safe_goal(M:G). 1169prologsandbox_allowed_expansion(_,_).
1175prologsandbox_allowed_goal(G) :- 1176 safe_goal(G). 1177 1178 1179 /******************************* 1180 * MESSAGES * 1181 *******************************/ 1182 1183:- multifile 1184 prolog:message//1, 1185 prolog:message_context//1, 1186 prolog:error_message//1. 1187 1188prologmessage_context(sandbox(_G, [])) --> !. 1189prologmessage_context(sandbox(_G, Parents)) --> 1190 [ nl, 'Reachable from:'-[] ], 1191 callers(Parents, 10). 1192 1193callers([], _) --> !. 1194callers(_, 0) --> !. 1195callers([G|Parents], Level) --> 1196 { NextLevel is Level-1 1197 }, 1198 [ nl, '\t ~p'-[G] ], 1199 callers(Parents, NextLevel). 1200 1201prologmessage(bad_safe_declaration(Goal, File, Line)) --> 1202 [ '~w:~d: Invalid safe_primitive/1 declaration: ~p'- 1203 [File, Line, Goal] ]. 1204 1205prologerror_message(format_error(Format, Types, Args)) --> 1206 format_error(Format, Types, Args). 1207 1208format_error(Format, Types, Args) --> 1209 { length(Types, TypeLen), 1210 length(Args, ArgsLen), 1211 ( TypeLen > ArgsLen 1212 -> Problem = 'not enough' 1213 ; Problem = 'too many' 1214 ) 1215 }, 1216 [ 'format(~q): ~w arguments (found ~w, need ~w)'- 1217 [Format, Problem, ArgsLen, TypeLen] 1218 ]
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.