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_singletons(_,_)).
729safe_primitive(system:term_variables(_,_)).
730safe_primitive(system:term_variables(_,_,_)).
731safe_primitive(system:'$term_size'(_,_,_)).
732safe_primitive(system:atom_to_term(_,_,_)).
733safe_primitive(system:term_to_atom(_,_)).
734safe_primitive(system:atomic_list_concat(_,_,_)).
735safe_primitive(system:atomic_list_concat(_,_)).
736safe_primitive(system:downcase_atom(_,_)).
737safe_primitive(system:upcase_atom(_,_)).
738safe_primitive(system:is_list(_)).
739safe_primitive(system:memberchk(_,_)).
740safe_primitive(system:'$skip_list'(_,_,_)).
741safe_primitive(system:'$seek_list'(_, _, _, _)).
742 743safe_primitive(system:get_attr(_,_,_)).
744safe_primitive(system:get_attrs(_,_)).
745safe_primitive(system:term_attvars(_,_)).
746safe_primitive(system:del_attr(_,_)).
747safe_primitive(system:del_attrs(_)).
748safe_primitive('$attvar':copy_term(_,_,_)).
749 750safe_primitive(system:b_getval(_,_)).
751safe_primitive(system:b_setval(Var,_)) :-
752 safe_global_var(Var).
753safe_primitive(system:nb_getval(_,_)).
754safe_primitive('$syspreds':nb_setval(Var,_)) :-
755 safe_global_var(Var).
756safe_primitive(system:nb_linkval(Var,_)) :-
757 safe_global_var(Var).
758safe_primitive(system:nb_current(_,_)).
759 760safe_primitive(system:assert(X)) :-
761 safe_assert(X).
762 763safe_primitive(system:writeln(_)).
764safe_primitive('$messages':print_message(_,_)).
765
766 767safe_primitive('$syspreds':set_prolog_stack(Stack, limit(ByteExpr))) :-
768 nonvar(Stack),
769 stack_name(Stack),
770 catch(Bytes is ByteExpr, _, fail),
771 prolog_stack_property(Stack, limit(Current)),
772 Bytes =< Current.
773
774stack_name(global).
775stack_name(local).
776stack_name(trail).
777
778safe_primitive('$tabling':abolish_all_tables).
779safe_primitive('$tabling':'$wrap_tabled'(Module:_Head, _Mode)) :-
780 prolog_load_context(module, Module),
781 !.
782safe_primitive('$tabling':'$moded_wrap_tabled'(Module:_Head,_,_,_,_)) :-
783 prolog_load_context(module, Module),
784 !.
785
786
789
790safe_primitive(system:use_module(Spec, _Import)) :-
791 safe_primitive(system:use_module(Spec)).
792safe_primitive(system:load_files(Spec, Options)) :-
793 safe_primitive(system:use_module(Spec)),
794 maplist(safe_load_file_option, Options).
795safe_primitive(system:use_module(Spec)) :-
796 ground(Spec),
797 ( atom(Spec)
798 -> Path = Spec
799 ; Spec =.. [_Alias, Segments],
800 phrase(segments_to_path(Segments), List),
801 atomic_list_concat(List, Path)
802 ),
803 \+ is_absolute_file_name(Path),
804 \+ sub_atom(Path, _, _, _, '/../'),
805 absolute_file_name(Spec, AbsFile,
806 [ access(read),
807 file_type(prolog),
808 file_errors(fail)
809 ]),
810 file_name_extension(_, Ext, AbsFile),
811 save_extension(Ext).
812
815
816segments_to_path(A/B) -->
817 !,
818 segments_to_path(A),
819 [/],
820 segments_to_path(B).
821segments_to_path(X) -->
822 [X].
823
824save_extension(pl).
825
826safe_load_file_option(if(changed)).
827safe_load_file_option(if(not_loaded)).
828safe_load_file_option(must_be_module(_)).
829safe_load_file_option(optimise(_)).
830safe_load_file_option(silent(_)).
831
838
839safe_assert(C) :- cyclic_term(C), !, fail.
840safe_assert(X) :- var(X), !, fail.
841safe_assert(_Head:-_Body) :- !, fail.
842safe_assert(_:_) :- !, fail.
843safe_assert(_).
844
850
851safe_clause(H) :- var(H), !.
852safe_clause(_:_) :- !, fail.
853safe_clause(_).
854
855
860
861safe_global_var(Name) :-
862 var(Name),
863 !,
864 instantiation_error(Name).
865safe_global_var(Name) :-
866 safe_global_variable(Name).
867
871
875
876safe_current_predicate(X) :-
877 nonvar(X),
878 X = _:_, !,
879 fail.
880safe_current_predicate(_).
881
886
887safe_meta(system:put_attr(V,M,A), Called) :-
888 !,
889 ( atom(M)
890 -> attr_hook_predicates([ attr_unify_hook(A, _),
891 attribute_goals(V,_,_),
892 project_attributes(_,_)
893 ], M, Called)
894 ; instantiation_error(M)
895 ).
896safe_meta(system:with_output_to(Output, G), [G]) :-
897 safe_output(Output),
898 !.
899safe_meta(system:format(Format, Args), Calls) :-
900 format_calls(Format, Args, Calls).
901safe_meta(system:format(Output, Format, Args), Calls) :-
902 safe_output(Output),
903 format_calls(Format, Args, Calls).
904safe_meta(prolog_debug:debug(_Term, Format, Args), Calls) :-
905 format_calls(Format, Args, Calls).
906safe_meta(system:set_prolog_flag(Flag, Value), []) :-
907 atom(Flag),
908 safe_prolog_flag(Flag, Value).
909safe_meta('$attvar':freeze(_Var,Goal), [Goal]).
910safe_meta(phrase(NT,Xs0,Xs), [Goal]) :- 911 expand_nt(NT,Xs0,Xs,Goal).
912safe_meta(phrase(NT,Xs0), [Goal]) :-
913 expand_nt(NT,Xs0,[],Goal).
914safe_meta('$dcg':call_dcg(NT,Xs0,Xs), [Goal]) :-
915 expand_nt(NT,Xs0,Xs,Goal).
916safe_meta('$dcg':call_dcg(NT,Xs0), [Goal]) :-
917 expand_nt(NT,Xs0,[],Goal).
918safe_meta('$tabling':abolish_table_subgoals(V), []) :-
919 \+ qualified(V).
920safe_meta('$tabling':current_table(V, _), []) :-
921 \+ qualified(V).
922safe_meta('$tabling':tnot(G), [G]).
923safe_meta('$tabling':not_exists(G), [G]).
924
925qualified(V) :-
926 nonvar(V),
927 V = _:_.
928
936
937attr_hook_predicates([], _, []).
938attr_hook_predicates([H|T], M, Called) :-
939 ( predicate_property(M:H, defined)
940 -> Called = [M:H|Rest]
941 ; Called = Rest
942 ),
943 attr_hook_predicates(T, M, Rest).
944
945
950
951expand_nt(NT, _Xs0, _Xs, _NewGoal) :-
952 strip_module(NT, _, Plain),
953 var(Plain),
954 !,
955 instantiation_error(Plain).
956expand_nt(NT, Xs0, Xs, NewGoal) :-
957 dcg_translate_rule((pseudo_nt --> NT),
958 (pseudo_nt(Xs0c,Xsc) :- NewGoal0)),
959 ( var(Xsc), Xsc \== Xs0c
960 -> Xs = Xsc, NewGoal1 = NewGoal0
961 ; NewGoal1 = (NewGoal0, Xsc = Xs)
962 ),
963 ( var(Xs0c)
964 -> Xs0 = Xs0c,
965 NewGoal = NewGoal1
966 ; NewGoal = ( Xs0 = Xs0c, NewGoal1 )
967 ).
968
973
974safe_meta_call(Goal, _, _Called) :-
975 debug(sandbox(meta), 'Safe meta ~p?', [Goal]),
976 fail.
977safe_meta_call(Goal, Context, Called) :-
978 ( safe_meta(Goal, Called)
979 -> true
980 ; safe_meta(Goal, Context, Called)
981 ),
982 !. 983safe_meta_call(Goal, _, Called) :-
984 Goal = M:Plain,
985 compound(Plain),
986 compound_name_arity(Plain, Name, Arity),
987 safe_meta_predicate(M:Name/Arity),
988 predicate_property(Goal, meta_predicate(Spec)),
989 !,
990 called(Spec, Plain, Called).
991safe_meta_call(M:Goal, _, Called) :-
992 !,
993 generic_goal(Goal, Gen),
994 safe_meta(M:Gen),
995 called(Gen, Goal, Called).
996safe_meta_call(Goal, _, Called) :-
997 generic_goal(Goal, Gen),
998 safe_meta(Gen),
999 called(Gen, Goal, Called).
1000
1001called(Gen, Goal, Called) :-
1002 compound_name_arity(Goal, _, Arity),
1003 called(1, Arity, Gen, Goal, Called).
1004
1005called(I, Arity, Gen, Goal, Called) :-
1006 I =< Arity,
1007 !,
1008 arg(I, Gen, Spec),
1009 ( calling_meta_spec(Spec)
1010 -> arg(I, Goal, Called0),
1011 extend(Spec, Called0, G),
1012 Called = [G|Rest]
1013 ; Called = Rest
1014 ),
1015 I2 is I+1,
1016 called(I2, Arity, Gen, Goal, Rest).
1017called(_, _, _, _, []).
1018
1019generic_goal(G, Gen) :-
1020 functor(G, Name, Arity),
1021 functor(Gen, Name, Arity).
1022
1023calling_meta_spec(V) :- var(V), !, fail.
1024calling_meta_spec(I) :- integer(I), !.
1025calling_meta_spec(^).
1026calling_meta_spec(//).
1027
1028
1029extend(^, G, Plain) :-
1030 !,
1031 strip_existential(G, Plain).
1032extend(//, DCG, Goal) :-
1033 !,
1034 ( expand_phrase(call_dcg(DCG,_,_), Goal)
1035 -> true
1036 ; instantiation_error(DCG) 1037 ). 1038extend(0, G, G) :- !.
1039extend(I, M:G0, M:G) :-
1040 !,
1041 G0 =.. List,
1042 length(Extra, I),
1043 append(List, Extra, All),
1044 G =.. All.
1045extend(I, G0, G) :-
1046 G0 =.. List,
1047 length(Extra, I),
1048 append(List, Extra, All),
1049 G =.. All.
1050
1051strip_existential(Var, Var) :-
1052 var(Var),
1053 !.
1054strip_existential(M:G0, M:G) :-
1055 !,
1056 strip_existential(G0, G).
1057strip_existential(_^G0, G) :-
1058 !,
1059 strip_existential(G0, G).
1060strip_existential(G, G).
1061
1063
1064safe_meta((0,0)).
1065safe_meta((0;0)).
1066safe_meta((0->0)).
1067safe_meta(system:(0*->0)).
1068safe_meta(catch(0,*,0)).
1069safe_meta(findall(*,0,*)).
1070safe_meta('$bags':findall(*,0,*,*)).
1071safe_meta(setof(*,^,*)).
1072safe_meta(bagof(*,^,*)).
1073safe_meta('$bags':findnsols(*,*,0,*)).
1074safe_meta('$bags':findnsols(*,*,0,*,*)).
1075safe_meta(system:call_cleanup(0,0)).
1076safe_meta(system:setup_call_cleanup(0,0,0)).
1077safe_meta(system:setup_call_catcher_cleanup(0,0,*,0)).
1078safe_meta('$attvar':call_residue_vars(0,*)).
1079safe_meta('$syspreds':call_with_inference_limit(0,*,*)).
1080safe_meta('$syspreds':call_with_depth_limit(0,*,*)).
1081safe_meta('$syspreds':undo(0)).
1082safe_meta(^(*,0)).
1083safe_meta(\+(0)).
1084safe_meta(call(0)).
1085safe_meta(call(1,*)).
1086safe_meta(call(2,*,*)).
1087safe_meta(call(3,*,*,*)).
1088safe_meta(call(4,*,*,*,*)).
1089safe_meta(call(5,*,*,*,*,*)).
1090safe_meta(call(6,*,*,*,*,*,*)).
1091safe_meta('$tabling':start_tabling(*,0)).
1092safe_meta('$tabling':start_tabling(*,0,*,*)).
1093safe_meta(wfs:call_delays(0,*)).
1094
1099
1100safe_output(Output) :-
1101 var(Output),
1102 !,
1103 instantiation_error(Output).
1104safe_output(atom(_)).
1105safe_output(string(_)).
1106safe_output(codes(_)).
1107safe_output(codes(_,_)).
1108safe_output(chars(_)).
1109safe_output(chars(_,_)).
1110safe_output(current_output).
1111safe_output(current_error).
1112
1116
1117:- public format_calls/3. 1118
1119format_calls(Format, Args, Calls) :-
1120 is_list(Args),
1121 !,
1122 format_types(Format, Types),
1123 ( format_callables(Types, Args, Calls)
1124 -> true
1125 ; throw(error(format_error(Format, Types, Args), _))
1126 ).
1127format_calls(Format, Arg, Calls) :-
1128 format_calls(Format, [Arg], Calls).
1129
1130format_callables([], [], []).
1131format_callables([callable|TT], [G|TA], [G|TG]) :-
1132 !,
1133 format_callables(TT, TA, TG).
1134format_callables([_|TT], [_|TA], TG) :-
1135 !,
1136 format_callables(TT, TA, TG).
1137
1138
1139 1142
1143:- multifile
1144 prolog:sandbox_allowed_directive/1,
1145 prolog:sandbox_allowed_goal/1,
1146 prolog:sandbox_allowed_expansion/1. 1147
1151
1152prolog:sandbox_allowed_directive(Directive) :-
1153 debug(sandbox(directive), 'Directive: ~p', [Directive]),
1154 fail.
1155prolog:sandbox_allowed_directive(Directive) :-
1156 safe_directive(Directive),
1157 !.
1158prolog:sandbox_allowed_directive(M:PredAttr) :-
1159 \+ prolog_load_context(module, M),
1160 !,
1161 debug(sandbox(directive), 'Cross-module directive', []),
1162 permission_error(execute, sandboxed_directive, (:- M:PredAttr)).
1163prolog:sandbox_allowed_directive(M:PredAttr) :-
1164 safe_pattr(PredAttr),
1165 !,
1166 PredAttr =.. [Attr, Preds],
1167 ( safe_pattr(Preds, Attr)
1168 -> true
1169 ; permission_error(execute, sandboxed_directive, (:- M:PredAttr))
1170 ).
1171prolog:sandbox_allowed_directive(_:Directive) :-
1172 safe_source_directive(Directive),
1173 !.
1174prolog:sandbox_allowed_directive(_:Directive) :-
1175 directive_loads_file(Directive, File),
1176 !,
1177 safe_path(File).
1178prolog:sandbox_allowed_directive(G) :-
1179 safe_goal(G).
1180
1195
1196
1197safe_pattr(dynamic(_)).
1198safe_pattr(thread_local(_)).
1199safe_pattr(volatile(_)).
1200safe_pattr(discontiguous(_)).
1201safe_pattr(multifile(_)).
1202safe_pattr(public(_)).
1203safe_pattr(meta_predicate(_)).
1204safe_pattr(table(_)).
1205safe_pattr(non_terminal(_)).
1206
1207safe_pattr(Var, _) :-
1208 var(Var),
1209 !,
1210 instantiation_error(Var).
1211safe_pattr((A,B), Attr) :-
1212 !,
1213 safe_pattr(A, Attr),
1214 safe_pattr(B, Attr).
1215safe_pattr(M:G, Attr) :-
1216 !,
1217 ( atom(M),
1218 prolog_load_context(module, M)
1219 -> true
1220 ; Goal =.. [Attr,M:G],
1221 permission_error(directive, sandboxed, (:- Goal))
1222 ).
1223safe_pattr(_, _).
1224
1225safe_source_directive(op(_,_,Name)) :-
1226 !,
1227 ( atom(Name)
1228 -> true
1229 ; is_list(Name),
1230 maplist(atom, Name)
1231 ).
1232safe_source_directive(set_prolog_flag(Flag, Value)) :-
1233 !,
1234 atom(Flag), ground(Value),
1235 safe_prolog_flag(Flag, Value).
1236safe_source_directive(style_check(_)).
1237safe_source_directive(initialization(_)). 1238safe_source_directive(initialization(_,_)). 1239
1240directive_loads_file(use_module(library(X)), X).
1241directive_loads_file(use_module(library(X), _Imports), X).
1242directive_loads_file(load_files(library(X), _Options), X).
1243directive_loads_file(ensure_loaded(library(X)), X).
1244directive_loads_file(include(X), X).
1245
1246safe_path(X) :-
1247 var(X),
1248 !,
1249 instantiation_error(X).
1250safe_path(X) :-
1251 ( atom(X)
1252 ; string(X)
1253 ),
1254 !,
1255 \+ sub_atom(X, 0, _, 0, '..'),
1256 \+ sub_atom(X, 0, _, _, '/'),
1257 \+ sub_atom(X, 0, _, _, '../'),
1258 \+ sub_atom(X, _, _, 0, '/..'),
1259 \+ sub_atom(X, _, _, _, '/../').
1260safe_path(A/B) :-
1261 !,
1262 safe_path(A),
1263 safe_path(B).
1264
1265
1274
1276safe_prolog_flag(generate_debug_info, _).
1277safe_prolog_flag(optimise, _).
1278safe_prolog_flag(occurs_check, _).
1279safe_prolog_flag(write_attributes, _).
1281safe_prolog_flag(var_prefix, _).
1282safe_prolog_flag(double_quotes, _).
1283safe_prolog_flag(back_quotes, _).
1284safe_prolog_flag(rational_syntax, _).
1286safe_prolog_flag(prefer_rationals, _).
1287safe_prolog_flag(float_overflow, _).
1288safe_prolog_flag(float_zero_div, _).
1289safe_prolog_flag(float_undefined, _).
1290safe_prolog_flag(float_underflow, _).
1291safe_prolog_flag(float_rounding, _).
1292safe_prolog_flag(float_rounding, _).
1293safe_prolog_flag(max_rational_size, _).
1294safe_prolog_flag(max_rational_size_action, _).
1296safe_prolog_flag(max_answers_for_subgoal,_).
1297safe_prolog_flag(max_answers_for_subgoal_action,_).
1298safe_prolog_flag(max_table_answer_size,_).
1299safe_prolog_flag(max_table_answer_size_action,_).
1300safe_prolog_flag(max_table_subgoal_size,_).
1301safe_prolog_flag(max_table_subgoal_size_action,_).
1302
1303
1316
1317prolog:sandbox_allowed_expansion(M:G) :-
1318 prolog_load_context(module, M),
1319 !,
1320 debug(sandbox(expansion), 'Expand in ~p: ~p', [M, G]),
1321 safe_goal(M:G).
1322prolog:sandbox_allowed_expansion(_,_).
1323
1327
1328prolog:sandbox_allowed_goal(G) :-
1329 safe_goal(G).
1330
1331
1332 1335
1336:- multifile
1337 prolog:message//1,
1338 prolog:message_context//1,
1339 prolog:error_message//1. 1340
1341prolog:message(error(instantiation_error, Context)) -->
1342 { nonvar(Context),
1343 Context = sandbox(_Goal,Parents),
1344 numbervars(Context, 1, _)
1345 },
1346 [ 'Sandbox restriction!'-[], nl,
1347 'Could not derive which predicate may be called from'-[]
1348 ],
1349 ( { Parents == [] }
1350 -> [ 'Search space too large'-[] ]
1351 ; callers(Parents, 10)
1352 ).
1353
1354prolog:message_context(sandbox(_G, [])) --> !.
1355prolog:message_context(sandbox(_G, Parents)) -->
1356 [ nl, 'Reachable from:'-[] ],
1357 callers(Parents, 10).
1358
1359callers([], _) --> !.
1360callers(_, 0) --> !.
1361callers([G|Parents], Level) -->
1362 { NextLevel is Level-1
1363 },
1364 [ nl, '\t ~p'-[G] ],
1365 callers(Parents, NextLevel).
1366
1367prolog:message(bad_safe_declaration(Goal, File, Line)) -->
1368 [ '~w:~d: Invalid safe_primitive/1 declaration: ~p'-
1369 [File, Line, Goal] ].
1370
1371prolog:error_message(format_error(Format, Types, Args)) -->
1372 format_error(Format, Types, Args).
1373
1374format_error(Format, Types, Args) -->
1375 { length(Types, TypeLen),
1376 length(Args, ArgsLen),
1377 ( TypeLen > ArgsLen
1378 -> Problem = 'not enough'
1379 ; Problem = 'too many'
1380 )
1381 },
1382 [ 'format(~q): ~w arguments (found ~w, need ~w)'-
1383 [Format, Problem, ArgsLen, TypeLen]
1384 ]