34
35:- module(sandbox,
36 [ safe_goal/1, 37 safe_call/1 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, 48 safe_meta_predicate/1, 49 safe_meta/2, 50 safe_global_variable/1, 51 safe_directive/1. 52
54
67
68
69:- meta_predicate
70 safe_goal(:),
71 safe_call(0).
72
82
83safe_call(Goal0) :-
84 expand_goal(Goal0, Goal),
85 safe_goal(Goal),
86 call(Goal).
87
109
110safe_goal(M:Goal) :-
111 empty_assoc(Safe0),
112 catch(safe(Goal, M, [], Safe0, _), E, true),
113 !,
114 nb_delete(sandbox_last_error),
115 ( var(E)
116 -> true
117 ; throw(E)
118 ).
119safe_goal(_) :-
120 nb_current(sandbox_last_error, E),
121 !,
122 nb_delete(sandbox_last_error),
123 throw(E).
124safe_goal(G) :-
125 debug(sandbox(fail), 'safe_goal/1 failed for ~p', [G]),
126 throw(error(instantiation_error, sandbox(G, []))).
127
128
132
133safe(V, _, Parents, _, _) :-
134 var(V),
135 !,
136 Error = error(instantiation_error, sandbox(V, Parents)),
137 nb_setval(sandbox_last_error, Error),
138 throw(Error).
139safe(M:G, _, Parents, Safe0, Safe) :-
140 !,
141 must_be(atom, M),
142 must_be(callable, G),
143 ( predicate_property(M:G, imported_from(M2))
144 -> true
145 ; M2 = M
146 ),
147 ( ( safe_primitive(M2:G)
148 ; safe_primitive(G),
149 predicate_property(G, iso)
150 )
151 -> Safe = Safe0
152 ; ( predicate_property(M:G, exported)
153 ; predicate_property(M:G, public)
154 ; predicate_property(M:G, multifile)
155 ; predicate_property(M:G, iso)
156 ; memberchk(M:_, Parents)
157 )
158 -> safe(G, M, Parents, Safe0, Safe)
159 ; throw(error(permission_error(call, sandboxed, M:G),
160 sandbox(M:G, Parents)))
161 ).
162safe(G, _, Parents, _, _) :-
163 debugging(sandbox(show)),
164 length(Parents, Level),
165 debug(sandbox(show), '[~D] SAFE ~q?', [Level, G]),
166 fail.
167safe(G, _, Parents, Safe, Safe) :-
168 catch(safe_primitive(G),
169 error(instantiation_error, _),
170 rethrow_instantition_error([G|Parents])),
171 predicate_property(G, iso),
172 !.
173safe(G, M, Parents, Safe, Safe) :-
174 ( predicate_property(M:G, imported_from(M2))
175 -> true
176 ; M2 = M
177 ),
178 ( catch(safe_primitive(M2:G),
179 error(instantiation_error, _),
180 rethrow_instantition_error([M2:G|Parents]))
181 ; predicate_property(M2:G, number_of_rules(0))
182 ),
183 !.
184safe(G, M, Parents, Safe0, Safe) :-
185 predicate_property(G, iso),
186 safe_meta_call(G, Called),
187 !,
188 safe_list(Called, M, Parents, Safe0, Safe).
189safe(G, M, Parents, Safe0, Safe) :-
190 ( predicate_property(M:G, imported_from(M2))
191 -> true
192 ; M2 = M
193 ),
194 safe_meta_call(M2:G, Called),
195 !,
196 safe_list(Called, M, Parents, Safe0, Safe).
197safe(G, M, Parents, Safe0, Safe) :-
198 goal_id(M:G, Id, Gen),
199 ( get_assoc(Id, Safe0, _)
200 -> Safe = Safe0
201 ; put_assoc(Id, Safe0, true, Safe1),
202 ( Gen == M:G
203 -> safe_clauses(Gen, M, [Id|Parents], Safe1, Safe)
204 ; catch(safe_clauses(Gen, M, [Id|Parents], Safe1, Safe),
205 error(instantiation_error, Ctx),
206 unsafe(Parents, Ctx))
207 )
208 ),
209 !.
210safe(G, M, Parents, _, _) :-
211 debug(sandbox(fail),
212 'safe/1 failed for ~p (parents:~p)', [M:G, Parents]),
213 fail.
214
215unsafe(Parents, Var) :-
216 var(Var),
217 !,
218 nb_setval(sandbox_last_error,
219 error(instantiation_error, sandbox(_, Parents))),
220 fail.
221unsafe(_Parents, Ctx) :-
222 Ctx = sandbox(_,_),
223 nb_setval(sandbox_last_error,
224 error(instantiation_error, Ctx)),
225 fail.
226
227rethrow_instantition_error(Parents) :-
228 throw(error(instantiation_error, sandbox(_, Parents))).
229
230safe_clauses(G, M, Parents, Safe0, Safe) :-
231 predicate_property(M:G, interpreted),
232 !,
233 def_module(M:G, MD:QG),
234 findall(Ref-Body, clause(MD:QG, Body, Ref), Bodies),
235 safe_bodies(Bodies, MD, Parents, Safe0, Safe).
236safe_clauses(G, M, [_|Parents], _, _) :-
237 predicate_property(M:G, visible),
238 !,
239 throw(error(permission_error(call, sandboxed, G),
240 sandbox(M:G, Parents))).
241safe_clauses(_, _, [G|Parents], _, _) :-
242 throw(error(existence_error(procedure, G),
243 sandbox(G, Parents))).
244
250
251safe_bodies([], _, _, Safe, Safe).
252safe_bodies([Ref-H|T], M, Parents, Safe0, Safe) :-
253 ( H = M2:H2, nonvar(M2),
254 clause_property(Ref, module(M2))
255 -> copy_term(H2, H3),
256 CM = M2
257 ; copy_term(H, H3),
258 CM = M
259 ),
260 safe(H3, CM, Parents, Safe0, Safe1),
261 safe_bodies(T, M, Parents, Safe1, Safe).
262
263def_module(M:G, MD:QG) :-
264 predicate_property(M:G, imported_from(MD)),
265 !,
266 meta_qualify(MD:G, M, QG).
267def_module(M:G, M:QG) :-
268 meta_qualify(M:G, M, QG).
269
275
276safe_list([], _, _, Safe, Safe).
277safe_list([H|T], M, Parents, Safe0, Safe) :-
278 ( H = M2:H2,
279 M == M2 % in our context
280 -> copy_term(H2, H3)
281 ; copy_term(H, H3) % cross-module call
282 ),
283 safe(H3, M, Parents, Safe0, Safe1),
284 safe_list(T, M, Parents, Safe1, Safe).
285
289
290meta_qualify(MD:G, M, QG) :-
291 predicate_property(MD:G, meta_predicate(Head)),
292 !,
293 G =.. [Name|Args],
294 Head =.. [_|Q],
295 qualify_args(Q, M, Args, QArgs),
296 QG =.. [Name|QArgs].
297meta_qualify(_:G, _, G).
298
299qualify_args([], _, [], []).
300qualify_args([H|T], M, [A|AT], [Q|QT]) :-
301 qualify_arg(H, M, A, Q),
302 qualify_args(T, M, AT, QT).
303
304qualify_arg(S, M, A, Q) :-
305 q_arg(S),
306 !,
307 qualify(A, M, Q).
308qualify_arg(_, _, A, A).
309
310q_arg(I) :- integer(I), !.
311q_arg(:).
312q_arg(^).
313q_arg(//).
314
315qualify(A, M, MZ:Q) :-
316 strip_module(M:A, MZ, Q).
317
327
328goal_id(M:Goal, M:Id, Gen) :-
329 !,
330 goal_id(Goal, Id, Gen).
331goal_id(Var, _, _) :-
332 var(Var),
333 !,
334 instantiation_error(Var).
335goal_id(Atom, Atom, Atom) :-
336 atom(Atom),
337 !.
338goal_id(Term, _, _) :-
339 \+ compound(Term),
340 !,
341 type_error(callable, Term).
342goal_id(Term, Skolem, Gen) :- 343 compound_name_arity(Term, Name, Arity),
344 compound_name_arity(Skolem, Name, Arity),
345 compound_name_arity(Gen, Name, Arity),
346 copy_goal_args(1, Term, Skolem, Gen),
347 ( Gen =@= Term
348 -> ! 349 ; true
350 ),
351 numbervars(Skolem, 0, _).
352goal_id(Term, Skolem, Term) :- 353 debug(sandbox(specify), 'Retrying with ~p', [Term]),
354 copy_term(Term, Skolem),
355 numbervars(Skolem, 0, _).
356
361
362copy_goal_args(I, Term, Skolem, Gen) :-
363 arg(I, Term, TA),
364 !,
365 arg(I, Skolem, SA),
366 arg(I, Gen, GA),
367 copy_goal_arg(TA, SA, GA),
368 I2 is I + 1,
369 copy_goal_args(I2, Term, Skolem, Gen).
370copy_goal_args(_, _, _, _).
371
372copy_goal_arg(Arg, SArg, Arg) :-
373 copy_goal_arg(Arg),
374 !,
375 copy_term(Arg, SArg).
376copy_goal_arg(_, _, _).
377
378copy_goal_arg(Var) :- var(Var), !, fail.
379copy_goal_arg(_:_).
380
390
391term_expansion(safe_primitive(Goal), Term) :-
392 ( verify_safe_declaration(Goal)
393 -> Term = safe_primitive(Goal)
394 ; Term = []
395 ).
396
397system:term_expansion(sandbox:safe_primitive(Goal), Term) :-
398 \+ current_prolog_flag(xref, true),
399 ( verify_safe_declaration(Goal)
400 -> Term = sandbox:safe_primitive(Goal)
401 ; Term = []
402 ).
403
404verify_safe_declaration(Var) :-
405 var(Var),
406 !,
407 instantiation_error(Var).
408verify_safe_declaration(Module:Goal) :-
409 must_be(atom, Module),
410 must_be(callable, Goal),
411 ( ok_meta(Module:Goal)
412 -> true
413 ; ( predicate_property(Module:Goal, visible)
414 -> true
415 ; predicate_property(Module:Goal, foreign)
416 ),
417 \+ predicate_property(Module:Goal, imported_from(_)),
418 \+ predicate_property(Module:Goal, meta_predicate(_))
419 -> true
420 ; permission_error(declare, safe_goal, Module:Goal)
421 ).
422verify_safe_declaration(Goal) :-
423 must_be(callable, Goal),
424 ( predicate_property(system:Goal, iso),
425 \+ predicate_property(system:Goal, meta_predicate())
426 -> true
427 ; permission_error(declare, safe_goal, Goal)
428 ).
429
430ok_meta(system:assert(_)).
431ok_meta(system:use_module(_,_)).
432ok_meta(system:use_module(_)).
433
434verify_predefined_safe_declarations :-
435 forall(clause(safe_primitive(Goal), _Body, Ref),
436 ( catch(verify_safe_declaration(Goal), E, true),
437 ( nonvar(E)
438 -> clause_property(Ref, file(File)),
439 clause_property(Ref, line_count(Line)),
440 print_message(error, bad_safe_declaration(Goal, File, Line))
441 ; true
442 )
443 )).
444
445:- initialization(verify_predefined_safe_declarations, now).
446
458
460
461safe_primitive(true).
462safe_primitive(fail).
463safe_primitive(system:false).
464safe_primitive(repeat).
465safe_primitive(!).
466 467safe_primitive(var(_)).
468safe_primitive(nonvar(_)).
469safe_primitive(system:attvar(_)).
470safe_primitive(integer(_)).
471safe_primitive(float(_)).
472safe_primitive(system:rational(_)).
473safe_primitive(number(_)).
474safe_primitive(atom(_)).
475safe_primitive(system:blob(_,_)).
476safe_primitive(system:string(_)).
477safe_primitive(atomic(_)).
478safe_primitive(compound(_)).
479safe_primitive(callable(_)).
480safe_primitive(ground(_)).
481safe_primitive(system:cyclic_term(_)).
482safe_primitive(acyclic_term(_)).
483safe_primitive(system:is_stream(_)).
484safe_primitive(system:'$is_char'(_)).
485safe_primitive(system:'$is_char_code'(_)).
486safe_primitive(system:'$is_char_list'(_,_)).
487safe_primitive(system:'$is_code_list'(_,_)).
488 489safe_primitive(@>(_,_)).
490safe_primitive(@>=(_,_)).
491safe_primitive(==(_,_)).
492safe_primitive(@<(_,_)).
493safe_primitive(@=<(_,_)).
494safe_primitive(compare(_,_,_)).
495safe_primitive(sort(_,_)).
496safe_primitive(keysort(_,_)).
497safe_primitive(system: =@=(_,_)).
498safe_primitive(system:'$btree_find_node'(_,_,_,_)).
499
500 501safe_primitive(=(_,_)).
502safe_primitive(\=(_,_)).
503safe_primitive(system:'?='(_,_)).
504safe_primitive(system:unifiable(_,_,_)).
505safe_primitive(unify_with_occurs_check(_,_)).
506safe_primitive(\==(_,_)).
507 508safe_primitive(is(_,_)).
509safe_primitive(>(_,_)).
510safe_primitive(>=(_,_)).
511safe_primitive(=:=(_,_)).
512safe_primitive(=\=(_,_)).
513safe_primitive(=<(_,_)).
514safe_primitive(<(_,_)).
515 516safe_primitive(arg(_,_,_)).
517safe_primitive(system:setarg(_,_,_)).
518safe_primitive(system:nb_setarg(_,_,_)).
519safe_primitive(system:nb_linkarg(_,_,_)).
520safe_primitive(functor(_,_,_)).
521safe_primitive(_ =.. _).
522safe_primitive(system:compound_name_arity(_,_,_)).
523safe_primitive(system:compound_name_arguments(_,_,_)).
524safe_primitive(system:'$filled_array'(_,_,_,_)).
525safe_primitive(copy_term(_,_)).
526safe_primitive(system:duplicate_term(_,_)).
527safe_primitive(system:copy_term_nat(_,_)).
528safe_primitive(numbervars(_,_,_)).
529safe_primitive(subsumes_term(_,_)).
530safe_primitive(system:term_hash(_,_)).
531safe_primitive(system:term_hash(_,_,_,_)).
532safe_primitive(system:variant_sha1(_,_)).
533safe_primitive(system:variant_hash(_,_)).
534safe_primitive(system:'$term_size'(_,_,_)).
535
536 537safe_primitive(system:is_dict(_)).
538safe_primitive(system:is_dict(_,_)).
539safe_primitive(system:get_dict(_,_,_)).
540safe_primitive(system:get_dict(_,_,_,_,_)).
541safe_primitive(system:'$get_dict_ex'(_,_,_)).
542safe_primitive(system:dict_create(_,_,_)).
543safe_primitive(system:dict_pairs(_,_,_)).
544safe_primitive(system:put_dict(_,_,_)).
545safe_primitive(system:put_dict(_,_,_,_)).
546safe_primitive(system:del_dict(_,_,_,_)).
547safe_primitive(system:select_dict(_,_,_)).
548safe_primitive(system:b_set_dict(_,_,_)).
549safe_primitive(system:nb_set_dict(_,_,_)).
550safe_primitive(system:nb_link_dict(_,_,_)).
551safe_primitive(system:(:<(_,_))).
552safe_primitive(system:(>:<(_,_))).
553 554safe_primitive(atom_chars(_, _)).
555safe_primitive(atom_codes(_, _)).
556safe_primitive(sub_atom(_,_,_,_,_)).
557safe_primitive(atom_concat(_,_,_)).
558safe_primitive(atom_length(_,_)).
559safe_primitive(char_code(_,_)).
560safe_primitive(system:name(_,_)).
561safe_primitive(system:atomic_concat(_,_,_)).
562safe_primitive(system:atomic_list_concat(_,_)).
563safe_primitive(system:atomic_list_concat(_,_,_)).
564safe_primitive(system:downcase_atom(_,_)).
565safe_primitive(system:upcase_atom(_,_)).
566safe_primitive(system:char_type(_,_)).
567safe_primitive(system:normalize_space(_,_)).
568safe_primitive(system:sub_atom_icasechk(_,_,_)).
569 570safe_primitive(number_codes(_,_)).
571safe_primitive(number_chars(_,_)).
572safe_primitive(system:atom_number(_,_)).
573safe_primitive(system:code_type(_,_)).
574 575safe_primitive(system:atom_string(_,_)).
576safe_primitive(system:number_string(_,_)).
577safe_primitive(system:string_chars(_, _)).
578safe_primitive(system:string_codes(_, _)).
579safe_primitive(system:string_code(_,_,_)).
580safe_primitive(system:sub_string(_,_,_,_,_)).
581safe_primitive(system:split_string(_,_,_,_)).
582safe_primitive(system:atomics_to_string(_,_,_)).
583safe_primitive(system:atomics_to_string(_,_)).
584safe_primitive(system:string_concat(_,_,_)).
585safe_primitive(system:string_length(_,_)).
586safe_primitive(system:string_lower(_,_)).
587safe_primitive(system:string_upper(_,_)).
588safe_primitive(system:term_string(_,_)).
589safe_primitive('$syspreds':term_string(_,_,_)).
590 591safe_primitive(length(_,_)).
592 593safe_primitive(throw(_)).
594safe_primitive(system:abort).
595 596safe_primitive(current_prolog_flag(_,_)).
597safe_primitive(current_op(_,_,_)).
598safe_primitive(system:sleep(_)).
599safe_primitive(system:thread_self(_)).
600safe_primitive(system:get_time(_)).
601safe_primitive(system:statistics(_,_)).
602safe_primitive(system:thread_statistics(Id,_,_)) :-
603 ( var(Id)
604 -> instantiation_error(Id)
605 ; thread_self(Id)
606 ).
607safe_primitive(system:thread_property(Id,_)) :-
608 ( var(Id)
609 -> instantiation_error(Id)
610 ; thread_self(Id)
611 ).
612safe_primitive(system:format_time(_,_,_)).
613safe_primitive(system:format_time(_,_,_,_)).
614safe_primitive(system:date_time_stamp(_,_)).
615safe_primitive(system:stamp_date_time(_,_,_)).
616safe_primitive(system:strip_module(_,_,_)).
617safe_primitive('$messages':message_to_string(_,_)).
618safe_primitive(system:import_module(_,_)).
619safe_primitive(system:file_base_name(_,_)).
620safe_primitive(system:file_directory_name(_,_)).
621safe_primitive(system:file_name_extension(_,_,_)).
622
623safe_primitive(clause(H,_)) :- safe_clause(H).
624safe_primitive(asserta(X)) :- safe_assert(X).
625safe_primitive(assertz(X)) :- safe_assert(X).
626safe_primitive(retract(X)) :- safe_assert(X).
627safe_primitive(retractall(X)) :- safe_assert(X).
628
632safe_primitive('$dicts':'.'(_,K,_)) :- atom(K).
633safe_primitive('$dicts':'.'(_,K,_)) :-
634 ( nonvar(K)
635 -> dict_built_in(K)
636 ; instantiation_error(K)
637 ).
638
639dict_built_in(get(_)).
640dict_built_in(put(_)).
641dict_built_in(put(_,_)).
642
645
646safe_primitive(system:false).
647safe_primitive(system:cyclic_term(_)).
648safe_primitive(system:msort(_,_)).
649safe_primitive(system:sort(_,_,_,_)).
650safe_primitive(system:between(_,_,_)).
651safe_primitive(system:succ(_,_)).
652safe_primitive(system:plus(_,_,_)).
653safe_primitive(system:term_variables(_,_)).
654safe_primitive(system:'$term_size'(_,_,_)).
655safe_primitive(system:atom_to_term(_,_,_)).
656safe_primitive(system:term_to_atom(_,_)).
657safe_primitive(system:atomic_list_concat(_,_,_)).
658safe_primitive(system:atomic_list_concat(_,_)).
659safe_primitive(system:downcase_atom(_,_)).
660safe_primitive(system:upcase_atom(_,_)).
661safe_primitive(system:is_list(_)).
662safe_primitive(system:memberchk(_,_)).
663safe_primitive(system:'$skip_list'(_,_,_)).
664 665safe_primitive(system:get_attr(_,_,_)).
666safe_primitive(system:get_attrs(_,_)).
667safe_primitive(system:term_attvars(_,_)).
668safe_primitive(system:del_attr(_,_)).
669safe_primitive(system:del_attrs(_)).
670safe_primitive('$attvar':copy_term(_,_,_)).
671 672safe_primitive(system:b_getval(_,_)).
673safe_primitive(system:b_setval(Var,_)) :-
674 safe_global_var(Var).
675safe_primitive(system:nb_getval(_,_)).
676safe_primitive('$syspreds':nb_setval(Var,_)) :-
677 safe_global_var(Var).
678safe_primitive(system:nb_current(_,_)).
679 680safe_primitive(system:assert(X)) :-
681 safe_assert(X).
682 683safe_primitive(system:writeln(_)).
684safe_primitive('$messages':print_message(_,_)).
685
686 687safe_primitive('$syspreds':set_prolog_stack(Stack, limit(ByteExpr))) :-
688 nonvar(Stack),
689 stack_name(Stack),
690 catch(Bytes is ByteExpr, _, fail),
691 prolog_stack_property(Stack, limit(Current)),
692 Bytes =< Current.
693
694stack_name(global).
695stack_name(local).
696stack_name(trail).
697
698
701
702safe_primitive(system:use_module(Spec, _Import)) :-
703 safe_primitive(system:use_module(Spec)).
704safe_primitive(system:use_module(Spec)) :-
705 ground(Spec),
706 ( atom(Spec)
707 -> Path = Spec
708 ; Spec =.. [_Alias, Segments],
709 phrase(segments_to_path(Segments), List),
710 atomic_list_concat(List, Path)
711 ),
712 \+ is_absolute_file_name(Path),
713 \+ sub_atom(Path, _, _, _, '/../'),
714 absolute_file_name(Spec, AbsFile,
715 [ access(read),
716 file_type(prolog),
717 file_errors(fail)
718 ]),
719 file_name_extension(_, Ext, AbsFile),
720 save_extension(Ext).
721
724
725segments_to_path(A/B) -->
726 !,
727 segments_to_path(A),
728 [/],
729 segments_to_path(B).
730segments_to_path(X) -->
731 [X].
732
733save_extension(pl).
734
741
742safe_assert(C) :- cyclic_term(C), !, fail.
743safe_assert(X) :- var(X), !, fail.
744safe_assert(_Head:-_Body) :- !, fail.
745safe_assert(_:_) :- !, fail.
746safe_assert(_).
747
753
754safe_clause(H) :- var(H), !.
755safe_clause(_:_) :- !, fail.
756safe_clause(_).
757
758
763
764safe_global_var(Name) :-
765 var(Name),
766 !,
767 instantiation_error(Name).
768safe_global_var(Name) :-
769 safe_global_variable(Name).
770
774
775
780
781safe_meta(system:put_attr(V,M,A), Called) :-
782 !,
783 ( atom(M)
784 -> attr_hook_predicates([ attr_unify_hook(A, _),
785 attribute_goals(V,_,_),
786 project_attributes(_,_)
787 ], M, Called)
788 ; instantiation_error(M)
789 ).
790safe_meta(system:with_output_to(Output, G), [G]) :-
791 safe_output(Output),
792 !.
793safe_meta(system:format(Format, Args), Calls) :-
794 format_calls(Format, Args, Calls).
795safe_meta(system:format(Output, Format, Args), Calls) :-
796 safe_output(Output),
797 format_calls(Format, Args, Calls).
798safe_meta(prolog_debug:debug(_Term, Format, Args), Calls) :-
799 format_calls(Format, Args, Calls).
800safe_meta('$attvar':freeze(_Var,Goal), [Goal]).
801safe_meta(phrase(NT,Xs0,Xs), [Goal]) :- 802 expand_nt(NT,Xs0,Xs,Goal).
803safe_meta(phrase(NT,Xs0), [Goal]) :-
804 expand_nt(NT,Xs0,[],Goal).
805safe_meta('$dcg':call_dcg(NT,Xs0,Xs), [Goal]) :-
806 expand_nt(NT,Xs0,Xs,Goal).
807safe_meta('$dcg':call_dcg(NT,Xs0), [Goal]) :-
808 expand_nt(NT,Xs0,[],Goal).
809
817
818attr_hook_predicates([], _, []).
819attr_hook_predicates([H|T], M, Called) :-
820 ( predicate_property(M:H, defined)
821 -> Called = [M:H|Rest]
822 ; Called = Rest
823 ),
824 attr_hook_predicates(T, M, Rest).
825
826
831
832expand_nt(NT, _Xs0, _Xs, _NewGoal) :-
833 strip_module(NT, _, Plain),
834 var(Plain),
835 !,
836 instantiation_error(Plain).
837expand_nt(NT, Xs0, Xs, NewGoal) :-
838 dcg_translate_rule((pseudo_nt --> NT),
839 (pseudo_nt(Xs0c,Xsc) :- NewGoal0)),
840 ( var(Xsc), Xsc \== Xs0c
841 -> Xs = Xsc, NewGoal1 = NewGoal0
842 ; NewGoal1 = (NewGoal0, Xsc = Xs)
843 ),
844 ( var(Xs0c)
845 -> Xs0 = Xs0c,
846 NewGoal = NewGoal1
847 ; NewGoal = ( Xs0 = Xs0c, NewGoal1 )
848 ).
849
854
855safe_meta_call(Goal, _Called) :-
856 debug(sandbox(meta), 'Safe meta ~p?', [Goal]),
857 fail.
858safe_meta_call(Goal, Called) :-
859 safe_meta(Goal, Called),
860 !. 861safe_meta_call(Goal, Called) :-
862 Goal = M:Plain,
863 compound(Plain),
864 compound_name_arity(Plain, Name, Arity),
865 safe_meta_predicate(M:Name/Arity),
866 predicate_property(Goal, meta_predicate(Spec)),
867 !,
868 findall(C, called(Spec, Plain, C), Called).
869safe_meta_call(M:Goal, Called) :-
870 !,
871 generic_goal(Goal, Gen),
872 safe_meta(M:Gen),
873 findall(C, called(Gen, Goal, C), Called).
874safe_meta_call(Goal, Called) :-
875 generic_goal(Goal, Gen),
876 safe_meta(Gen),
877 findall(C, called(Gen, Goal, C), Called).
878
879called(Gen, Goal, Called) :-
880 arg(I, Gen, Spec),
881 calling_meta_spec(Spec),
882 arg(I, Goal, Called0),
883 extend(Spec, Called0, Called).
884
885generic_goal(G, Gen) :-
886 functor(G, Name, Arity),
887 functor(Gen, Name, Arity).
888
889calling_meta_spec(V) :- var(V), !, fail.
890calling_meta_spec(I) :- integer(I), !.
891calling_meta_spec(^).
892calling_meta_spec(//).
893
894
895extend(^, G, Plain) :-
896 !,
897 strip_existential(G, Plain).
898extend(//, DCG, Goal) :-
899 !,
900 ( expand_phrase(call_dcg(DCG,_,_), Goal)
901 -> true
902 ; instantiation_error(DCG) 903 ). 904extend(0, G, G) :- !.
905extend(I, M:G0, M:G) :-
906 !,
907 G0 =.. List,
908 length(Extra, I),
909 append(List, Extra, All),
910 G =.. All.
911extend(I, G0, G) :-
912 G0 =.. List,
913 length(Extra, I),
914 append(List, Extra, All),
915 G =.. All.
916
917strip_existential(Var, Var) :-
918 var(Var),
919 !.
920strip_existential(M:G0, M:G) :-
921 !,
922 strip_existential(G0, G).
923strip_existential(_^G0, G) :-
924 !,
925 strip_existential(G0, G).
926strip_existential(G, G).
927
929
930safe_meta((0,0)).
931safe_meta((0;0)).
932safe_meta((0->0)).
933safe_meta(system:(0*->0)).
934safe_meta(catch(0,*,0)).
935safe_meta(findall(*,0,*)).
936safe_meta('$bags':findall(*,0,*,*)).
937safe_meta(setof(*,^,*)).
938safe_meta(bagof(*,^,*)).
939safe_meta('$bags':findnsols(*,*,0,*)).
940safe_meta('$bags':findnsols(*,*,0,*,*)).
941safe_meta(system:call_cleanup(0,0)).
942safe_meta(system:setup_call_cleanup(0,0,0)).
943safe_meta(system:setup_call_catcher_cleanup(0,0,*,0)).
944safe_meta('$attvar':call_residue_vars(0,*)).
945safe_meta('$syspreds':call_with_inference_limit(0,*,*)).
946safe_meta('$syspreds':call_with_depth_limit(0,*,*)).
947safe_meta(^(*,0)).
948safe_meta(\+(0)).
949safe_meta(call(0)).
950safe_meta(call(1,*)).
951safe_meta(call(2,*,*)).
952safe_meta(call(3,*,*,*)).
953safe_meta(call(4,*,*,*,*)).
954safe_meta(call(5,*,*,*,*,*)).
955safe_meta(call(6,*,*,*,*,*,*)).
956
957
962
963safe_output(Output) :-
964 var(Output),
965 !,
966 instantiation_error(Output).
967safe_output(atom(_)).
968safe_output(string(_)).
969safe_output(codes(_)).
970safe_output(codes(_,_)).
971safe_output(chars(_)).
972safe_output(chars(_,_)).
973safe_output(current_output).
974safe_output(current_error).
975
979
980:- public format_calls/3. 981
982format_calls(Format, _Args, _Calls) :-
983 var(Format),
984 !,
985 instantiation_error(Format).
986format_calls(Format, Args, Calls) :-
987 format_types(Format, Types),
988 ( format_callables(Types, Args, Calls)
989 -> true
990 ; throw(error(format_error(Format, Types, Args), _))
991 ).
992
993format_callables([], [], []).
994format_callables([callable|TT], [G|TA], [G|TG]) :-
995 !,
996 format_callables(TT, TA, TG).
997format_callables([_|TT], [_|TA], TG) :-
998 !,
999 format_callables(TT, TA, TG).
1000
1001
1002 1005
1006:- multifile
1007 prolog:sandbox_allowed_directive/1,
1008 prolog:sandbox_allowed_goal/1,
1009 prolog:sandbox_allowed_expansion/1.
1010
1014
1015prolog:sandbox_allowed_directive(Directive) :-
1016 debug(sandbox(directive), 'Directive: ~p', [Directive]),
1017 fail.
1018prolog:sandbox_allowed_directive(Directive) :-
1019 safe_directive(Directive),
1020 !.
1021prolog:sandbox_allowed_directive(M:PredAttr) :-
1022 \+ prolog_load_context(module, M),
1023 !,
1024 debug(sandbox(directive), 'Cross-module directive', []),
1025 permission_error(execute, sandboxed_directive, (:- M:PredAttr)).
1026prolog:sandbox_allowed_directive(M:PredAttr) :-
1027 safe_pattr(PredAttr),
1028 !,
1029 PredAttr =.. [Attr, Preds],
1030 ( safe_pattr(Preds, Attr)
1031 -> true
1032 ; permission_error(execute, sandboxed_directive, (:- M:PredAttr))
1033 ).
1034prolog:sandbox_allowed_directive(_:Directive) :-
1035 safe_source_directive(Directive),
1036 !.
1037prolog:sandbox_allowed_directive(_:Directive) :-
1038 directive_loads_file(Directive, File),
1039 !,
1040 safe_path(File).
1041prolog:sandbox_allowed_directive(G) :-
1042 safe_goal(G).
1043
1058
1059
1060safe_pattr(dynamic(_)).
1061safe_pattr(thread_local(_)).
1062safe_pattr(volatile(_)).
1063safe_pattr(discontiguous(_)).
1064safe_pattr(multifile(_)).
1065safe_pattr(public(_)).
1066safe_pattr(meta_predicate(_)).
1067
1068safe_pattr(Var, _) :-
1069 var(Var),
1070 !,
1071 instantiation_error(Var).
1072safe_pattr((A,B), Attr) :-
1073 !,
1074 safe_pattr(A, Attr),
1075 safe_pattr(B, Attr).
1076safe_pattr(M:G, Attr) :-
1077 !,
1078 ( atom(M),
1079 prolog_load_context(module, M)
1080 -> true
1081 ; Goal =.. [Attr,M:G],
1082 permission_error(directive, sandboxed, (:- Goal))
1083 ).
1084safe_pattr(_, _).
1085
1086safe_source_directive(op(_,_,Name)) :-
1087 !,
1088 ( atom(Name)
1089 -> true
1090 ; is_list(Name),
1091 maplist(atom, Name)
1092 ).
1093safe_source_directive(set_prolog_flag(Flag, Value)) :-
1094 !,
1095 atom(Flag), ground(Value),
1096 safe_directive_flag(Flag, Value).
1097safe_source_directive(style_check(_)).
1098safe_source_directive(initialization(_)). 1099safe_source_directive(initialization(_,_)). 1100
1101directive_loads_file(use_module(library(X)), X).
1102directive_loads_file(use_module(library(X), _Imports), X).
1103directive_loads_file(ensure_loaded(library(X)), X).
1104directive_loads_file(include(X), X).
1105
1106safe_path(X) :-
1107 var(X),
1108 !,
1109 instantiation_error(X).
1110safe_path(X) :-
1111 ( atom(X)
1112 ; string(X)
1113 ),
1114 !,
1115 \+ sub_atom(X, 0, _, 0, '..'),
1116 \+ sub_atom(X, 0, _, _, '/'),
1117 \+ sub_atom(X, 0, _, _, '../'),
1118 \+ sub_atom(X, _, _, 0, '/..'),
1119 \+ sub_atom(X, _, _, _, '/../').
1120safe_path(A/B) :-
1121 !,
1122 safe_path(A),
1123 safe_path(B).
1124
1125
1134
1135safe_directive_flag(generate_debug_info, _).
1136safe_directive_flag(var_prefix, _).
1137safe_directive_flag(double_quotes, _).
1138safe_directive_flag(back_quotes, _).
1139
1152
1153prolog:sandbox_allowed_expansion(Directive) :-
1154 prolog_load_context(module, M),
1155 debug(sandbox(expansion), 'Expand in ~p: ~p', [M, Directive]),
1156 fail.
1157prolog:sandbox_allowed_expansion(M:G) :-
1158 prolog_load_context(module, M),
1159 !,
1160 safe_goal(M:G).
1161prolog:sandbox_allowed_expansion(_,_).
1162
1166
1167prolog:sandbox_allowed_goal(G) :-
1168 safe_goal(G).
1169
1170
1171 1174
1175:- multifile
1176 prolog:message//1,
1177 prolog:message_context//1,
1178 prolog:error_message//1.
1179
1180prolog:message_context(sandbox(_G, [])) --> !.
1181prolog:message_context(sandbox(_G, Parents)) -->
1182 [ nl, 'Reachable from:'-[] ],
1183 callers(Parents, 10).
1184
1185callers([], _) --> !.
1186callers(_, 0) --> !.
1187callers([G|Parents], Level) -->
1188 { NextLevel is Level-1
1189 },
1190 [ nl, '\t ~p'-[G] ],
1191 callers(Parents, NextLevel).
1192
1193prolog:message(bad_safe_declaration(Goal, File, Line)) -->
1194 [ '~w:~d: Invalid safe_primitive/1 declaration: ~p'-
1195 [File, Line, Goal] ].
1196
1197prolog:error_message(format_error(Format, Types, Args)) -->
1198 format_error(Format, Types, Args).
1199
1200format_error(Format, Types, Args) -->
1201 { length(Types, TypeLen),
1202 length(Args, ArgsLen),
1203 ( TypeLen > ArgsLen
1204 -> Problem = 'not enough'
1205 ; Problem = 'too many'
1206 )
1207 },
1208 [ 'format(~q): ~w arguments (found ~w, need ~w)'-
1209 [Format, Problem, ArgsLen, TypeLen]
1210 ].