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 known_module(M:G, Parents), 145 ( predicate_property(M:G, imported_from(M2)) 146 -> true 147 ; M2 = M 148 ), 149 ( ( safe_primitive(M2:G) 150 ; safe_primitive(G), 151 predicate_property(G, iso) 152 ) 153 -> Safe = Safe0 154 ; ( predicate_property(M:G, exported) 155 ; predicate_property(M:G, public) 156 ; predicate_property(M:G, multifile) 157 ; predicate_property(M:G, iso) 158 ; memberchk(M:_, Parents) 159 ) 160 -> safe(G, M, Parents, Safe0, Safe) 161 ; throw(error(permission_error(call, sandboxed, M:G), 162 sandbox(M:G, Parents))) 163 ). 164safe(G, _, Parents, _, _) :- 165 debugging(sandbox(show)), 166 length(Parents, Level), 167 debug(sandbox(show), '[~D] SAFE ~q?', [Level, G]), 168 fail. 169safe(G, _, Parents, Safe, Safe) :- 170 catch(safe_primitive(G), 171 error(instantiation_error, _), 172 rethrow_instantition_error([G|Parents])), 173 predicate_property(G, iso), 174 !. 175safe(G, M, Parents, Safe, Safe) :- 176 known_module(M:G, Parents), 177 ( predicate_property(M:G, imported_from(M2)) 178 -> true 179 ; M2 = M 180 ), 181 ( catch(safe_primitive(M2:G), 182 error(instantiation_error, _), 183 rethrow_instantition_error([M2:G|Parents])) 184 ; predicate_property(M2:G, number_of_rules(0)) 185 ), 186 !. 187safe(G, M, Parents, Safe0, Safe) :- 188 predicate_property(G, iso), 189 safe_meta_call(G, M, Called), 190 !, 191 safe_list(Called, M, Parents, Safe0, Safe). 192safe(G, M, Parents, Safe0, Safe) :- 193 ( predicate_property(M:G, imported_from(M2)) 194 -> true 195 ; M2 = M 196 ), 197 safe_meta_call(M2:G, M, Called), 198 !, 199 safe_list(Called, M, Parents, Safe0, Safe). 200safe(G, M, Parents, Safe0, Safe) :- 201 goal_id(M:G, Id, Gen), 202 ( get_assoc(Id, Safe0, _) 203 -> Safe = Safe0 204 ; put_assoc(Id, Safe0, true, Safe1), 205 ( Gen == M:G 206 -> safe_clauses(Gen, M, [Id|Parents], Safe1, Safe) 207 ; catch(safe_clauses(Gen, M, [Id|Parents], Safe1, Safe), 208 error(instantiation_error, Ctx), 209 unsafe(Parents, Ctx)) 210 ) 211 ), 212 !. 213safe(G, M, Parents, _, _) :- 214 debug(sandbox(fail), 215 'safe/1 failed for ~p (parents:~p)', [M:G, Parents]), 216 fail. 217 218unsafe(Parents, Var) :- 219 var(Var), 220 !, 221 nb_setval(sandbox_last_error, 222 error(instantiation_error, sandbox(_, Parents))), 223 fail. 224unsafe(_Parents, Ctx) :- 225 Ctx = sandbox(_,_), 226 nb_setval(sandbox_last_error, 227 error(instantiation_error, Ctx)), 228 fail. 229 230rethrow_instantition_error(Parents) :- 231 throw(error(instantiation_error, sandbox(_, Parents))). 232 233safe_clauses(G, M, Parents, Safe0, Safe) :- 234 predicate_property(M:G, interpreted), 235 def_module(M:G, MD:QG), 236 \+ compiled(MD:QG), 237 !, 238 findall(Ref-Body, clause(MD:, Body, Ref), Bodies), 239 safe_bodies(Bodies, MD, Parents, Safe0, Safe). 240safe_clauses(G, M, [_|Parents], _, _) :- 241 predicate_property(M:G, visible), 242 !, 243 throw(error(permission_error(call, sandboxed, G), 244 sandbox(M:G, Parents))). 245safe_clauses(_, _, [G|Parents], _, _) :- 246 throw(error(existence_error(procedure, G), 247 sandbox(G, Parents))). 248 249compiled(system:(@(_,_))). 250 251known_module(M:_, _) :- 252 current_module(M), 253 !. 254known_module(M:G, Parents) :- 255 throw(error(permission_error(call, sandboxed, M:G), 256 sandbox(M:G, Parents))).
265safe_bodies([], _, _, Safe, Safe). 266safe_bodies([Ref-H|T], M, Parents, Safe0, Safe) :- 267 ( H = M2:H2, nonvar(M2), 268 clause_property(Ref, module(M2)) 269 -> copy_term(H2, H3), 270 CM = M2 271 ; copy_term(H, H3), 272 CM = M 273 ), 274 safe(H3, CM, Parents, Safe0, Safe1), 275 safe_bodies(T, M, Parents, Safe1, Safe). 276 277def_module(M:G, MD:QG) :- 278 predicate_property(M:G, imported_from(MD)), 279 !, 280 meta_qualify(MD:G, M, QG). 281def_module(M:G, M:QG) :- 282 meta_qualify(M:G, M, QG).
290safe_list([], _, _, Safe, Safe). 291safe_list([H|T], M, Parents, Safe0, Safe) :- 292 ( H = M2:H2, 293 M == M2 % in our context 294 -> copy_term(H2, H3) 295 ; copy_term(H, H3) % cross-module call 296 ), 297 safe(H3, M, Parents, Safe0, Safe1), 298 safe_list(T, M, Parents, Safe1, Safe).
304meta_qualify(MD:G, M, QG) :- 305 predicate_property(MD:G, meta_predicate(Head)), 306 !, 307 G =.. [Name|Args], 308 Head =.. [_|Q], 309 qualify_args(Q, M, Args, QArgs), 310 QG =.. [Name|QArgs]. 311meta_qualify(_:G, _, G). 312 313qualify_args([], _, [], []). 314qualify_args([H|T], M, [A|AT], [Q|QT]) :- 315 qualify_arg(H, M, A, Q), 316 qualify_args(T, M, AT, QT). 317 318qualify_arg(S, M, A, Q) :- 319 q_arg(S), 320 !, 321 qualify(A, M, Q). 322qualify_arg(_, _, A, A). 323 324q_arg(I) :- integer(I), !. 325q_arg(:). 326q_arg(^). 327q_arg(//). 328 329qualify(A, M, MZ:Q) :- 330 strip_module(M:A, MZ, Q).
342goal_id(M:Goal, M:Id, Gen) :- 343 !, 344 goal_id(Goal, Id, Gen). 345goal_id(Var, _, _) :- 346 var(Var), 347 !, 348 instantiation_error(Var). 349goal_id(Atom, Atom, Atom) :- 350 atom(Atom), 351 !. 352goal_id(Term, _, _) :- 353 \+ compound(Term), 354 !, 355 type_error(callable, Term). 356goal_id(Term, Skolem, Gen) :- % most general form 357 compound_name_arity(Term, Name, Arity), 358 compound_name_arity(Skolem, Name, Arity), 359 compound_name_arity(Gen, Name, Arity), 360 copy_goal_args(1, Term, Skolem, Gen), 361 ( Gen =@= Term 362 -> ! % No more specific one; we can commit 363 ; true 364 ), 365 numbervars(Skolem, 0, _). 366goal_id(Term, Skolem, Term) :- % most specific form 367 debug(sandbox(specify), 'Retrying with ~p', [Term]), 368 copy_term(Term, Skolem), 369 numbervars(Skolem, 0, _).
376copy_goal_args(I, Term, Skolem, Gen) :- 377 arg(I, Term, TA), 378 !, 379 arg(I, Skolem, SA), 380 arg(I, Gen, GA), 381 copy_goal_arg(TA, SA, GA), 382 I2 is I + 1, 383 copy_goal_args(I2, Term, Skolem, Gen). 384copy_goal_args(_, _, _, _). 385 386copy_goal_arg(Arg, SArg, Arg) :- 387 copy_goal_arg(Arg), 388 !, 389 copy_term(Arg, SArg). 390copy_goal_arg(_, _, _). 391 392copy_goal_arg(Var) :- var(Var), !, fail. 393copy_goal_arg(_:_).
405term_expansion(safe_primitive(Goal), Term) :- 406 ( verify_safe_declaration(Goal) 407 -> Term = safe_primitive(Goal) 408 ; Term = [] 409 ). 410 411systemterm_expansion(sandbox:safe_primitive(Goal), Term) :- 412 \+ current_prolog_flag(xref, true), 413 ( verify_safe_declaration(Goal) 414 -> Term = sandbox:safe_primitive(Goal) 415 ; Term = [] 416 ). 417 418verify_safe_declaration(Var) :- 419 var(Var), 420 !, 421 instantiation_error(Var). 422verify_safe_declaration(Module:Goal) :- 423 must_be(atom, Module), 424 must_be(callable, Goal), 425 ( ok_meta(Module:Goal) 426 -> true 427 ; ( predicate_property(Module:Goal, visible) 428 -> true 429 ; predicate_property(Module:Goal, foreign) 430 ), 431 \+ predicate_property(Module:Goal, imported_from(_)), 432 \+ predicate_property(Module:Goal, meta_predicate(_)) 433 -> true 434 ; permission_error(declare, safe_goal, Module:Goal) 435 ). 436verify_safe_declaration(Goal) :- 437 must_be(callable, Goal), 438 ( predicate_property(system:Goal, iso), 439 \+ predicate_property(system:Goal, meta_predicate()) 440 -> true 441 ; permission_error(declare, safe_goal, Goal) 442 ). 443 444ok_meta(system:assert(_)). 445ok_meta(system:use_module(_,_)). 446ok_meta(system:use_module(_)). 447 448verify_predefined_safe_declarations :- 449 forall(clause(safe_primitive(Goal), _Body, Ref), 450 ( catch(verify_safe_declaration(Goal), E, true), 451 ( nonvar(E) 452 -> clause_property(Ref, file(File)), 453 clause_property(Ref, line_count(Line)), 454 print_message(error, bad_safe_declaration(Goal, File, Line)) 455 ; true 456 ) 457 )). 458 459:- initialization(verify_predefined_safe_declarations, now).
473% First, all ISO system predicates that are considered safe 474 475safe_primitive(true). 476safe_primitive(fail). 477safe_primitive(system:false). 478safe_primitive(repeat). 479safe_primitive(!). 480 % types 481safe_primitive(var(_)). 482safe_primitive(nonvar(_)). 483safe_primitive(system:attvar(_)). 484safe_primitive(integer(_)). 485safe_primitive(float(_)). 486safe_primitive(system:rational(_)). 487safe_primitive(number(_)). 488safe_primitive(atom(_)). 489safe_primitive(system:blob(_,_)). 490safe_primitive(system:string(_)). 491safe_primitive(atomic(_)). 492safe_primitive(compound(_)). 493safe_primitive(callable(_)). 494safe_primitive(ground(_)). 495safe_primitive(system:cyclic_term(_)). 496safe_primitive(acyclic_term(_)). 497safe_primitive(system:is_stream(_)). 498safe_primitive(system:'$is_char'(_)). 499safe_primitive(system:'$is_char_code'(_)). 500safe_primitive(system:'$is_char_list'(_,_)). 501safe_primitive(system:'$is_code_list'(_,_)). 502 % ordering 503safe_primitive(@>(_,_)). 504safe_primitive(@>=(_,_)). 505safe_primitive(==(_,_)). 506safe_primitive(@<(_,_)). 507safe_primitive(@=<(_,_)). 508safe_primitive(compare(_,_,_)). 509safe_primitive(sort(_,_)). 510safe_primitive(keysort(_,_)). 511safe_primitive(system: =@=(_,_)). 512safe_primitive(system:'$btree_find_node'(_,_,_,_)). 513 514 % unification and equivalence 515safe_primitive(=(_,_)). 516safe_primitive(\=(_,_)). 517safe_primitive(system:'?='(_,_)). 518safe_primitive(system:unifiable(_,_,_)). 519safe_primitive(unify_with_occurs_check(_,_)). 520safe_primitive(\==(_,_)). 521 % arithmetic 522safe_primitive(is(_,_)). 523safe_primitive(>(_,_)). 524safe_primitive(>=(_,_)). 525safe_primitive(=:=(_,_)). 526safe_primitive(=\=(_,_)). 527safe_primitive(=<(_,_)). 528safe_primitive(<(_,_)). 529 % term-handling 530safe_primitive(arg(_,_,_)). 531safe_primitive(system:setarg(_,_,_)). 532safe_primitive(system:nb_setarg(_,_,_)). 533safe_primitive(system:nb_linkarg(_,_,_)). 534safe_primitive(functor(_,_,_)). 535safe_primitive(_ =.. _). 536safe_primitive(system:compound_name_arity(_,_,_)). 537safe_primitive(system:compound_name_arguments(_,_,_)). 538safe_primitive(system:'$filled_array'(_,_,_,_)). 539safe_primitive(copy_term(_,_)). 540safe_primitive(system:duplicate_term(_,_)). 541safe_primitive(system:copy_term_nat(_,_)). 542safe_primitive(numbervars(_,_,_)). 543safe_primitive(subsumes_term(_,_)). 544safe_primitive(system:term_hash(_,_)). 545safe_primitive(system:term_hash(_,_,_,_)). 546safe_primitive(system:variant_sha1(_,_)). 547safe_primitive(system:variant_hash(_,_)). 548safe_primitive(system:'$term_size'(_,_,_)). 549 550 % dicts 551safe_primitive(system:is_dict(_)). 552safe_primitive(system:is_dict(_,_)). 553safe_primitive(system:get_dict(_,_,_)). 554safe_primitive(system:get_dict(_,_,_,_,_)). 555safe_primitive(system:'$get_dict_ex'(_,_,_)). 556safe_primitive(system:dict_create(_,_,_)). 557safe_primitive(system:dict_pairs(_,_,_)). 558safe_primitive(system:put_dict(_,_,_)). 559safe_primitive(system:put_dict(_,_,_,_)). 560safe_primitive(system:del_dict(_,_,_,_)). 561safe_primitive(system:select_dict(_,_,_)). 562safe_primitive(system:b_set_dict(_,_,_)). 563safe_primitive(system:nb_set_dict(_,_,_)). 564safe_primitive(system:nb_link_dict(_,_,_)). 565safe_primitive(system:(:<(_,_))). 566safe_primitive(system:(>:<(_,_))). 567 % atoms 568safe_primitive(atom_chars(_, _)). 569safe_primitive(atom_codes(_, _)). 570safe_primitive(sub_atom(_,_,_,_,_)). 571safe_primitive(atom_concat(_,_,_)). 572safe_primitive(atom_length(_,_)). 573safe_primitive(char_code(_,_)). 574safe_primitive(system:name(_,_)). 575safe_primitive(system:atomic_concat(_,_,_)). 576safe_primitive(system:atomic_list_concat(_,_)). 577safe_primitive(system:atomic_list_concat(_,_,_)). 578safe_primitive(system:downcase_atom(_,_)). 579safe_primitive(system:upcase_atom(_,_)). 580safe_primitive(system:char_type(_,_)). 581safe_primitive(system:normalize_space(_,_)). 582safe_primitive(system:sub_atom_icasechk(_,_,_)). 583 % numbers 584safe_primitive(number_codes(_,_)). 585safe_primitive(number_chars(_,_)). 586safe_primitive(system:atom_number(_,_)). 587safe_primitive(system:code_type(_,_)). 588 % strings 589safe_primitive(system:atom_string(_,_)). 590safe_primitive(system:number_string(_,_)). 591safe_primitive(system:string_chars(_, _)). 592safe_primitive(system:string_codes(_, _)). 593safe_primitive(system:string_code(_,_,_)). 594safe_primitive(system:sub_string(_,_,_,_,_)). 595safe_primitive(system:split_string(_,_,_,_)). 596safe_primitive(system:atomics_to_string(_,_,_)). 597safe_primitive(system:atomics_to_string(_,_)). 598safe_primitive(system:string_concat(_,_,_)). 599safe_primitive(system:string_length(_,_)). 600safe_primitive(system:string_lower(_,_)). 601safe_primitive(system:string_upper(_,_)). 602safe_primitive(system:term_string(_,_)). 603safe_primitive('$syspreds':term_string(_,_,_)). 604 % Lists 605safe_primitive(length(_,_)). 606 % exceptions 607safe_primitive(throw(_)). 608safe_primitive(system:abort). 609 % misc 610safe_primitive(current_prolog_flag(_,_)). 611safe_primitive(current_op(_,_,_)). 612safe_primitive(system:sleep(_)). 613safe_primitive(system:thread_self(_)). 614safe_primitive(system:get_time(_)). 615safe_primitive(system:statistics(_,_)). 616safe_primitive(system:thread_statistics(Id,_,_)) :- 617 ( var(Id) 618 -> instantiation_error(Id) 619 ; thread_self(Id) 620 ). 621safe_primitive(system:thread_property(Id,_)) :- 622 ( var(Id) 623 -> instantiation_error(Id) 624 ; thread_self(Id) 625 ). 626safe_primitive(system:format_time(_,_,_)). 627safe_primitive(system:format_time(_,_,_,_)). 628safe_primitive(system:date_time_stamp(_,_)). 629safe_primitive(system:stamp_date_time(_,_,_)). 630safe_primitive(system:strip_module(_,_,_)). 631safe_primitive('$messages':message_to_string(_,_)). 632safe_primitive(system:import_module(_,_)). 633safe_primitive(system:file_base_name(_,_)). 634safe_primitive(system:file_directory_name(_,_)). 635safe_primitive(system:file_name_extension(_,_,_)). 636 637safe_primitive(clause(H,_)) :- safe_clause(H). 638safe_primitive(asserta(X)) :- safe_assert(X). 639safe_primitive(assertz(X)) :- safe_assert(X). 640safe_primitive(retract(X)) :- safe_assert(X). 641safe_primitive(retractall(X)) :- safe_assert(X). 642 643% We need to do data flow analysis to find the tag of the 644% target key before we can conclude that functions on dicts 645% are safe. 646safe_primitive('$dicts':'.'(_,K,_)) :- atom(K). 647safe_primitive('$dicts':'.'(_,K,_)) :- 648 ( nonvar(K) 649 -> dict_built_in(K) 650 ; instantiation_error(K) 651 ). 652 653dict_built_in(get(_)). 654dict_built_in(put(_)). 655dict_built_in(put(_,_)). 656 657% The non-ISO system predicates. These can be redefined, so we must 658% be careful to ensure the system ones are used. 659 660safe_primitive(system:false). 661safe_primitive(system:cyclic_term(_)). 662safe_primitive(system:msort(_,_)). 663safe_primitive(system:sort(_,_,_,_)). 664safe_primitive(system:between(_,_,_)). 665safe_primitive(system:succ(_,_)). 666safe_primitive(system:plus(_,_,_)). 667safe_primitive(system:term_variables(_,_)). 668safe_primitive(system:term_variables(_,_,_)). 669safe_primitive(system:'$term_size'(_,_,_)). 670safe_primitive(system:atom_to_term(_,_,_)). 671safe_primitive(system:term_to_atom(_,_)). 672safe_primitive(system:atomic_list_concat(_,_,_)). 673safe_primitive(system:atomic_list_concat(_,_)). 674safe_primitive(system:downcase_atom(_,_)). 675safe_primitive(system:upcase_atom(_,_)). 676safe_primitive(system:is_list(_)). 677safe_primitive(system:memberchk(_,_)). 678safe_primitive(system:'$skip_list'(_,_,_)). 679 % attributes 680safe_primitive(system:get_attr(_,_,_)). 681safe_primitive(system:get_attrs(_,_)). 682safe_primitive(system:term_attvars(_,_)). 683safe_primitive(system:del_attr(_,_)). 684safe_primitive(system:del_attrs(_)). 685safe_primitive('$attvar':copy_term(_,_,_)). 686 % globals 687safe_primitive(system:b_getval(_,_)). 688safe_primitive(system:b_setval(Var,_)) :- 689 safe_global_var(Var). 690safe_primitive(system:nb_getval(_,_)). 691safe_primitive('$syspreds':nb_setval(Var,_)) :- 692 safe_global_var(Var). 693safe_primitive(system:nb_current(_,_)). 694 % database 695safe_primitive(system:assert(X)) :- 696 safe_assert(X). 697 % Output 698safe_primitive(system:writeln(_)). 699safe_primitive('$messages':print_message(_,_)). 700 701 % Stack limits (down) 702safe_primitive('$syspreds':set_prolog_stack(Stack, limit(ByteExpr))) :- 703 nonvar(Stack), 704 stack_name(Stack), 705 catch(Bytes is ByteExpr, _, fail), 706 prolog_stack_property(Stack, limit(Current)), 707 Bytes =< Current. 708 709stack_name(global). 710stack_name(local). 711stack_name(trail). 712 713 714% use_module/1. We only allow for .pl files that are loaded from 715% relative paths that do not contain /../ 716 717safe_primitive(system:use_module(Spec, _Import)) :- 718 safe_primitive(system:use_module(Spec)). 719safe_primitive(system:use_module(Spec)) :- 720 ground(Spec), 721 ( atom(Spec) 722 -> Path = Spec 723 ; Spec =.. [_Alias, Segments], 724 phrase(segments_to_path(Segments), List), 725 atomic_list_concat(List, Path) 726 ), 727 \+ is_absolute_file_name(Path), 728 \+ sub_atom(Path, _, _, _, '/../'), 729 absolute_file_name(Spec, AbsFile, 730 [ access(read), 731 file_type(prolog), 732 file_errors(fail) 733 ]), 734 file_name_extension(_, Ext, AbsFile), 735 save_extension(Ext). 736 737% support predicates for safe_primitive, validating the safety of 738% arguments to certain goals. 739 740segments_to_path(A/B) --> 741 !, 742 segments_to_path(A), 743 [/], 744 segments_to_path(B). 745segments_to_path(X) --> 746 [X]. 747 748save_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.757safe_assert(C) :- cyclic_term(C), !, fail. 758safe_assert(X) :- var(X), !, fail. 759safe_assert(_Head:-_Body) :- !, fail. 760safe_assert(_:_) :- !, fail. 761safe_assert(_).
769safe_clause(H) :- var(H), !. 770safe_clause(_:_) :- !, fail. 771safe_clause(_).
779safe_global_var(Name) :- 780 var(Name), 781 !, 782 instantiation_error(Name). 783safe_global_var(Name) :- 784 safe_global_variable(Name).
796safe_meta(system:put_attr(V,M,A), Called) :- 797 !, 798 ( atom(M) 799 -> attr_hook_predicates([ attr_unify_hook(A, _), 800 attribute_goals(V,_,_), 801 project_attributes(_,_) 802 ], M, Called) 803 ; instantiation_error(M) 804 ). 805safe_meta(system:with_output_to(Output, G), [G]) :- 806 safe_output(Output), 807 !. 808safe_meta(system:format(Format, Args), Calls) :- 809 format_calls(Format, Args, Calls). 810safe_meta(system:format(Output, Format, Args), Calls) :- 811 safe_output(Output), 812 format_calls(Format, Args, Calls). 813safe_meta(prolog_debug:debug(_Term, Format, Args), Calls) :- 814 format_calls(Format, Args, Calls). 815safe_meta('$attvar':freeze(_Var,Goal), [Goal]). 816safe_meta(phrase(NT,Xs0,Xs), [Goal]) :- % phrase/2,3 and call_dcg/2,3 817 expand_nt(NT,Xs0,Xs,Goal). 818safe_meta(phrase(NT,Xs0), [Goal]) :- 819 expand_nt(NT,Xs0,[],Goal). 820safe_meta('$dcg':call_dcg(NT,Xs0,Xs), [Goal]) :- 821 expand_nt(NT,Xs0,Xs,Goal). 822safe_meta('$dcg':call_dcg(NT,Xs0), [Goal]) :- 823 expand_nt(NT,Xs0,[],Goal).
833attr_hook_predicates([], _, []). 834attr_hook_predicates([H|T], M, Called) :- 835 ( predicate_property(M:H, defined) 836 -> Called = [M:H|Rest] 837 ; Called = Rest 838 ), 839 attr_hook_predicates(T, M, Rest).
847expand_nt(NT, _Xs0, _Xs, _NewGoal) :- 848 strip_module(NT, _, Plain), 849 var(Plain), 850 !, 851 instantiation_error(Plain). 852expand_nt(NT, Xs0, Xs, NewGoal) :- 853 dcg_translate_rule((pseudo_nt --> NT), 854 (pseudo_nt(Xs0c,Xsc) :- NewGoal0)), 855 ( var(Xsc), Xsc \== Xs0c 856 -> Xs = Xsc, NewGoal1 = NewGoal0 857 ; NewGoal1 = (NewGoal0, Xsc = Xs) 858 ), 859 ( var(Xs0c) 860 -> Xs0 = Xs0c, 861 NewGoal = NewGoal1 862 ; NewGoal = ( Xs0 = Xs0c, NewGoal1 ) 863 ).
870safe_meta_call(Goal, _, _Called) :- 871 debug(sandbox(meta), 'Safe meta ~p?', [Goal]), 872 fail. 873safe_meta_call(Goal, Context, Called) :- 874 ( safe_meta(Goal, Called) 875 -> true 876 ; safe_meta(Goal, Context, Called) 877 ), 878 !. % call hook 879safe_meta_call(Goal, _, Called) :- 880 Goal = M:Plain, 881 compound(Plain), 882 compound_name_arity(Plain, Name, Arity), 883 safe_meta_predicate(M:Name/Arity), 884 predicate_property(Goal, meta_predicate(Spec)), 885 !, 886 findall(C, called(Spec, Plain, C), Called). 887safe_meta_call(M:Goal, _, Called) :- 888 !, 889 generic_goal(Goal, Gen), 890 safe_meta(M:Gen), 891 findall(C, called(Gen, Goal, C), Called). 892safe_meta_call(Goal, _, Called) :- 893 generic_goal(Goal, Gen), 894 safe_meta(Gen), 895 findall(C, called(Gen, Goal, C), Called). 896 897called(Gen, Goal, Called) :- 898 arg(I, Gen, Spec), 899 calling_meta_spec(Spec), 900 arg(I, Goal, Called0), 901 extend(Spec, Called0, Called). 902 903generic_goal(G, Gen) :- 904 functor(G, Name, Arity), 905 functor(Gen, Name, Arity). 906 907calling_meta_spec(V) :- var(V), !, fail. 908calling_meta_spec(I) :- integer(I), !. 909calling_meta_spec(^). 910calling_meta_spec(//). 911 912 913extend(^, G, Plain) :- 914 !, 915 strip_existential(G, Plain). 916extend(//, DCG, Goal) :- 917 !, 918 ( expand_phrase(call_dcg(DCG,_,_), Goal) 919 -> true 920 ; instantiation_error(DCG) % Ask more instantiation. 921 ). % might not help, but does not harm. 922extend(0, G, G) :- !. 923extend(I, M:G0, M:G) :- 924 !, 925 G0 =.. List, 926 length(Extra, I), 927 append(List, Extra, All), 928 G =.. All. 929extend(I, G0, G) :- 930 G0 =.. List, 931 length(Extra, I), 932 append(List, Extra, All), 933 G =.. All. 934 935strip_existential(Var, Var) :- 936 var(Var), 937 !. 938strip_existential(M:G0, M:G) :- 939 !, 940 strip_existential(G0, G). 941strip_existential(_^G0, G) :- 942 !, 943 strip_existential(G0, G). 944strip_existential(G, G).
948safe_meta((0,0)). 949safe_meta((0;0)). 950safe_meta((0->0)). 951safe_meta(system:(0*->0)). 952safe_meta(catch(0,*,0)). 953safe_meta(findall(*,0,*)). 954safe_meta('$bags':findall(*,0,*,*)). 955safe_meta(setof(*,^,*)). 956safe_meta(bagof(*,^,*)). 957safe_meta('$bags':findnsols(*,*,0,*)). 958safe_meta('$bags':findnsols(*,*,0,*,*)). 959safe_meta(system:call_cleanup(0,0)). 960safe_meta(system:setup_call_cleanup(0,0,0)). 961safe_meta(system:setup_call_catcher_cleanup(0,0,*,0)). 962safe_meta('$attvar':call_residue_vars(0,*)). 963safe_meta('$syspreds':call_with_inference_limit(0,*,*)). 964safe_meta('$syspreds':call_with_depth_limit(0,*,*)). 965safe_meta(^(*,0)). 966safe_meta(\+(0)). 967safe_meta(call(0)). 968safe_meta(call(1,*)). 969safe_meta(call(2,*,*)). 970safe_meta(call(3,*,*,*)). 971safe_meta(call(4,*,*,*,*)). 972safe_meta(call(5,*,*,*,*,*)). 973safe_meta(call(6,*,*,*,*,*,*)).
981safe_output(Output) :- 982 var(Output), 983 !, 984 instantiation_error(Output). 985safe_output(atom(_)). 986safe_output(string(_)). 987safe_output(codes(_)). 988safe_output(codes(_,_)). 989safe_output(chars(_)). 990safe_output(chars(_,_)). 991safe_output(current_output). 992safe_output(current_error).
998:- public format_calls/3. % used in pengines_io 999 1000format_calls(Format, _Args, _Calls) :- 1001 var(Format), 1002 !, 1003 instantiation_error(Format). 1004format_calls(Format, Args, Calls) :- 1005 format_types(Format, Types), 1006 ( format_callables(Types, Args, Calls) 1007 -> true 1008 ; throw(error(format_error(Format, Types, Args), _)) 1009 ). 1010 1011format_callables([], [], []). 1012format_callables([callable|TT], [G|TA], [G|TG]) :- 1013 !, 1014 format_callables(TT, TA, TG). 1015format_callables([_|TT], [_|TA], TG) :- 1016 !, 1017 format_callables(TT, TA, TG). 1018 1019 1020 /******************************* 1021 * SAFE COMPILATION HOOKS * 1022 *******************************/ 1023 1024:- multifile 1025 prolog:sandbox_allowed_directive/1, 1026 prolog:sandbox_allowed_goal/1, 1027 prolog:sandbox_allowed_expansion/1.
1033prologsandbox_allowed_directive(Directive) :- 1034 debug(sandbox(directive), 'Directive: ~p', [Directive]), 1035 fail. 1036prologsandbox_allowed_directive(Directive) :- 1037 safe_directive(Directive), 1038 !. 1039prologsandbox_allowed_directive(M:PredAttr) :- 1040 \+ prolog_load_context(module, M), 1041 !, 1042 debug(sandbox(directive), 'Cross-module directive', []), 1043 permission_error(execute, sandboxed_directive, (:- M:PredAttr)). 1044prologsandbox_allowed_directive(M:PredAttr) :- 1045 safe_pattr(PredAttr), 1046 !, 1047 PredAttr =.. [Attr, Preds], 1048 ( safe_pattr(Preds, Attr) 1049 -> true 1050 ; permission_error(execute, sandboxed_directive, (:- M:PredAttr)) 1051 ). 1052prologsandbox_allowed_directive(_:Directive) :- 1053 safe_source_directive(Directive), 1054 !. 1055prologsandbox_allowed_directive(_:Directive) :- 1056 directive_loads_file(Directive, File), 1057 !, 1058 safe_path(File). 1059prologsandbox_allowed_directive(G) :- 1060 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),
...
1078safe_pattr(dynamic(_)). 1079safe_pattr(thread_local(_)). 1080safe_pattr(volatile(_)). 1081safe_pattr(discontiguous(_)). 1082safe_pattr(multifile(_)). 1083safe_pattr(public(_)). 1084safe_pattr(meta_predicate(_)). 1085 1086safe_pattr(Var, _) :- 1087 var(Var), 1088 !, 1089 instantiation_error(Var). 1090safe_pattr((A,B), Attr) :- 1091 !, 1092 safe_pattr(A, Attr), 1093 safe_pattr(B, Attr). 1094safe_pattr(M:G, Attr) :- 1095 !, 1096 ( atom(M), 1097 prolog_load_context(module, M) 1098 -> true 1099 ; Goal =.. [Attr,M:G], 1100 permission_error(directive, sandboxed, (:- Goal)) 1101 ). 1102safe_pattr(_, _). 1103 1104safe_source_directive(op(_,_,Name)) :- 1105 !, 1106 ( atom(Name) 1107 -> true 1108 ; is_list(Name), 1109 maplist(atom, Name) 1110 ). 1111safe_source_directive(set_prolog_flag(Flag, Value)) :- 1112 !, 1113 atom(Flag), ground(Value), 1114 safe_directive_flag(Flag, Value). 1115safe_source_directive(style_check(_)). 1116safe_source_directive(initialization(_)). % Checked at runtime 1117safe_source_directive(initialization(_,_)). % Checked at runtime 1118 1119directive_loads_file(use_module(library(X)), X). 1120directive_loads_file(use_module(library(X), _Imports), X). 1121directive_loads_file(ensure_loaded(library(X)), X). 1122directive_loads_file(include(X), X). 1123 1124safe_path(X) :- 1125 var(X), 1126 !, 1127 instantiation_error(X). 1128safe_path(X) :- 1129 ( atom(X) 1130 ; string(X) 1131 ), 1132 !, 1133 \+ sub_atom(X, 0, _, 0, '..'), 1134 \+ sub_atom(X, 0, _, _, '/'), 1135 \+ sub_atom(X, 0, _, _, '../'), 1136 \+ sub_atom(X, _, _, 0, '/..'), 1137 \+ sub_atom(X, _, _, _, '/../'). 1138safe_path(A/B) :- 1139 !, 1140 safe_path(A), 1141 safe_path(B).
1153safe_directive_flag(generate_debug_info, _). 1154safe_directive_flag(var_prefix, _). 1155safe_directive_flag(double_quotes, _). 1156safe_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.
1171prologsandbox_allowed_expansion(Directive) :- 1172 prolog_load_context(module, M), 1173 debug(sandbox(expansion), 'Expand in ~p: ~p', [M, Directive]), 1174 fail. 1175prologsandbox_allowed_expansion(M:G) :- 1176 prolog_load_context(module, M), 1177 !, 1178 safe_goal(M:G). 1179prologsandbox_allowed_expansion(_,_).
1185prologsandbox_allowed_goal(G) :- 1186 safe_goal(G). 1187 1188 1189 /******************************* 1190 * MESSAGES * 1191 *******************************/ 1192 1193:- multifile 1194 prolog:message//1, 1195 prolog:message_context//1, 1196 prolog:error_message//1. 1197 1198prologmessage_context(sandbox(_G, [])) --> !. 1199prologmessage_context(sandbox(_G, Parents)) --> 1200 [ nl, 'Reachable from:'-[] ], 1201 callers(Parents, 10). 1202 1203callers([], _) --> !. 1204callers(_, 0) --> !. 1205callers([G|Parents], Level) --> 1206 { NextLevel is Level-1 1207 }, 1208 [ nl, '\t ~p'-[G] ], 1209 callers(Parents, NextLevel). 1210 1211prologmessage(bad_safe_declaration(Goal, File, Line)) --> 1212 [ '~w:~d: Invalid safe_primitive/1 declaration: ~p'- 1213 [File, Line, Goal] ]. 1214 1215prologerror_message(format_error(Format, Types, Args)) --> 1216 format_error(Format, Types, Args). 1217 1218format_error(Format, Types, Args) --> 1219 { length(Types, TypeLen), 1220 length(Args, ArgsLen), 1221 ( TypeLen > ArgsLen 1222 -> Problem = 'not enough' 1223 ; Problem = 'too many' 1224 ) 1225 }, 1226 [ 'format(~q): ~w arguments (found ~w, need ~w)'- 1227 [Format, Problem, ArgsLen, TypeLen] 1228 ]
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.