36
37:- module(sandbox,
38 [ safe_goal/1, 39 safe_call/1 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, 56 safe_meta_predicate/1, 57 safe_meta/2, 58 safe_meta/3, 59 safe_global_variable/1, 60 safe_directive/1, 61 safe_prolog_flag/2. 62
64
77
78
79:- meta_predicate
80 safe_goal(:),
81 safe_call(0). 82
92
93safe_call(Goal0) :-
94 expand_goal(Goal0, Goal),
95 safe_goal(Goal),
96 call(Goal).
97
119
120safe_goal(M:Goal) :-
121 empty_assoc(Safe0),
122 catch(safe(Goal, M, [], Safe0, _), E, true),
123 !,
124 nb_delete(sandbox_last_error),
125 ( var(E)
126 -> true
127 ; throw(E)
128 ).
129safe_goal(_) :-
130 nb_current(sandbox_last_error, E),
131 !,
132 nb_delete(sandbox_last_error),
133 throw(E).
134safe_goal(G) :-
135 debug(sandbox(fail), 'safe_goal/1 failed for ~p', [G]),
136 throw(error(instantiation_error, sandbox(G, []))).
137
138
142
143safe(V, _, Parents, _, _) :-
144 var(V),
145 !,
146 Error = error(instantiation_error, sandbox(V, Parents)),
147 nb_setval(sandbox_last_error, Error),
148 throw(Error).
149safe(M:G, _, Parents, Safe0, Safe) :-
150 !,
151 must_be(atom, M),
152 must_be(callable, G),
153 known_module(M:G, Parents),
154 ( predicate_property(M:G, imported_from(M2))
155 -> true
156 ; M2 = M
157 ),
158 ( ( safe_primitive(M2:G)
159 ; safe_primitive(G),
160 predicate_property(G, iso)
161 )
162 -> Safe = Safe0
163 ; ( predicate_property(M:G, exported)
164 ; predicate_property(M:G, public)
165 ; predicate_property(M:G, multifile)
166 ; predicate_property(M:G, iso)
167 ; memberchk(M:_, Parents)
168 )
169 -> safe(G, M, Parents, Safe0, Safe)
170 ; throw(error(permission_error(call, sandboxed, M:G),
171 sandbox(M:G, Parents)))
172 ).
173safe(G, _, Parents, _, _) :-
174 debugging(sandbox(show)),
175 length(Parents, Level),
176 debug(sandbox(show), '[~D] SAFE ~q?', [Level, G]),
177 fail.
178safe(G, _, Parents, Safe, Safe) :-
179 catch(safe_primitive(G),
180 error(instantiation_error, _),
181 rethrow_instantition_error([G|Parents])),
182 predicate_property(G, iso),
183 !.
184safe(G, M, Parents, Safe, Safe) :-
185 known_module(M:G, Parents),
186 ( predicate_property(M:G, imported_from(M2))
187 -> true
188 ; M2 = M
189 ),
190 ( catch(safe_primitive(M2:G),
191 error(instantiation_error, _),
192 rethrow_instantition_error([M2:G|Parents]))
193 ; predicate_property(M2:G, number_of_rules(0))
194 ),
195 !.
196safe(G, M, Parents, Safe0, Safe) :-
197 predicate_property(G, iso),
198 safe_meta_call(G, M, Called),
199 !,
200 add_iso_parent(G, Parents, Parents1),
201 safe_list(Called, M, Parents1, Safe0, Safe).
202safe(G, M, Parents, Safe0, Safe) :-
203 ( predicate_property(M:G, imported_from(M2))
204 -> true
205 ; M2 = M
206 ),
207 safe_meta_call(M2:G, M, Called),
208 !,
209 safe_list(Called, M, Parents, Safe0, Safe).
210safe(G, M, Parents, Safe0, Safe) :-
211 goal_id(M:G, Id, Gen),
212 ( get_assoc(Id, Safe0, _)
213 -> Safe = Safe0
214 ; put_assoc(Id, Safe0, true, Safe1),
215 ( Gen == M:G
216 -> safe_clauses(Gen, M, [Id|Parents], Safe1, Safe)
217 ; catch(safe_clauses(Gen, M, [Id|Parents], Safe1, Safe),
218 error(instantiation_error, Ctx),
219 unsafe(Parents, Ctx))
220 )
221 ),
222 !.
223safe(G, M, Parents, _, _) :-
224 debug(sandbox(fail),
225 'safe/1 failed for ~p (parents:~p)', [M:G, Parents]),
226 fail.
227
228unsafe(Parents, Var) :-
229 var(Var),
230 !,
231 nb_setval(sandbox_last_error,
232 error(instantiation_error, sandbox(_, Parents))),
233 fail.
234unsafe(_Parents, Ctx) :-
235 Ctx = sandbox(_,_),
236 nb_setval(sandbox_last_error,
237 error(instantiation_error, Ctx)),
238 fail.
239
240rethrow_instantition_error(Parents) :-
241 throw(error(instantiation_error, sandbox(_, Parents))).
242
243safe_clauses(G, M, Parents, Safe0, Safe) :-
244 predicate_property(M:G, interpreted),
245 def_module(M:G, MD:QG),
246 \+ compiled(MD:QG),
247 !,
248 findall(Ref-Body, clause(MD:QG, Body, Ref), Bodies),
249 safe_bodies(Bodies, MD, Parents, Safe0, Safe).
250safe_clauses(G, M, [_|Parents], _, _) :-
251 predicate_property(M:G, visible),
252 !,
253 throw(error(permission_error(call, sandboxed, G),
254 sandbox(M:G, Parents))).
255safe_clauses(_, _, [G|Parents], _, _) :-
256 throw(error(existence_error(procedure, G),
257 sandbox(G, Parents))).
258
259compiled(system:(@(_,_))).
260
261known_module(M:_, _) :-
262 current_module(M),
263 !.
264known_module(M:G, Parents) :-
265 throw(error(permission_error(call, sandboxed, M:G),
266 sandbox(M:G, Parents))).
267
268add_iso_parent(G, Parents, Parents) :-
269 is_control(G),
270 !.
271add_iso_parent(G, Parents, [G|Parents]).
272
273is_control((_,_)).
274is_control((_;_)).
275is_control((_->_)).
276is_control((_*->_)).
277is_control(\+(_)).
278
279
285
286safe_bodies([], _, _, Safe, Safe).
287safe_bodies([Ref-H|T], M, Parents, Safe0, Safe) :-
288 ( H = M2:H2, nonvar(M2),
289 clause_property(Ref, module(M2))
290 -> copy_term(H2, H3),
291 CM = M2
292 ; copy_term(H, H3),
293 CM = M
294 ),
295 safe(H3, CM, Parents, Safe0, Safe1),
296 safe_bodies(T, M, Parents, Safe1, Safe).
297
298def_module(M:G, MD:QG) :-
299 predicate_property(M:G, imported_from(MD)),
300 !,
301 meta_qualify(MD:G, M, QG).
302def_module(M:G, M:QG) :-
303 meta_qualify(M:G, M, QG).
304
310
311safe_list([], _, _, Safe, Safe).
312safe_list([H|T], M, Parents, Safe0, Safe) :-
313 ( H = M2:H2,
314 M == M2 315 -> copy_term(H2, H3)
316 ; copy_term(H, H3) 317 ),
318 safe(H3, M, Parents, Safe0, Safe1),
319 safe_list(T, M, Parents, Safe1, Safe).
320
324
325meta_qualify(MD:G, M, QG) :-
326 predicate_property(MD:G, meta_predicate(Head)),
327 !,
328 G =.. [Name|Args],
329 Head =.. [_|Q],
330 qualify_args(Q, M, Args, QArgs),
331 QG =.. [Name|QArgs].
332meta_qualify(_:G, _, G).
333
334qualify_args([], _, [], []).
335qualify_args([H|T], M, [A|AT], [Q|QT]) :-
336 qualify_arg(H, M, A, Q),
337 qualify_args(T, M, AT, QT).
338
339qualify_arg(S, M, A, Q) :-
340 q_arg(S),
341 !,
342 qualify(A, M, Q).
343qualify_arg(_, _, A, A).
344
345q_arg(I) :- integer(I), !.
346q_arg(:).
347q_arg(^).
348q_arg(//).
349
350qualify(A, M, MZ:Q) :-
351 strip_module(M:A, MZ, Q).
352
362
363goal_id(M:Goal, M:Id, Gen) :-
364 !,
365 goal_id(Goal, Id, Gen).
366goal_id(Var, _, _) :-
367 var(Var),
368 !,
369 instantiation_error(Var).
370goal_id(Atom, Atom, Atom) :-
371 atom(Atom),
372 !.
373goal_id(Term, _, _) :-
374 \+ compound(Term),
375 !,
376 type_error(callable, Term).
377goal_id(Term, Skolem, Gen) :- 378 compound_name_arity(Term, Name, Arity),
379 compound_name_arity(Skolem, Name, Arity),
380 compound_name_arity(Gen, Name, Arity),
381 copy_goal_args(1, Term, Skolem, Gen),
382 ( Gen =@= Term
383 -> ! 384 ; true
385 ),
386 numbervars(Skolem, 0, _).
387goal_id(Term, Skolem, Term) :- 388 debug(sandbox(specify), 'Retrying with ~p', [Term]),
389 copy_term(Term, Skolem),
390 numbervars(Skolem, 0, _).
391
396
397copy_goal_args(I, Term, Skolem, Gen) :-
398 arg(I, Term, TA),
399 !,
400 arg(I, Skolem, SA),
401 arg(I, Gen, GA),
402 copy_goal_arg(TA, SA, GA),
403 I2 is I + 1,
404 copy_goal_args(I2, Term, Skolem, Gen).
405copy_goal_args(_, _, _, _).
406
407copy_goal_arg(Arg, SArg, Arg) :-
408 copy_goal_arg(Arg),
409 !,
410 copy_term(Arg, SArg).
411copy_goal_arg(_, _, _).
412
413copy_goal_arg(Var) :- var(Var), !, fail.
414copy_goal_arg(_:_).
415
425
426term_expansion(safe_primitive(Goal), Term) :-
427 ( verify_safe_declaration(Goal)
428 -> Term = safe_primitive(Goal)
429 ; Term = []
430 ).
431term_expansion((safe_primitive(Goal) :- Body), Term) :-
432 ( verify_safe_declaration(Goal)
433 -> Term = (safe_primitive(Goal) :- Body)
434 ; Term = []
435 ).
436
437system:term_expansion(sandbox:safe_primitive(Goal), Term) :-
438 \+ current_prolog_flag(xref, true),
439 ( verify_safe_declaration(Goal)
440 -> Term = sandbox:safe_primitive(Goal)
441 ; Term = []
442 ).
443system:term_expansion((sandbox:safe_primitive(Goal) :- Body), Term) :-
444 \+ current_prolog_flag(xref, true),
445 ( verify_safe_declaration(Goal)
446 -> Term = (sandbox:safe_primitive(Goal) :- Body)
447 ; Term = []
448 ).
449
450verify_safe_declaration(Var) :-
451 var(Var),
452 !,
453 instantiation_error(Var).
454verify_safe_declaration(Module:Goal) :-
455 !,
456 must_be(atom, Module),
457 must_be(callable, Goal),
458 ( ok_meta(Module:Goal)
459 -> true
460 ; ( predicate_property(Module:Goal, visible)
461 -> true
462 ; predicate_property(Module:Goal, foreign)
463 ),
464 \+ predicate_property(Module:Goal, imported_from(_)),
465 \+ predicate_property(Module:Goal, meta_predicate(_))
466 -> true
467 ; permission_error(declare, safe_goal, Module:Goal)
468 ).
469verify_safe_declaration(Goal) :-
470 must_be(callable, Goal),
471 ( predicate_property(system:Goal, iso),
472 \+ predicate_property(system:Goal, meta_predicate())
473 -> true
474 ; permission_error(declare, safe_goal, Goal)
475 ).
476
477ok_meta(system:assert(_)).
478ok_meta(system:load_files(_,_)).
479ok_meta(system:use_module(_,_)).
480ok_meta(system:use_module(_)).
481ok_meta('$syspreds':predicate_property(_,_)).
482
483verify_predefined_safe_declarations :-
484 forall(clause(safe_primitive(Goal), _Body, Ref),
485 ( E = error(F,_),
486 catch(verify_safe_declaration(Goal), E, true),
487 ( nonvar(F)
488 -> clause_property(Ref, file(File)),
489 clause_property(Ref, line_count(Line)),
490 print_message(error, bad_safe_declaration(Goal, File, Line))
491 ; true
492 )
493 )).
494
495:- initialization(verify_predefined_safe_declarations, now). 496
508
510
511safe_primitive(true).
512safe_primitive(fail).
513safe_primitive(system:false).
514safe_primitive(repeat).
515safe_primitive(!).
516 517safe_primitive(var(_)).
518safe_primitive(nonvar(_)).
519safe_primitive(system:attvar(_)).
520safe_primitive(integer(_)).
521safe_primitive(float(_)).
522:- if(current_predicate(rational/1)). 523safe_primitive(system:rational(_)).
524safe_primitive(system:rational(_,_,_)).
525:- endif. 526safe_primitive(number(_)).
527safe_primitive(atom(_)).
528safe_primitive(system:blob(_,_)).
529safe_primitive(system:string(_)).
530safe_primitive(atomic(_)).
531safe_primitive(compound(_)).
532safe_primitive(callable(_)).
533safe_primitive(ground(_)).
534safe_primitive(system:nonground(_,_)).
535safe_primitive(system:cyclic_term(_)).
536safe_primitive(acyclic_term(_)).
537safe_primitive(system:is_stream(_)).
538safe_primitive(system:'$is_char'(_)).
539safe_primitive(system:'$is_char_code'(_)).
540safe_primitive(system:'$is_char_list'(_,_)).
541safe_primitive(system:'$is_code_list'(_,_)).
542 543safe_primitive(@>(_,_)).
544safe_primitive(@>=(_,_)).
545safe_primitive(==(_,_)).
546safe_primitive(@<(_,_)).
547safe_primitive(@=<(_,_)).
548safe_primitive(compare(_,_,_)).
549safe_primitive(sort(_,_)).
550safe_primitive(keysort(_,_)).
551safe_primitive(system: =@=(_,_)).
552safe_primitive(system:'$btree_find_node'(_,_,_,_,_)).
553
554 555safe_primitive(=(_,_)).
556safe_primitive(\=(_,_)).
557safe_primitive(system:'?='(_,_)).
558safe_primitive(system:unifiable(_,_,_)).
559safe_primitive(unify_with_occurs_check(_,_)).
560safe_primitive(\==(_,_)).
561 562safe_primitive(is(_,_)).
563safe_primitive(>(_,_)).
564safe_primitive(>=(_,_)).
565safe_primitive(=:=(_,_)).
566safe_primitive(=\=(_,_)).
567safe_primitive(=<(_,_)).
568safe_primitive(<(_,_)).
569:- if(current_prolog_flag(bounded, false)). 570safe_primitive(system:nth_integer_root_and_remainder(_,_,_,_)).
571:- endif. 572safe_primitive(system:current_arithmetic_function(_)).
573safe_primitive(system:bounded_number(_,_,_)).
574safe_primitive(system:float_class(_,_)).
575safe_primitive(system:float_parts(_,_,_,_)).
576
577 578safe_primitive(arg(_,_,_)).
579safe_primitive(system:setarg(_,_,_)).
580safe_primitive(system:nb_setarg(_,_,_)).
581safe_primitive(system:nb_linkarg(_,_,_)).
582safe_primitive(functor(_,_,_)).
583safe_primitive(system:functor(_,_,_,_)).
584safe_primitive(_ =.. _).
585safe_primitive(system:compound_name_arity(_,_,_)).
586safe_primitive(system:compound_name_arguments(_,_,_)).
587safe_primitive(system:'$filled_array'(_,_,_,_)).
588safe_primitive(copy_term(_,_)).
589safe_primitive(system:copy_term(_,_,_,_)).
590safe_primitive(system:duplicate_term(_,_)).
591safe_primitive(system:copy_term_nat(_,_)).
592safe_primitive(system:size_abstract_term(_,_,_)).
593safe_primitive(numbervars(_,_,_)).
594safe_primitive(system:numbervars(_,_,_,_)).
595safe_primitive(subsumes_term(_,_)).
596safe_primitive(system:term_hash(_,_)).
597safe_primitive(system:term_hash(_,_,_,_)).
598safe_primitive(system:variant_sha1(_,_)).
599safe_primitive(system:variant_hash(_,_)).
600safe_primitive(system:'$term_size'(_,_,_)).
601
602 603safe_primitive(system:is_dict(_)).
604safe_primitive(system:is_dict(_,_)).
605safe_primitive(system:get_dict(_,_,_)).
606safe_primitive(system:get_dict(_,_,_,_,_)).
607safe_primitive(system:'$get_dict_ex'(_,_,_)).
608safe_primitive(system:dict_create(_,_,_)).
609safe_primitive(system:dict_pairs(_,_,_)).
610safe_primitive(system:put_dict(_,_,_)).
611safe_primitive(system:put_dict(_,_,_,_)).
612safe_primitive(system:del_dict(_,_,_,_)).
613safe_primitive(system:select_dict(_,_,_)).
614safe_primitive(system:b_set_dict(_,_,_)).
615safe_primitive(system:nb_set_dict(_,_,_)).
616safe_primitive(system:nb_link_dict(_,_,_)).
617safe_primitive(system:(:<(_,_))).
618safe_primitive(system:(>:<(_,_))).
619 620safe_primitive(atom_chars(_, _)).
621safe_primitive(atom_codes(_, _)).
622safe_primitive(sub_atom(_,_,_,_,_)).
623safe_primitive(atom_concat(_,_,_)).
624safe_primitive(atom_length(_,_)).
625safe_primitive(char_code(_,_)).
626safe_primitive(system:name(_,_)).
627safe_primitive(system:atomic_concat(_,_,_)).
628safe_primitive(system:atomic_list_concat(_,_)).
629safe_primitive(system:atomic_list_concat(_,_,_)).
630safe_primitive(system:downcase_atom(_,_)).
631safe_primitive(system:upcase_atom(_,_)).
632safe_primitive(system:char_type(_,_)).
633safe_primitive(system:normalize_space(_,_)).
634safe_primitive(system:sub_atom_icasechk(_,_,_)).
635 636safe_primitive(number_codes(_,_)).
637safe_primitive(number_chars(_,_)).
638safe_primitive(system:atom_number(_,_)).
639safe_primitive(system:code_type(_,_)).
640 641safe_primitive(system:atom_string(_,_)).
642safe_primitive(system:number_string(_,_)).
643safe_primitive(system:string_chars(_, _)).
644safe_primitive(system:string_codes(_, _)).
645safe_primitive(system:string_code(_,_,_)).
646safe_primitive(system:sub_string(_,_,_,_,_)).
647safe_primitive(system:split_string(_,_,_,_)).
648safe_primitive(system:atomics_to_string(_,_,_)).
649safe_primitive(system:atomics_to_string(_,_)).
650safe_primitive(system:string_concat(_,_,_)).
651safe_primitive(system:string_length(_,_)).
652safe_primitive(system:string_lower(_,_)).
653safe_primitive(system:string_upper(_,_)).
654safe_primitive(system:term_string(_,_)).
655safe_primitive('$syspreds':term_string(_,_,_)).
656 657safe_primitive(length(_,_)).
658 659safe_primitive(throw(_)).
660safe_primitive(system:abort).
661 662safe_primitive(current_prolog_flag(_,_)).
663safe_primitive(current_op(_,_,_)).
664safe_primitive(system:sleep(_)).
665safe_primitive(system:thread_self(_)).
666safe_primitive(system:get_time(_)).
667safe_primitive(system:statistics(_,_)).
668:- if(current_prolog_flag(threads,true)). 669safe_primitive(system:thread_statistics(Id,_,_)) :-
670 ( var(Id)
671 -> instantiation_error(Id)
672 ; thread_self(Id)
673 ).
674safe_primitive(system:thread_property(Id,_)) :-
675 ( var(Id)
676 -> instantiation_error(Id)
677 ; thread_self(Id)
678 ).
679:- endif. 680safe_primitive(system:format_time(_,_,_)).
681safe_primitive(system:format_time(_,_,_,_)).
682safe_primitive(system:date_time_stamp(_,_)).
683safe_primitive(system:stamp_date_time(_,_,_)).
684safe_primitive(system:strip_module(_,_,_)).
685safe_primitive('$messages':message_to_string(_,_)).
686safe_primitive(system:import_module(_,_)).
687safe_primitive(system:file_base_name(_,_)).
688safe_primitive(system:file_directory_name(_,_)).
689safe_primitive(system:file_name_extension(_,_,_)).
690
691safe_primitive(clause(H,_)) :- safe_clause(H).
692safe_primitive(asserta(X)) :- safe_assert(X).
693safe_primitive(assertz(X)) :- safe_assert(X).
694safe_primitive(retract(X)) :- safe_assert(X).
695safe_primitive(retractall(X)) :- safe_assert(X).
696safe_primitive(current_predicate(X)) :- safe_current_predicate(X).
697safe_primitive('$dcg':dcg_translate_rule(_,_)).
698safe_primitive('$syspreds':predicate_property(Pred, _)) :-
699 nonvar(Pred),
700 Pred \= (_:_).
701
705safe_primitive('$dicts':'.'(_,K,_)) :- atom(K).
706safe_primitive('$dicts':'.'(_,K,_)) :-
707 ( nonvar(K)
708 -> dict_built_in(K)
709 ; instantiation_error(K)
710 ).
711
712dict_built_in(get(_)).
713dict_built_in(get(_,_)).
714dict_built_in(put(_)).
715dict_built_in(put(_,_)).
716
719
720safe_primitive(system:false).
721safe_primitive(system:cyclic_term(_)).
722safe_primitive(system:msort(_,_)).
723safe_primitive(system:sort(_,_,_,_)).
724safe_primitive(system:between(_,_,_)).
725safe_primitive(system:succ(_,_)).
726safe_primitive(system:plus(_,_,_)).
727safe_primitive(system:float_class(_,_)).
728safe_primitive(system:term_variables(_,_)).
729safe_primitive(system:term_variables(_,_,_)).
730safe_primitive(system:'$term_size'(_,_,_)).
731safe_primitive(system:atom_to_term(_,_,_)).
732safe_primitive(system:term_to_atom(_,_)).
733safe_primitive(system:atomic_list_concat(_,_,_)).
734safe_primitive(system:atomic_list_concat(_,_)).
735safe_primitive(system:downcase_atom(_,_)).
736safe_primitive(system:upcase_atom(_,_)).
737safe_primitive(system:is_list(_)).
738safe_primitive(system:memberchk(_,_)).
739safe_primitive(system:'$skip_list'(_,_,_)).
740safe_primitive(system:'$seek_list'(_, _, _, _)).
741 742safe_primitive(system:get_attr(_,_,_)).
743safe_primitive(system:get_attrs(_,_)).
744safe_primitive(system:term_attvars(_,_)).
745safe_primitive(system:del_attr(_,_)).
746safe_primitive(system:del_attrs(_)).
747safe_primitive('$attvar':copy_term(_,_,_)).
748 749safe_primitive(system:b_getval(_,_)).
750safe_primitive(system:b_setval(Var,_)) :-
751 safe_global_var(Var).
752safe_primitive(system:nb_getval(_,_)).
753safe_primitive('$syspreds':nb_setval(Var,_)) :-
754 safe_global_var(Var).
755safe_primitive(system:nb_linkval(Var,_)) :-
756 safe_global_var(Var).
757safe_primitive(system:nb_current(_,_)).
758 759safe_primitive(system:assert(X)) :-
760 safe_assert(X).
761 762safe_primitive(system:writeln(_)).
763safe_primitive('$messages':print_message(_,_)).
764
765 766safe_primitive('$syspreds':set_prolog_stack(Stack, limit(ByteExpr))) :-
767 nonvar(Stack),
768 stack_name(Stack),
769 catch(Bytes is ByteExpr, _, fail),
770 prolog_stack_property(Stack, limit(Current)),
771 Bytes =< Current.
772
773stack_name(global).
774stack_name(local).
775stack_name(trail).
776
777safe_primitive('$tabling':abolish_all_tables).
778safe_primitive('$tabling':'$wrap_tabled'(Module:_Head, _Mode)) :-
779 prolog_load_context(module, Module),
780 !.
781safe_primitive('$tabling':'$moded_wrap_tabled'(Module:_Head,_,_,_,_)) :-
782 prolog_load_context(module, Module),
783 !.
784
785
788
789safe_primitive(system:use_module(Spec, _Import)) :-
790 safe_primitive(system:use_module(Spec)).
791safe_primitive(system:load_files(Spec, Options)) :-
792 safe_primitive(system:use_module(Spec)),
793 maplist(safe_load_file_option, Options).
794safe_primitive(system:use_module(Spec)) :-
795 ground(Spec),
796 ( atom(Spec)
797 -> Path = Spec
798 ; Spec =.. [_Alias, Segments],
799 phrase(segments_to_path(Segments), List),
800 atomic_list_concat(List, Path)
801 ),
802 \+ is_absolute_file_name(Path),
803 \+ sub_atom(Path, _, _, _, '/../'),
804 absolute_file_name(Spec, AbsFile,
805 [ access(read),
806 file_type(prolog),
807 file_errors(fail)
808 ]),
809 file_name_extension(_, Ext, AbsFile),
810 save_extension(Ext).
811
814
815segments_to_path(A/B) -->
816 !,
817 segments_to_path(A),
818 [/],
819 segments_to_path(B).
820segments_to_path(X) -->
821 [X].
822
823save_extension(pl).
824
825safe_load_file_option(if(changed)).
826safe_load_file_option(if(not_loaded)).
827safe_load_file_option(must_be_module(_)).
828safe_load_file_option(optimise(_)).
829safe_load_file_option(silent(_)).
830
837
838safe_assert(C) :- cyclic_term(C), !, fail.
839safe_assert(X) :- var(X), !, fail.
840safe_assert(_Head:-_Body) :- !, fail.
841safe_assert(_:_) :- !, fail.
842safe_assert(_).
843
849
850safe_clause(H) :- var(H), !.
851safe_clause(_:_) :- !, fail.
852safe_clause(_).
853
854
859
860safe_global_var(Name) :-
861 var(Name),
862 !,
863 instantiation_error(Name).
864safe_global_var(Name) :-
865 safe_global_variable(Name).
866
870
874
875safe_current_predicate(X) :-
876 nonvar(X),
877 X = _:_, !,
878 fail.
879safe_current_predicate(_).
880
885
886safe_meta(system:put_attr(V,M,A), Called) :-
887 !,
888 ( atom(M)
889 -> attr_hook_predicates([ attr_unify_hook(A, _),
890 attribute_goals(V,_,_),
891 project_attributes(_,_)
892 ], M, Called)
893 ; instantiation_error(M)
894 ).
895safe_meta(system:with_output_to(Output, G), [G]) :-
896 safe_output(Output),
897 !.
898safe_meta(system:format(Format, Args), Calls) :-
899 format_calls(Format, Args, Calls).
900safe_meta(system:format(Output, Format, Args), Calls) :-
901 safe_output(Output),
902 format_calls(Format, Args, Calls).
903safe_meta(prolog_debug:debug(_Term, Format, Args), Calls) :-
904 format_calls(Format, Args, Calls).
905safe_meta(system:set_prolog_flag(Flag, Value), []) :-
906 atom(Flag),
907 safe_prolog_flag(Flag, Value).
908safe_meta('$attvar':freeze(_Var,Goal), [Goal]).
909safe_meta(phrase(NT,Xs0,Xs), [Goal]) :- 910 expand_nt(NT,Xs0,Xs,Goal).
911safe_meta(phrase(NT,Xs0), [Goal]) :-
912 expand_nt(NT,Xs0,[],Goal).
913safe_meta('$dcg':call_dcg(NT,Xs0,Xs), [Goal]) :-
914 expand_nt(NT,Xs0,Xs,Goal).
915safe_meta('$dcg':call_dcg(NT,Xs0), [Goal]) :-
916 expand_nt(NT,Xs0,[],Goal).
917safe_meta('$tabling':abolish_table_subgoals(V), []) :-
918 \+ qualified(V).
919safe_meta('$tabling':current_table(V, _), []) :-
920 \+ qualified(V).
921safe_meta('$tabling':tnot(G), [G]).
922safe_meta('$tabling':not_exists(G), [G]).
923
924qualified(V) :-
925 nonvar(V),
926 V = _:_.
927
935
936attr_hook_predicates([], _, []).
937attr_hook_predicates([H|T], M, Called) :-
938 ( predicate_property(M:H, defined)
939 -> Called = [M:H|Rest]
940 ; Called = Rest
941 ),
942 attr_hook_predicates(T, M, Rest).
943
944
949
950expand_nt(NT, _Xs0, _Xs, _NewGoal) :-
951 strip_module(NT, _, Plain),
952 var(Plain),
953 !,
954 instantiation_error(Plain).
955expand_nt(NT, Xs0, Xs, NewGoal) :-
956 dcg_translate_rule((pseudo_nt --> NT),
957 (pseudo_nt(Xs0c,Xsc) :- NewGoal0)),
958 ( var(Xsc), Xsc \== Xs0c
959 -> Xs = Xsc, NewGoal1 = NewGoal0
960 ; NewGoal1 = (NewGoal0, Xsc = Xs)
961 ),
962 ( var(Xs0c)
963 -> Xs0 = Xs0c,
964 NewGoal = NewGoal1
965 ; NewGoal = ( Xs0 = Xs0c, NewGoal1 )
966 ).
967
972
973safe_meta_call(Goal, _, _Called) :-
974 debug(sandbox(meta), 'Safe meta ~p?', [Goal]),
975 fail.
976safe_meta_call(Goal, Context, Called) :-
977 ( safe_meta(Goal, Called)
978 -> true
979 ; safe_meta(Goal, Context, Called)
980 ),
981 !. 982safe_meta_call(Goal, _, Called) :-
983 Goal = M:Plain,
984 compound(Plain),
985 compound_name_arity(Plain, Name, Arity),
986 safe_meta_predicate(M:Name/Arity),
987 predicate_property(Goal, meta_predicate(Spec)),
988 !,
989 called(Spec, Plain, Called).
990safe_meta_call(M:Goal, _, Called) :-
991 !,
992 generic_goal(Goal, Gen),
993 safe_meta(M:Gen),
994 called(Gen, Goal, Called).
995safe_meta_call(Goal, _, Called) :-
996 generic_goal(Goal, Gen),
997 safe_meta(Gen),
998 called(Gen, Goal, Called).
999
1000called(Gen, Goal, Called) :-
1001 compound_name_arity(Goal, _, Arity),
1002 called(1, Arity, Gen, Goal, Called).
1003
1004called(I, Arity, Gen, Goal, Called) :-
1005 I =< Arity,
1006 !,
1007 arg(I, Gen, Spec),
1008 ( calling_meta_spec(Spec)
1009 -> arg(I, Goal, Called0),
1010 extend(Spec, Called0, G),
1011 Called = [G|Rest]
1012 ; Called = Rest
1013 ),
1014 I2 is I+1,
1015 called(I2, Arity, Gen, Goal, Rest).
1016called(_, _, _, _, []).
1017
1018generic_goal(G, Gen) :-
1019 functor(G, Name, Arity),
1020 functor(Gen, Name, Arity).
1021
1022calling_meta_spec(V) :- var(V), !, fail.
1023calling_meta_spec(I) :- integer(I), !.
1024calling_meta_spec(^).
1025calling_meta_spec(//).
1026
1027
1028extend(^, G, Plain) :-
1029 !,
1030 strip_existential(G, Plain).
1031extend(//, DCG, Goal) :-
1032 !,
1033 ( expand_phrase(call_dcg(DCG,_,_), Goal)
1034 -> true
1035 ; instantiation_error(DCG) 1036 ). 1037extend(0, G, G) :- !.
1038extend(I, M:G0, M:G) :-
1039 !,
1040 G0 =.. List,
1041 length(Extra, I),
1042 append(List, Extra, All),
1043 G =.. All.
1044extend(I, G0, G) :-
1045 G0 =.. List,
1046 length(Extra, I),
1047 append(List, Extra, All),
1048 G =.. All.
1049
1050strip_existential(Var, Var) :-
1051 var(Var),
1052 !.
1053strip_existential(M:G0, M:G) :-
1054 !,
1055 strip_existential(G0, G).
1056strip_existential(_^G0, G) :-
1057 !,
1058 strip_existential(G0, G).
1059strip_existential(G, G).
1060
1062
1063safe_meta((0,0)).
1064safe_meta((0;0)).
1065safe_meta((0->0)).
1066safe_meta(system:(0*->0)).
1067safe_meta(catch(0,*,0)).
1068safe_meta(findall(*,0,*)).
1069safe_meta('$bags':findall(*,0,*,*)).
1070safe_meta(setof(*,^,*)).
1071safe_meta(bagof(*,^,*)).
1072safe_meta('$bags':findnsols(*,*,0,*)).
1073safe_meta('$bags':findnsols(*,*,0,*,*)).
1074safe_meta(system:call_cleanup(0,0)).
1075safe_meta(system:setup_call_cleanup(0,0,0)).
1076safe_meta(system:setup_call_catcher_cleanup(0,0,*,0)).
1077safe_meta('$attvar':call_residue_vars(0,*)).
1078safe_meta('$syspreds':call_with_inference_limit(0,*,*)).
1079safe_meta('$syspreds':call_with_depth_limit(0,*,*)).
1080safe_meta('$syspreds':undo(0)).
1081safe_meta(^(*,0)).
1082safe_meta(\+(0)).
1083safe_meta(call(0)).
1084safe_meta(call(1,*)).
1085safe_meta(call(2,*,*)).
1086safe_meta(call(3,*,*,*)).
1087safe_meta(call(4,*,*,*,*)).
1088safe_meta(call(5,*,*,*,*,*)).
1089safe_meta(call(6,*,*,*,*,*,*)).
1090safe_meta('$tabling':start_tabling(*,0)).
1091safe_meta('$tabling':start_tabling(*,0,*,*)).
1092safe_meta(wfs:call_delays(0,*)).
1093
1098
1099safe_output(Output) :-
1100 var(Output),
1101 !,
1102 instantiation_error(Output).
1103safe_output(atom(_)).
1104safe_output(string(_)).
1105safe_output(codes(_)).
1106safe_output(codes(_,_)).
1107safe_output(chars(_)).
1108safe_output(chars(_,_)).
1109safe_output(current_output).
1110safe_output(current_error).
1111
1115
1116:- public format_calls/3. 1117
1118format_calls(Format, Args, Calls) :-
1119 is_list(Args),
1120 !,
1121 format_types(Format, Types),
1122 ( format_callables(Types, Args, Calls)
1123 -> true
1124 ; throw(error(format_error(Format, Types, Args), _))
1125 ).
1126format_calls(Format, Arg, Calls) :-
1127 format_calls(Format, [Arg], Calls).
1128
1129format_callables([], [], []).
1130format_callables([callable|TT], [G|TA], [G|TG]) :-
1131 !,
1132 format_callables(TT, TA, TG).
1133format_callables([_|TT], [_|TA], TG) :-
1134 !,
1135 format_callables(TT, TA, TG).
1136
1137
1138 1141
1142:- multifile
1143 prolog:sandbox_allowed_directive/1,
1144 prolog:sandbox_allowed_goal/1,
1145 prolog:sandbox_allowed_expansion/1. 1146
1150
1151prolog:sandbox_allowed_directive(Directive) :-
1152 debug(sandbox(directive), 'Directive: ~p', [Directive]),
1153 fail.
1154prolog:sandbox_allowed_directive(Directive) :-
1155 safe_directive(Directive),
1156 !.
1157prolog:sandbox_allowed_directive(M:PredAttr) :-
1158 \+ prolog_load_context(module, M),
1159 !,
1160 debug(sandbox(directive), 'Cross-module directive', []),
1161 permission_error(execute, sandboxed_directive, (:- M:PredAttr)).
1162prolog:sandbox_allowed_directive(M:PredAttr) :-
1163 safe_pattr(PredAttr),
1164 !,
1165 PredAttr =.. [Attr, Preds],
1166 ( safe_pattr(Preds, Attr)
1167 -> true
1168 ; permission_error(execute, sandboxed_directive, (:- M:PredAttr))
1169 ).
1170prolog:sandbox_allowed_directive(_:Directive) :-
1171 safe_source_directive(Directive),
1172 !.
1173prolog:sandbox_allowed_directive(_:Directive) :-
1174 directive_loads_file(Directive, File),
1175 !,
1176 safe_path(File).
1177prolog:sandbox_allowed_directive(G) :-
1178 safe_goal(G).
1179
1194
1195
1196safe_pattr(dynamic(_)).
1197safe_pattr(thread_local(_)).
1198safe_pattr(volatile(_)).
1199safe_pattr(discontiguous(_)).
1200safe_pattr(multifile(_)).
1201safe_pattr(public(_)).
1202safe_pattr(meta_predicate(_)).
1203safe_pattr(table(_)).
1204safe_pattr(non_terminal(_)).
1205
1206safe_pattr(Var, _) :-
1207 var(Var),
1208 !,
1209 instantiation_error(Var).
1210safe_pattr((A,B), Attr) :-
1211 !,
1212 safe_pattr(A, Attr),
1213 safe_pattr(B, Attr).
1214safe_pattr(M:G, Attr) :-
1215 !,
1216 ( atom(M),
1217 prolog_load_context(module, M)
1218 -> true
1219 ; Goal =.. [Attr,M:G],
1220 permission_error(directive, sandboxed, (:- Goal))
1221 ).
1222safe_pattr(_, _).
1223
1224safe_source_directive(op(_,_,Name)) :-
1225 !,
1226 ( atom(Name)
1227 -> true
1228 ; is_list(Name),
1229 maplist(atom, Name)
1230 ).
1231safe_source_directive(set_prolog_flag(Flag, Value)) :-
1232 !,
1233 atom(Flag), ground(Value),
1234 safe_prolog_flag(Flag, Value).
1235safe_source_directive(style_check(_)).
1236safe_source_directive(initialization(_)). 1237safe_source_directive(initialization(_,_)). 1238
1239directive_loads_file(use_module(library(X)), X).
1240directive_loads_file(use_module(library(X), _Imports), X).
1241directive_loads_file(load_files(library(X), _Options), X).
1242directive_loads_file(ensure_loaded(library(X)), X).
1243directive_loads_file(include(X), X).
1244
1245safe_path(X) :-
1246 var(X),
1247 !,
1248 instantiation_error(X).
1249safe_path(X) :-
1250 ( atom(X)
1251 ; string(X)
1252 ),
1253 !,
1254 \+ sub_atom(X, 0, _, 0, '..'),
1255 \+ sub_atom(X, 0, _, _, '/'),
1256 \+ sub_atom(X, 0, _, _, '../'),
1257 \+ sub_atom(X, _, _, 0, '/..'),
1258 \+ sub_atom(X, _, _, _, '/../').
1259safe_path(A/B) :-
1260 !,
1261 safe_path(A),
1262 safe_path(B).
1263
1264
1273
1275safe_prolog_flag(generate_debug_info, _).
1276safe_prolog_flag(optimise, _).
1277safe_prolog_flag(occurs_check, _).
1278safe_prolog_flag(write_attributes, _).
1280safe_prolog_flag(var_prefix, _).
1281safe_prolog_flag(double_quotes, _).
1282safe_prolog_flag(back_quotes, _).
1283safe_prolog_flag(rational_syntax, _).
1285safe_prolog_flag(prefer_rationals, _).
1286safe_prolog_flag(float_overflow, _).
1287safe_prolog_flag(float_zero_div, _).
1288safe_prolog_flag(float_undefined, _).
1289safe_prolog_flag(float_underflow, _).
1290safe_prolog_flag(float_rounding, _).
1291safe_prolog_flag(float_rounding, _).
1292safe_prolog_flag(max_rational_size, _).
1293safe_prolog_flag(max_rational_size_action, _).
1295safe_prolog_flag(max_answers_for_subgoal,_).
1296safe_prolog_flag(max_answers_for_subgoal_action,_).
1297safe_prolog_flag(max_table_answer_size,_).
1298safe_prolog_flag(max_table_answer_size_action,_).
1299safe_prolog_flag(max_table_subgoal_size,_).
1300safe_prolog_flag(max_table_subgoal_size_action,_).
1301
1302
1315
1316prolog:sandbox_allowed_expansion(M:G) :-
1317 prolog_load_context(module, M),
1318 !,
1319 debug(sandbox(expansion), 'Expand in ~p: ~p', [M, G]),
1320 safe_goal(M:G).
1321prolog:sandbox_allowed_expansion(_,_).
1322
1326
1327prolog:sandbox_allowed_goal(G) :-
1328 safe_goal(G).
1329
1330
1331 1334
1335:- multifile
1336 prolog:message//1,
1337 prolog:message_context//1,
1338 prolog:error_message//1. 1339
1340prolog:message(error(instantiation_error, Context)) -->
1341 { nonvar(Context),
1342 Context = sandbox(_Goal,Parents),
1343 numbervars(Context, 1, _)
1344 },
1345 [ 'Sandbox restriction!'-[], nl,
1346 'Could not derive which predicate may be called from'-[]
1347 ],
1348 ( { Parents == [] }
1349 -> [ 'Search space too large'-[] ]
1350 ; callers(Parents, 10)
1351 ).
1352
1353prolog:message_context(sandbox(_G, [])) --> !.
1354prolog:message_context(sandbox(_G, Parents)) -->
1355 [ nl, 'Reachable from:'-[] ],
1356 callers(Parents, 10).
1357
1358callers([], _) --> !.
1359callers(_, 0) --> !.
1360callers([G|Parents], Level) -->
1361 { NextLevel is Level-1
1362 },
1363 [ nl, '\t ~p'-[G] ],
1364 callers(Parents, NextLevel).
1365
1366prolog:message(bad_safe_declaration(Goal, File, Line)) -->
1367 [ '~w:~d: Invalid safe_primitive/1 declaration: ~p'-
1368 [File, Line, Goal] ].
1369
1370prolog:error_message(format_error(Format, Types, Args)) -->
1371 format_error(Format, Types, Args).
1372
1373format_error(Format, Types, Args) -->
1374 { length(Types, TypeLen),
1375 length(Args, ArgsLen),
1376 ( TypeLen > ArgsLen
1377 -> Problem = 'not enough'
1378 ; Problem = 'too many'
1379 )
1380 },
1381 [ 'format(~q): ~w arguments (found ~w, need ~w)'-
1382 [Format, Problem, ArgsLen, TypeLen]
1383 ]