1:- encoding(utf8).
36
37:- module(pengines,
38 [ pengine_create/1, 39 pengine_ask/3, 40 pengine_next/2, 41 pengine_stop/2, 42 pengine_event/2, 43 pengine_input/2, 44 pengine_output/1, 45 pengine_respond/3, 46 pengine_debug/2, 47 pengine_self/1, 48 pengine_pull_response/2, 49 pengine_destroy/1, 50 pengine_destroy/2, 51 pengine_abort/1, 52 pengine_application/1, 53 current_pengine_application/1, 54 pengine_property/2, 55 pengine_user/1, 56 pengine_event_loop/2, 57 pengine_rpc/2, 58 pengine_rpc/3 59 ]).
60
69
70:- use_module(library(http/http_dispatch)).
71:- use_module(library(http/http_parameters)).
72:- use_module(library(http/http_client)).
73:- use_module(library(http/http_json)).
74:- use_module(library(http/http_open)).
75:- use_module(library(http/http_stream)).
76:- use_module(library(http/http_wrapper)).
77:- use_module(library(http/http_cors)).
78:- use_module(library(thread_pool)).
79:- use_module(library(broadcast)).
80:- use_module(library(uri)).
81:- use_module(library(filesex)).
82:- use_module(library(time)).
83:- use_module(library(lists)).
84:- use_module(library(charsio)).
85:- use_module(library(apply)).
86:- use_module(library(aggregate)).
87:- use_module(library(option)).
88:- use_module(library(settings)).
89:- use_module(library(debug)).
90:- use_module(library(error)).
91:- use_module(library(sandbox)).
92:- use_module(library(modules)).
93:- use_module(library(term_to_json)).
94:- if(exists_source(library(uuid))).
95:- use_module(library(uuid)).
96:- endif.
97
98
99:- meta_predicate
100 pengine_create(:),
101 pengine_rpc(+, +, :),
102 pengine_event_loop(1, +).
103
104:- multifile
105 write_result/3, 106 write_result/4, 107 event_to_json/4, 108 prepare_module/3, 109 prepare_goal/3, 110 authentication_hook/3, 111 not_sandboxed/2. 112
113:- predicate_options(pengine_create/1, 1,
114 [ id(-atom),
115 alias(atom),
116 application(atom),
117 destroy(boolean),
118 server(atom),
119 ask(compound),
120 template(compound),
121 chunk(integer),
122 src_list(list),
123 src_text(any), 124 src_url(atom),
125 src_predicates(list)
126 ]).
127:- predicate_options(pengine_ask/3, 3,
128 [ template(any),
129 chunk(integer)
130 ]).
131:- predicate_options(pengine_next/2, 2,
132 [ chunk(integer),
133 pass_to(pengine_send/3, 3)
134 ]).
135:- predicate_options(pengine_stop/2, 2,
136 [ pass_to(pengine_send/3, 3)
137 ]).
138:- predicate_options(pengine_respond/3, 2,
139 [ pass_to(pengine_send/3, 3)
140 ]).
141:- predicate_options(pengine_rpc/3, 3,
142 [ chunk(integer),
143 pass_to(pengine_create/1, 1)
144 ]).
145:- predicate_options(pengine_send/3, 3,
146 [ delay(number)
147 ]).
148:- predicate_options(pengine_event/2, 2,
149 [ pass_to(thread_get_message/3, 3)
150 ]).
151:- predicate_options(pengine_pull_response/2, 2,
152 [ pass_to(http_open/3, 3)
153 ]).
154:- predicate_options(pengine_event_loop/2, 2,
155 []). 156
158:- debug(pengine(debug)). 159
160goal_expansion(random_delay, Expanded) :-
161 ( debugging(pengine(delay))
162 -> Expanded = do_random_delay
163 ; Expanded = true
164 ).
165
166do_random_delay :-
167 Delay is random(20)/1000,
168 sleep(Delay).
169
170:- meta_predicate 171 solve(+, ?, 0, +),
172 findnsols_no_empty(+, ?, 0, -),
173 pengine_event_loop(+, 1, +).
174
226
227
228pengine_create(M:Options0) :-
229 translate_local_sources(Options0, Options, M),
230 ( select_option(server(BaseURL), Options, RestOptions)
231 -> remote_pengine_create(BaseURL, RestOptions)
232 ; local_pengine_create(Options)
233 ).
234
246
247translate_local_sources(OptionsIn, Options, Module) :-
248 translate_local_sources(OptionsIn, Sources, Options2, Module),
249 ( Sources == []
250 -> Options = Options2
251 ; Sources = [Source]
252 -> Options = [src_text(Source)|Options2]
253 ; atomics_to_string(Sources, Source)
254 -> Options = [src_text(Source)|Options2]
255 ).
256
257translate_local_sources([], [], [], _).
258translate_local_sources([H0|T], [S0|S], Options, M) :-
259 nonvar(H0),
260 translate_local_source(H0, S0, M),
261 !,
262 translate_local_sources(T, S, Options, M).
263translate_local_sources([H|T0], S, [H|T], M) :-
264 translate_local_sources(T0, S, T, M).
265
266translate_local_source(src_predicates(PIs), Source, M) :-
267 must_be(list, PIs),
268 with_output_to(string(Source),
269 maplist(listing(M), PIs)).
270translate_local_source(src_list(Terms), Source, _) :-
271 must_be(list, Terms),
272 with_output_to(string(Source),
273 forall(member(Term, Terms),
274 format('~k .~n', [Term]))).
275translate_local_source(src_text(Source), Source, _).
276
277listing(M, PI) :-
278 listing(M:PI).
279
284
285pengine_send(Target, Event) :-
286 pengine_send(Target, Event, []).
287
288
300
301pengine_send(Target, Event, Options) :-
302 must_be(atom, Target),
303 pengine_send2(Target, Event, Options).
304
305pengine_send2(self, Event, Options) :-
306 !,
307 thread_self(Queue),
308 delay_message(queue(Queue), Event, Options).
309pengine_send2(Name, Event, Options) :-
310 child(Name, Target),
311 !,
312 delay_message(pengine(Target), Event, Options).
313pengine_send2(Target, Event, Options) :-
314 delay_message(pengine(Target), Event, Options).
315
316delay_message(Target, Event, Options) :-
317 option(delay(Delay), Options),
318 !,
319 alarm(Delay,
320 send_message(Target, Event, Options),
321 _AlarmID,
322 [remove(true)]).
323delay_message(Target, Event, Options) :-
324 random_delay,
325 send_message(Target, Event, Options).
326
327send_message(queue(Queue), Event, _) :-
328 thread_send_message(Queue, pengine_request(Event)).
329send_message(pengine(Pengine), Event, Options) :-
330 ( pengine_remote(Pengine, Server)
331 -> remote_pengine_send(Server, Pengine, Event, Options)
332 ; pengine_thread(Pengine, Thread)
333 -> thread_send_message(Thread, pengine_request(Event))
334 ; existence_error(pengine, Pengine)
335 ).
336
341
342pengine_request(Request) :-
343 pengine_self(Self),
344 get_pengine_application(Self, Application),
345 setting(Application:idle_limit, IdleLimit),
346 thread_self(Me),
347 ( thread_get_message(Me, pengine_request(Request), [timeout(IdleLimit)])
348 -> true
349 ; Request = destroy
350 ).
351
352
362
363pengine_reply(Event) :-
364 pengine_parent(Queue),
365 pengine_reply(Queue, Event).
366
367pengine_reply(_Queue, _Event0) :-
368 nb_current(pengine_idle_limit_exceeded, true),
369 !.
370pengine_reply(Queue, Event0) :-
371 arg(1, Event0, ID),
372 wrap_first_answer(ID, Event0, Event),
373 random_delay,
374 debug(pengine(event), 'Reply to ~p: ~p', [Queue, Event]),
375 ( pengine_self(ID)
376 -> get_pengine_application(ID, Application),
377 setting(Application:idle_limit, IdleLimit),
378 debug(pengine(reply), 'Sending ~p, timout: ~q', [Event, IdleLimit]),
379 ( thread_send_message(Queue, pengine_event(ID, Event),
380 [ timeout(IdleLimit)
381 ])
382 -> true
383 ; thread_self(Me),
384 debug(pengine(reply), 'pengine_reply: timeout for ~q (thread ~q)',
385 [ID, Me]),
386 nb_setval(pengine_idle_limit_exceeded, true),
387 thread_detach(Me),
388 abort
389 )
390 ; thread_send_message(Queue, pengine_event(ID, Event))
391 ).
392
393wrap_first_answer(ID, Event0, CreateEvent) :-
394 wrap_first_answer_in_create_event(CreateEvent, [answer(Event0)]),
395 arg(1, CreateEvent, ID),
396 !,
397 retract(wrap_first_answer_in_create_event(CreateEvent, [answer(Event0)])).
398wrap_first_answer(_ID, Event, Event).
399
400
401empty_queue :-
402 pengine_parent(Queue),
403 empty_queue(Queue, 0, Discarded),
404 debug(pengine(abort), 'Abort: discarded ~D messages', [Discarded]).
405
406empty_queue(Queue, C0, C) :-
407 thread_get_message(Queue, _Term, [timeout(0)]),
408 !,
409 C1 is C0+1,
410 empty_queue(Queue, C1, C).
411empty_queue(_, C, C).
412
413
468
469pengine_ask(ID, Query, Options) :-
470 partition(pengine_ask_option, Options, AskOptions, SendOptions),
471 pengine_send(ID, ask(Query, AskOptions), SendOptions).
472
473
474pengine_ask_option(template(_)).
475pengine_ask_option(chunk(_)).
476pengine_ask_option(breakpoints(_)).
477
478
523
524pengine_next(ID, Options) :-
525 select_option(chunk(Count), Options, Options1),
526 !,
527 pengine_send(ID, next(Count), Options1).
528pengine_next(ID, Options) :-
529 pengine_send(ID, next, Options).
530
531
544
545pengine_stop(ID, Options) :- pengine_send(ID, stop, Options).
546
547
555
556pengine_abort(Name) :-
557 ( child(Name, Pengine)
558 -> true
559 ; Pengine = Name
560 ),
561 ( pengine_remote(Pengine, Server)
562 -> remote_pengine_abort(Server, Pengine, [])
563 ; pengine_thread(Pengine, Thread),
564 debug(pengine(abort), 'Signalling thread ~p', [Thread]),
565 catch(thread_signal(Thread, throw(abort_query)), _, true)
566 ).
567
568
575
576pengine_destroy(ID) :-
577 pengine_destroy(ID, []).
578
579pengine_destroy(Name, Options) :-
580 ( child(Name, ID)
581 -> true
582 ; ID = Name
583 ),
584 option(force(true), Options),
585 !,
586 ( pengine_thread(ID, Thread)
587 -> catch(thread_signal(Thread, abort),
588 error(existence_error(thread, _), _), true)
589 ; true
590 ).
591pengine_destroy(ID, _) :-
592 catch(pengine_send(ID, destroy),
593 error(existence_error(pengine, ID), _),
594 retractall(child(_,ID))).
595
596
599
608
609:- dynamic
610 current_pengine/6, 611 pengine_queue/4, 612 output_queue/3, 613 pengine_user/2, 614 pengine_data/2. 615:- volatile
616 current_pengine/6,
617 pengine_queue/4,
618 output_queue/3,
619 pengine_user/2,
620 pengine_data/2.
621
622:- thread_local
623 child/2. 624
628
629pengine_register_local(Id, Thread, Queue, URL, Application, Destroy) :-
630 asserta(current_pengine(Id, Queue, Thread, URL, Application, Destroy)).
631
632pengine_register_remote(Id, URL, Application, Destroy) :-
633 thread_self(Queue),
634 asserta(current_pengine(Id, Queue, 0, URL, Application, Destroy)).
635
641
642pengine_unregister(Id) :-
643 thread_self(Me),
644 ( current_pengine(Id, Queue, Me, http, _, _)
645 -> with_mutex(pengine, sync_destroy_queue_from_pengine(Id, Queue))
646 ; true
647 ),
648 retractall(current_pengine(Id, _, Me, _, _, _)),
649 retractall(pengine_user(Id, _)),
650 retractall(pengine_data(Id, _)).
651
652pengine_unregister_remote(Id) :-
653 retractall(current_pengine(Id, _Parent, 0, _, _, _)).
654
655pengine_self(Id) :-
656 thread_self(Thread),
657 current_pengine(Id, _Parent, Thread, _URL, _Application, _Destroy).
658
659pengine_parent(Parent) :-
660 nb_getval(pengine_parent, Parent).
661
662pengine_thread(Pengine, Thread) :-
663 current_pengine(Pengine, _Parent, Thread, _URL, _Application, _Destroy),
664 Thread \== 0,
665 !.
666
667pengine_remote(Pengine, URL) :-
668 current_pengine(Pengine, _Parent, 0, URL, _Application, _Destroy).
669
670get_pengine_application(Pengine, Application) :-
671 current_pengine(Pengine, _Parent, _, _URL, Application, _Destroy),
672 !.
673
674get_pengine_module(Pengine, Pengine).
675
676:- if(current_predicate(uuid/2)).
677pengine_uuid(Id) :-
678 uuid(Id, [version(4)]). 679:- else.
680:- use_module(library(random)).
681pengine_uuid(Id) :-
682 Max is 1<<128,
683 random_between(0, Max, Num),
684 atom_number(Id, Num).
685:- endif.
686
700
701pengine_application(Application) :-
702 throw(error(context_error(nodirective,
703 pengine_application(Application)), _)).
704
705:- multifile
706 system:term_expansion/2,
707 current_application/1.
708
714
715current_pengine_application(Application) :-
716 current_application(Application).
717
718
720
721:- setting(thread_pool_size, integer, 100,
722 'Maximum number of pengines this application can run.').
723:- setting(thread_pool_stacks, list(compound), [],
724 'Maximum stack sizes for pengines this application can run.').
725:- setting(slave_limit, integer, 3,
726 'Maximum number of slave pengines a master pengine can create.').
727:- setting(time_limit, number, 300,
728 'Maximum time to wait for output').
729:- setting(idle_limit, number, 300,
730 'Pengine auto-destroys when idle for this time').
731:- setting(safe_goal_limit, number, 10,
732 'Maximum time to try proving safity of the goal').
733:- setting(program_space, integer, 100_000_000,
734 'Maximum memory used by predicates').
735:- setting(allow_from, list(atom), [*],
736 'IP addresses from which remotes are allowed to connect').
737:- setting(deny_from, list(atom), [],
738 'IP addresses from which remotes are NOT allowed to connect').
739:- setting(debug_info, boolean, false,
740 'Keep information to support source-level debugging').
741
742
743system:term_expansion((:- pengine_application(Application)), Expanded) :-
744 must_be(atom, Application),
745 ( module_property(Application, file(_))
746 -> permission_error(create, pengine_application, Application)
747 ; true
748 ),
749 expand_term((:- setting(Application:thread_pool_size, integer,
750 setting(pengines:thread_pool_size),
751 'Maximum number of pengines this \c
752 application can run.')),
753 ThreadPoolSizeSetting),
754 expand_term((:- setting(Application:thread_pool_stacks, list(compound),
755 setting(pengines:thread_pool_stacks),
756 'Maximum stack sizes for pengines \c
757 this application can run.')),
758 ThreadPoolStacksSetting),
759 expand_term((:- setting(Application:slave_limit, integer,
760 setting(pengines:slave_limit),
761 'Maximum number of local slave pengines \c
762 a master pengine can create.')),
763 SlaveLimitSetting),
764 expand_term((:- setting(Application:time_limit, number,
765 setting(pengines:time_limit),
766 'Maximum time to wait for output')),
767 TimeLimitSetting),
768 expand_term((:- setting(Application:idle_limit, number,
769 setting(pengines:idle_limit),
770 'Pengine auto-destroys when idle for this time')),
771 IdleLimitSetting),
772 expand_term((:- setting(Application:safe_goal_limit, number,
773 setting(pengines:safe_goal_limit),
774 'Maximum time to try proving safity of the goal')),
775 SafeGoalLimitSetting),
776 expand_term((:- setting(Application:program_space, integer,
777 setting(pengines:program_space),
778 'Maximum memory used by predicates')),
779 ProgramSpaceSetting),
780 expand_term((:- setting(Application:allow_from, list(atom),
781 setting(pengines:allow_from),
782 'IP addresses from which remotes are allowed \c
783 to connect')),
784 AllowFromSetting),
785 expand_term((:- setting(Application:deny_from, list(atom),
786 setting(pengines:deny_from),
787 'IP addresses from which remotes are NOT \c
788 allowed to connect')),
789 DenyFromSetting),
790 expand_term((:- setting(Application:debug_info, boolean,
791 setting(pengines:debug_info),
792 'Keep information to support source-level \c
793 debugging')),
794 DebugInfoSetting),
795 flatten([ pengines:current_application(Application),
796 ThreadPoolSizeSetting,
797 ThreadPoolStacksSetting,
798 SlaveLimitSetting,
799 TimeLimitSetting,
800 IdleLimitSetting,
801 SafeGoalLimitSetting,
802 ProgramSpaceSetting,
803 AllowFromSetting,
804 DenyFromSetting,
805 DebugInfoSetting
806 ], Expanded).
807
809
810:- pengine_application(pengine_sandbox).
811
812
843
844
845pengine_property(Id, Prop) :-
846 nonvar(Id), nonvar(Prop),
847 pengine_property2(Id, Prop),
848 !.
849pengine_property(Id, Prop) :-
850 pengine_property2(Id, Prop).
851
852pengine_property2(Id, self(Id)) :-
853 current_pengine(Id, _Parent, _Thread, _URL, _Application, _Destroy).
854pengine_property2(Id, module(Id)) :-
855 current_pengine(Id, _Parent, _Thread, _URL, _Application, _Destroy).
856pengine_property2(Id, alias(Alias)) :-
857 child(Alias, Id),
858 Alias \== Id.
859pengine_property2(Id, thread(Thread)) :-
860 current_pengine(Id, _Parent, Thread, _URL, _Application, _Destroy),
861 Thread \== 0.
862pengine_property2(Id, remote(Server)) :-
863 current_pengine(Id, _Parent, 0, Server, _Application, _Destroy).
864pengine_property2(Id, application(Application)) :-
865 current_pengine(Id, _Parent, _Thread, _Server, Application, _Destroy).
866pengine_property2(Id, destroy(Destroy)) :-
867 current_pengine(Id, _Parent, _Thread, _Server, _Application, Destroy).
868pengine_property2(Id, parent(Parent)) :-
869 current_pengine(Id, Parent, _Thread, _URL, _Application, _Destroy).
870pengine_property2(Id, source(SourceID, Source)) :-
871 pengine_data(Id, source(SourceID, Source)).
872
877
878pengine_output(Term) :-
879 pengine_self(Me),
880 pengine_reply(output(Me, Term)).
881
882
894
895pengine_debug(Format, Args) :-
896 pengine_parent(Queue),
897 pengine_self(Self),
898 catch(safe_goal(format(atom(_), Format, Args)), E, true),
899 ( var(E)
900 -> format(atom(Message), Format, Args)
901 ; message_to_string(E, Message)
902 ),
903 pengine_reply(Queue, debug(Self, Message)).
904
905
908
917
918local_pengine_create(Options) :-
919 thread_self(Self),
920 option(application(Application), Options, pengine_sandbox),
921 create(Self, Child, Options, local, Application),
922 option(alias(Name), Options, Child),
923 assert(child(Name, Child)).
924
925
929
930thread_pool:create_pool(Application) :-
931 current_application(Application),
932 setting(Application:thread_pool_size, Size),
933 setting(Application:thread_pool_stacks, Stacks),
934 thread_pool_create(Application, Size, Stacks).
935
943
944create(Queue, Child, Options, local, Application) :-
945 !,
946 pengine_child_id(Child),
947 create0(Queue, Child, Options, local, Application).
948create(Queue, Child, Options, URL, Application) :-
949 pengine_child_id(Child),
950 catch(create0(Queue, Child, Options, URL, Application),
951 Error,
952 create_error(Queue, Child, Error)).
953
954pengine_child_id(Child) :-
955 ( nonvar(Child)
956 -> true
957 ; pengine_uuid(Child)
958 ).
959
960create_error(Queue, Child, Error) :-
961 pengine_reply(Queue, error(Child, Error)).
962
963create0(Queue, Child, Options, URL, Application) :-
964 ( current_application(Application)
965 -> true
966 ; existence_error(pengine_application, Application)
967 ),
968 ( URL \== http 969 970 -> aggregate_all(count, child(_,_), Count),
971 setting(Application:slave_limit, Max),
972 ( Count >= Max
973 -> throw(error(resource_error(max_pengines), _))
974 ; true
975 )
976 ; true
977 ),
978 partition(pengine_create_option, Options, PengineOptions, RestOptions),
979 thread_create_in_pool(
980 Application,
981 pengine_main(Queue, PengineOptions, Application), ChildThread,
982 [ at_exit(pengine_done)
983 | RestOptions
984 ]),
985 option(destroy(Destroy), PengineOptions, true),
986 pengine_register_local(Child, ChildThread, Queue, URL, Application, Destroy),
987 thread_send_message(ChildThread, pengine_registered(Child)),
988 ( option(id(Id), Options)
989 -> Id = Child
990 ; true
991 ).
992
993pengine_create_option(src_text(_)).
994pengine_create_option(src_url(_)).
995pengine_create_option(application(_)).
996pengine_create_option(destroy(_)).
997pengine_create_option(ask(_)).
998pengine_create_option(template(_)).
999pengine_create_option(chunk(_)).
1000pengine_create_option(alias(_)).
1001pengine_create_option(user(_)).
1002
1003
1008
1009:- public
1010 pengine_done/0.
1011
1012pengine_done :-
1013 thread_self(Me),
1014 ( thread_property(Me, status(exception('$aborted')))
1015 -> pengine_self(Pengine),
1016 pengine_reply(destroy(Pengine, abort(Pengine))),
1017 thread_detach(Me)
1018 ; true
1019 ),
1020 forall(child(_Name, Child),
1021 pengine_destroy(Child)),
1022 pengine_self(Id),
1023 pengine_unregister(Id).
1024
1025
1030
1031:- thread_local wrap_first_answer_in_create_event/2.
1032
1033:- meta_predicate
1034 pengine_prepare_source(:, +).
1035
1036pengine_main(Parent, Options, Application) :-
1037 fix_streams,
1038 thread_get_message(pengine_registered(Self)),
1039 nb_setval(pengine_parent, Parent),
1040 pengine_register_user(Options),
1041 catch(in_temporary_module(
1042 Self,
1043 pengine_prepare_source(Application, Options),
1044 pengine_create_and_loop(Self, Application, Options)),
1045 prepare_source_failed,
1046 pengine_terminate(Self)).
1047
1048pengine_create_and_loop(Self, Application, Options) :-
1049 setting(Application:slave_limit, SlaveLimit),
1050 CreateEvent = create(Self, [slave_limit(SlaveLimit)|Extra]),
1051 ( option(ask(Query), Options)
1052 -> asserta(wrap_first_answer_in_create_event(CreateEvent, Extra)),
1053 option(template(Template), Options, Query),
1054 option(chunk(Chunk), Options, 1),
1055 pengine_ask(Self, Query, [template(Template), chunk(Chunk)])
1056 ; Extra = [],
1057 pengine_reply(CreateEvent)
1058 ),
1059 pengine_main_loop(Self).
1060
1061
1066
1067fix_streams :-
1068 fix_stream(current_output).
1069
1070fix_stream(Name) :-
1071 is_cgi_stream(Name),
1072 !,
1073 debug(pengine(stream), '~w is a CGI stream!', [Name]),
1074 set_stream(user_output, alias(Name)).
1075fix_stream(_).
1076
1083
1084pengine_prepare_source(Module:Application, Options) :-
1085 setting(Application:program_space, SpaceLimit),
1086 set_module(Module:program_space(SpaceLimit)),
1087 delete_import_module(Module, user),
1088 add_import_module(Module, Application, start),
1089 catch(prep_module(Module, Application, Options), Error, true),
1090 ( var(Error)
1091 -> true
1092 ; send_error(Error),
1093 throw(prepare_source_failed)
1094 ).
1095
1096prep_module(Module, Application, Options) :-
1097 maplist(copy_flag(Module, Application), [var_prefix]),
1098 forall(prepare_module(Module, Application, Options), true),
1099 setup_call_cleanup(
1100 '$set_source_module'(OldModule, Module),
1101 maplist(process_create_option(Module), Options),
1102 '$set_source_module'(OldModule)).
1103
1104copy_flag(Module, Application, Flag) :-
1105 current_prolog_flag(Application:Flag, Value),
1106 !,
1107 set_prolog_flag(Module:Flag, Value).
1108copy_flag(_, _, _).
1109
1110process_create_option(Application, src_text(Text)) :-
1111 !,
1112 pengine_src_text(Text, Application).
1113process_create_option(Application, src_url(URL)) :-
1114 !,
1115 pengine_src_url(URL, Application).
1116process_create_option(_, _).
1117
1118
1137
1138
1139pengine_main_loop(ID) :-
1140 catch(guarded_main_loop(ID), abort_query, pengine_aborted(ID)).
1141
1142pengine_aborted(ID) :-
1143 thread_self(Self),
1144 debug(pengine(abort), 'Aborting ~p (thread ~p)', [ID, Self]),
1145 empty_queue,
1146 destroy_or_continue(abort(ID)).
1147
1148
1158
1159guarded_main_loop(ID) :-
1160 pengine_request(Request),
1161 ( Request = destroy
1162 -> debug(pengine(transition), '~q: 2 = ~q => 1', [ID, destroy]),
1163 pengine_terminate(ID)
1164 ; Request = ask(Goal, Options)
1165 -> debug(pengine(transition), '~q: 2 = ~q => 3', [ID, ask(Goal)]),
1166 ask(ID, Goal, Options)
1167 ; debug(pengine(transition), '~q: 2 = ~q => 2', [ID, protocol_error]),
1168 pengine_reply(error(ID, error(protocol_error, _))),
1169 guarded_main_loop(ID)
1170 ).
1171
1172
1173pengine_terminate(ID) :-
1174 pengine_reply(destroy(ID)),
1175 thread_self(Me), 1176 thread_detach(Me).
1177
1178
1186
1187solve(Chunk, Template, Goal, ID) :-
1188 prolog_current_choice(Choice),
1189 State = count(Chunk),
1190 statistics(cputime, Epoch),
1191 Time = time(Epoch),
1192 ( call_cleanup(catch(findnsols_no_empty(State, Template, Goal, Result),
1193 Error, true),
1194 Det = true),
1195 arg(1, Time, T0),
1196 statistics(cputime, T1),
1197 CPUTime is T1-T0,
1198 ( var(Error)
1199 -> ( var(Det)
1200 -> pengine_reply(success(ID, Result, CPUTime, true)),
1201 more_solutions(ID, Choice, State, Time)
1202 ; !, 1203 destroy_or_continue(success(ID, Result, CPUTime, false))
1204 )
1205 ; !, 1206 ( Error == abort_query
1207 -> throw(Error)
1208 ; destroy_or_continue(error(ID, Error))
1209 )
1210 )
1211 ; !, 1212 arg(1, Time, T0),
1213 statistics(cputime, T1),
1214 CPUTime is T1-T0,
1215 destroy_or_continue(failure(ID, CPUTime))
1216 ).
1217solve(_, _, _, _). 1218
1219findnsols_no_empty(N, Template, Goal, List) :-
1220 findnsols(N, Template, Goal, List),
1221 List \== [].
1222
1223destroy_or_continue(Event) :-
1224 arg(1, Event, ID),
1225 ( pengine_property(ID, destroy(true))
1226 -> thread_self(Me),
1227 thread_detach(Me),
1228 pengine_reply(destroy(ID, Event))
1229 ; pengine_reply(Event),
1230 garbage_collect, 1231 trim_stacks,
1232 guarded_main_loop(ID)
1233 ).
1234
1250
1251more_solutions(ID, Choice, State, Time) :-
1252 pengine_request(Event),
1253 more_solutions(Event, ID, Choice, State, Time).
1254
1255more_solutions(stop, ID, _Choice, _State, _Time) :-
1256 !,
1257 debug(pengine(transition), '~q: 6 = ~q => 7', [ID, stop]),
1258 destroy_or_continue(stop(ID)).
1259more_solutions(next, ID, _Choice, _State, Time) :-
1260 !,
1261 debug(pengine(transition), '~q: 6 = ~q => 3', [ID, next]),
1262 statistics(cputime, T0),
1263 nb_setarg(1, Time, T0),
1264 fail.
1265more_solutions(next(Count), ID, _Choice, State, Time) :-
1266 Count > 0,
1267 !,
1268 debug(pengine(transition), '~q: 6 = ~q => 3', [ID, next(Count)]),
1269 nb_setarg(1, State, Count),
1270 statistics(cputime, T0),
1271 nb_setarg(1, Time, T0),
1272 fail.
1273more_solutions(ask(Goal, Options), ID, Choice, _State, _Time) :-
1274 !,
1275 debug(pengine(transition), '~q: 6 = ~q => 3', [ID, ask(Goal)]),
1276 prolog_cut_to(Choice),
1277 ask(ID, Goal, Options).
1278more_solutions(destroy, ID, _Choice, _State, _Time) :-
1279 !,
1280 debug(pengine(transition), '~q: 6 = ~q => 1', [ID, destroy]),
1281 pengine_terminate(ID).
1282more_solutions(Event, ID, Choice, State, Time) :-
1283 debug(pengine(transition), '~q: 6 = ~q => 6', [ID, protocol_error(Event)]),
1284 pengine_reply(error(ID, error(protocol_error, _))),
1285 more_solutions(ID, Choice, State, Time).
1286
1292
1293ask(ID, Goal, Options) :-
1294 catch(prepare_goal(ID, Goal, Goal1, Options), Error, true),
1295 !,
1296 ( var(Error)
1297 -> option(template(Template), Options, Goal),
1298 option(chunk(N), Options, 1),
1299 solve(N, Template, Goal1, ID)
1300 ; pengine_reply(error(ID, Error)),
1301 guarded_main_loop(ID)
1302 ).
1303
1315
1316prepare_goal(ID, Goal0, Module:Goal, Options) :-
1317 ( prepare_goal(Goal0, Goal1, Options)
1318 -> true
1319 ; Goal1 = Goal0
1320 ),
1321 get_pengine_module(ID, Module),
1322 setup_call_cleanup(
1323 '$set_source_module'(Old, Module),
1324 expand_goal(Goal1, Goal),
1325 '$set_source_module'(_, Old)),
1326 ( pengine_not_sandboxed(ID)
1327 -> true
1328 ; get_pengine_application(ID, App),
1329 setting(App:safe_goal_limit, Limit),
1330 catch(call_with_time_limit(
1331 Limit,
1332 safe_goal(Module:Goal)), E, true)
1333 -> ( var(E)
1334 -> true
1335 ; E = time_limit_exceeded
1336 -> throw(error(sandbox(time_limit_exceeded, Limit),_))
1337 ; throw(E)
1338 )
1339 ).
1340
1350
1351
1357
1358pengine_not_sandboxed(ID) :-
1359 pengine_user(ID, User),
1360 pengine_property(ID, application(App)),
1361 not_sandboxed(User, App),
1362 !.
1363
1376
1377
1383
1384pengine_pull_response(Pengine, Options) :-
1385 pengine_remote(Pengine, Server),
1386 !,
1387 remote_pengine_pull_response(Server, Pengine, Options).
1388pengine_pull_response(_ID, _Options).
1389
1390
1396
1397pengine_input(Prompt, Term) :-
1398 pengine_self(Self),
1399 pengine_parent(Parent),
1400 pengine_reply(Parent, prompt(Self, Prompt)),
1401 pengine_request(Request),
1402 ( Request = input(Input)
1403 -> Term = Input
1404 ; Request == destroy
1405 -> abort
1406 ; throw(error(protocol_error,_))
1407 ).
1408
1409
1423
1424pengine_respond(Pengine, Input, Options) :-
1425 pengine_send(Pengine, input(Input), Options).
1426
1427
1433
1434send_error(error(Formal, context(prolog_stack(Frames), Message))) :-
1435 is_list(Frames),
1436 !,
1437 with_output_to(string(Stack),
1438 print_prolog_backtrace(current_output, Frames)),
1439 pengine_self(Self),
1440 replace_blobs(Formal, Formal1),
1441 replace_blobs(Message, Message1),
1442 pengine_reply(error(Self, error(Formal1,
1443 context(prolog_stack(Stack), Message1)))).
1444send_error(Error) :-
1445 pengine_self(Self),
1446 replace_blobs(Error, Error1),
1447 pengine_reply(error(Self, Error1)).
1448
1454
1455replace_blobs(Blob, Atom) :-
1456 blob(Blob, Type), Type \== text,
1457 !,
1458 format(atom(Atom), '~p', [Blob]).
1459replace_blobs(Term0, Term) :-
1460 compound(Term0),
1461 !,
1462 compound_name_arguments(Term0, Name, Args0),
1463 maplist(replace_blobs, Args0, Args),
1464 compound_name_arguments(Term, Name, Args).
1465replace_blobs(Term, Term).
1466
1467
1470
1471
1472remote_pengine_create(BaseURL, Options) :-
1473 partition(pengine_create_option, Options, PengineOptions0, RestOptions),
1474 ( option(ask(Query), PengineOptions0),
1475 \+ option(template(_Template), PengineOptions0)
1476 -> PengineOptions = [template(Query)|PengineOptions0]
1477 ; PengineOptions = PengineOptions0
1478 ),
1479 options_to_dict(PengineOptions, PostData),
1480 remote_post_rec(BaseURL, create, PostData, Reply, RestOptions),
1481 arg(1, Reply, ID),
1482 ( option(id(ID2), Options)
1483 -> ID = ID2
1484 ; true
1485 ),
1486 option(alias(Name), Options, ID),
1487 assert(child(Name, ID)),
1488 ( ( functor(Reply, create, _) 1489 ; functor(Reply, output, _) 1490 )
1491 -> option(application(Application), PengineOptions, pengine_sandbox),
1492 option(destroy(Destroy), PengineOptions, true),
1493 pengine_register_remote(ID, BaseURL, Application, Destroy)
1494 ; true
1495 ),
1496 thread_self(Queue),
1497 pengine_reply(Queue, Reply).
1498
1499options_to_dict(Options, Dict) :-
1500 select_option(ask(Ask), Options, Options1),
1501 select_option(template(Template), Options1, Options2),
1502 !,
1503 no_numbered_var_in(Ask+Template),
1504 findall(AskString-TemplateString,
1505 ask_template_to_strings(Ask, Template, AskString, TemplateString),
1506 [ AskString-TemplateString ]),
1507 options_to_dict(Options2, Dict0),
1508 Dict = Dict0.put(_{ask:AskString,template:TemplateString}).
1509options_to_dict(Options, Dict) :-
1510 maplist(prolog_option, Options, Options1),
1511 dict_create(Dict, _, Options1).
1512
1513no_numbered_var_in(Term) :-
1514 sub_term(Sub, Term),
1515 subsumes_term('$VAR'(_), Sub),
1516 !,
1517 domain_error(numbered_vars_free_term, Term).
1518no_numbered_var_in(_).
1519
1520ask_template_to_strings(Ask, Template, AskString, TemplateString) :-
1521 numbervars(Ask+Template, 0, _),
1522 WOpts = [ numbervars(true), ignore_ops(true), quoted(true) ],
1523 format(string(AskTemplate), '~W\n~W', [ Ask, WOpts,
1524 Template, WOpts
1525 ]),
1526 split_string(AskTemplate, "\n", "", [AskString, TemplateString]).
1527
1528prolog_option(Option0, Option) :-
1529 create_option_type(Option0, term),
1530 !,
1531 Option0 =.. [Name,Value],
1532 format(string(String), '~k', [Value]),
1533 Option =.. [Name,String].
1534prolog_option(Option, Option).
1535
1536create_option_type(ask(_), term).
1537create_option_type(template(_), term).
1538create_option_type(application(_), atom).
1539
1540remote_pengine_send(BaseURL, ID, Event, Options) :-
1541 remote_send_rec(BaseURL, send, ID, [event=Event], Reply, Options),
1542 thread_self(Queue),
1543 pengine_reply(Queue, Reply).
1544
1545remote_pengine_pull_response(BaseURL, ID, Options) :-
1546 remote_send_rec(BaseURL, pull_response, ID, [], Reply, Options),
1547 thread_self(Queue),
1548 pengine_reply(Queue, Reply).
1549
1550remote_pengine_abort(BaseURL, ID, Options) :-
1551 remote_send_rec(BaseURL, abort, ID, [], Reply, Options),
1552 thread_self(Queue),
1553 pengine_reply(Queue, Reply).
1554
1559
1560remote_send_rec(Server, Action, ID, [event=Event], Reply, Options) :-
1561 !,
1562 server_url(Server, Action, [id=ID], URL),
1563 http_open(URL, Stream, 1564 [ post(prolog(Event)) 1565 | Options
1566 ]),
1567 call_cleanup(
1568 read_prolog_reply(Stream, Reply),
1569 close(Stream)).
1570remote_send_rec(Server, Action, ID, Params, Reply, Options) :-
1571 server_url(Server, Action, [id=ID|Params], URL),
1572 http_open(URL, Stream, Options),
1573 call_cleanup(
1574 read_prolog_reply(Stream, Reply),
1575 close(Stream)).
1576
1577remote_post_rec(Server, Action, Data, Reply, Options) :-
1578 server_url(Server, Action, [], URL),
1579 probe(Action, URL),
1580 http_open(URL, Stream,
1581 [ post(json(Data))
1582 | Options
1583 ]),
1584 call_cleanup(
1585 read_prolog_reply(Stream, Reply),
1586 close(Stream)).
1587
1593
1594probe(create, URL) :-
1595 !,
1596 http_open(URL, Stream, [method(options)]),
1597 close(Stream).
1598probe(_, _).
1599
1600read_prolog_reply(In, Reply) :-
1601 set_stream(In, encoding(utf8)),
1602 read(In, Reply0),
1603 rebind_cycles(Reply0, Reply).
1604
1605rebind_cycles(@(Reply, Bindings), Reply) :-
1606 is_list(Bindings),
1607 !,
1608 maplist(bind, Bindings).
1609rebind_cycles(Reply, Reply).
1610
1611bind(Var = Value) :-
1612 Var = Value.
1613
1614server_url(Server, Action, Params, URL) :-
1615 uri_components(Server, Components0),
1616 uri_query_components(Query, Params),
1617 uri_data(path, Components0, Path0),
1618 atom_concat('pengine/', Action, PAction),
1619 directory_file_path(Path0, PAction, Path),
1620 uri_data(path, Components0, Path, Components),
1621 uri_data(search, Components, Query),
1622 uri_components(URL, Components).
1623
1624
1642
1643pengine_event(Event) :-
1644 pengine_event(Event, []).
1645
1646pengine_event(Event, Options) :-
1647 thread_self(Self),
1648 option(listen(Id), Options, _),
1649 ( thread_get_message(Self, pengine_event(Id, Event), Options)
1650 -> true
1651 ; Event = timeout
1652 ),
1653 update_remote_destroy(Event).
1654
1655update_remote_destroy(Event) :-
1656 destroy_event(Event),
1657 arg(1, Event, Id),
1658 pengine_remote(Id, _Server),
1659 !,
1660 pengine_unregister_remote(Id).
1661update_remote_destroy(_).
1662
1663destroy_event(destroy(_)).
1664destroy_event(destroy(_,_)).
1665destroy_event(create(_,Features)) :-
1666 memberchk(answer(Answer), Features),
1667 !,
1668 nonvar(Answer),
1669 destroy_event(Answer).
1670
1671
1697
1698pengine_event_loop(Closure, Options) :-
1699 child(_,_),
1700 !,
1701 pengine_event(Event),
1702 ( option(autoforward(all), Options) 1703 -> forall(child(_,ID), pengine_send(ID, Event))
1704 ; true
1705 ),
1706 pengine_event_loop(Event, Closure, Options).
1707pengine_event_loop(_, _).
1708
1709:- meta_predicate
1710 pengine_process_event(+, 1, -, +).
1711
1712pengine_event_loop(Event, Closure, Options) :-
1713 pengine_process_event(Event, Closure, Continue, Options),
1714 ( Continue == true
1715 -> pengine_event_loop(Closure, Options)
1716 ; true
1717 ).
1718
1719pengine_process_event(create(ID, T), Closure, Continue, Options) :-
1720 debug(pengine(transition), '~q: 1 = /~q => 2', [ID, create(T)]),
1721 ( select(answer(First), T, T1)
1722 -> ignore(call(Closure, create(ID, T1))),
1723 pengine_process_event(First, Closure, Continue, Options)
1724 ; ignore(call(Closure, create(ID, T))),
1725 Continue = true
1726 ).
1727pengine_process_event(output(ID, Msg), Closure, true, _Options) :-
1728 debug(pengine(transition), '~q: 3 = /~q => 4', [ID, output(Msg)]),
1729 ignore(call(Closure, output(ID, Msg))),
1730 pengine_pull_response(ID, []).
1731pengine_process_event(debug(ID, Msg), Closure, true, _Options) :-
1732 debug(pengine(transition), '~q: 3 = /~q => 4', [ID, debug(Msg)]),
1733 ignore(call(Closure, debug(ID, Msg))),
1734 pengine_pull_response(ID, []).
1735pengine_process_event(prompt(ID, Term), Closure, true, _Options) :-
1736 debug(pengine(transition), '~q: 3 = /~q => 5', [ID, prompt(Term)]),
1737 ignore(call(Closure, prompt(ID, Term))).
1738pengine_process_event(success(ID, Sol, _Time, More), Closure, true, _Options) :-
1739 debug(pengine(transition), '~q: 3 = /~q => 6/2', [ID, success(Sol, More)]),
1740 ignore(call(Closure, success(ID, Sol, More))).
1741pengine_process_event(failure(ID, _Time), Closure, true, _Options) :-
1742 debug(pengine(transition), '~q: 3 = /~q => 2', [ID, failure]),
1743 ignore(call(Closure, failure(ID))).
1744pengine_process_event(error(ID, Error), Closure, Continue, _Options) :-
1745 debug(pengine(transition), '~q: 3 = /~q => 2', [ID, error(Error)]),
1746 ( call(Closure, error(ID, Error))
1747 -> Continue = true
1748 ; forall(child(_,Child), pengine_destroy(Child)),
1749 throw(Error)
1750 ).
1751pengine_process_event(stop(ID), Closure, true, _Options) :-
1752 debug(pengine(transition), '~q: 7 = /~q => 2', [ID, stop]),
1753 ignore(call(Closure, stop(ID))).
1754pengine_process_event(destroy(ID, Event), Closure, Continue, Options) :-
1755 pengine_process_event(Event, Closure, _, Options),
1756 pengine_process_event(destroy(ID), Closure, Continue, Options).
1757pengine_process_event(destroy(ID), Closure, true, _Options) :-
1758 retractall(child(_,ID)),
1759 debug(pengine(transition), '~q: 1 = /~q => 0', [ID, destroy]),
1760 ignore(call(Closure, destroy(ID))).
1761
1762
1788
1789pengine_rpc(URL, Query) :-
1790 pengine_rpc(URL, Query, []).
1791
1792pengine_rpc(URL, Query, M:Options0) :-
1793 translate_local_sources(Options0, Options1, M),
1794 ( option(timeout(_), Options1)
1795 -> Options = Options1
1796 ; setting(time_limit, Limit),
1797 Options = [timeout(Limit)|Options1]
1798 ),
1799 term_variables(Query, Vars),
1800 Template =.. [v|Vars],
1801 State = destroy(true), 1802 setup_call_catcher_cleanup(
1803 pengine_create([ ask(Query),
1804 template(Template),
1805 server(URL),
1806 id(Id)
1807 | Options
1808 ]),
1809 wait_event(Template, State, [listen(Id)|Options]),
1810 Why,
1811 pengine_destroy_and_wait(State, Id, Why)).
1812
1813pengine_destroy_and_wait(destroy(true), Id, Why) :-
1814 !,
1815 debug(pengine(rpc), 'Destroying RPC because of ~p', [Why]),
1816 pengine_destroy(Id),
1817 wait_destroy(Id, 10).
1818pengine_destroy_and_wait(_, _, Why) :-
1819 debug(pengine(rpc), 'Not destroying RPC (~p)', [Why]).
1820
1821wait_destroy(Id, _) :-
1822 \+ child(_, Id),
1823 !.
1824wait_destroy(Id, N) :-
1825 pengine_event(Event, [listen(Id),timeout(10)]),
1826 !,
1827 ( destroy_event(Event)
1828 -> retractall(child(_,Id))
1829 ; succ(N1, N)
1830 -> wait_destroy(Id, N1)
1831 ; debug(pengine(rpc), 'RPC did not answer to destroy ~p', [Id]),
1832 pengine_unregister_remote(Id),
1833 retractall(child(_,Id))
1834 ).
1835
1836wait_event(Template, State, Options) :-
1837 pengine_event(Event, Options),
1838 debug(pengine(event), 'Received ~p', [Event]),
1839 process_event(Event, Template, State, Options).
1840
1841process_event(create(_ID, Features), Template, State, Options) :-
1842 memberchk(answer(First), Features),
1843 process_event(First, Template, State, Options).
1844process_event(error(_ID, Error), _Template, _, _Options) :-
1845 throw(Error).
1846process_event(failure(_ID, _Time), _Template, _, _Options) :-
1847 fail.
1848process_event(prompt(ID, Prompt), Template, State, Options) :-
1849 pengine_rpc_prompt(ID, Prompt, Reply),
1850 pengine_send(ID, input(Reply)),
1851 wait_event(Template, State, Options).
1852process_event(output(ID, Term), Template, State, Options) :-
1853 pengine_rpc_output(ID, Term),
1854 pengine_pull_response(ID, Options),
1855 wait_event(Template, State, Options).
1856process_event(debug(ID, Message), Template, State, Options) :-
1857 debug(pengine(debug), '~w', [Message]),
1858 pengine_pull_response(ID, Options),
1859 wait_event(Template, State, Options).
1860process_event(success(_ID, Solutions, _Time, false), Template, _, _Options) :-
1861 !,
1862 member(Template, Solutions).
1863process_event(success(ID, Solutions, _Time, true), Template, State, Options) :-
1864 ( member(Template, Solutions)
1865 ; pengine_next(ID, Options),
1866 wait_event(Template, State, Options)
1867 ).
1868process_event(destroy(ID, Event), Template, State, Options) :-
1869 !,
1870 retractall(child(_,ID)),
1871 nb_setarg(1, State, false),
1872 debug(pengine(destroy), 'State: ~p~n', [State]),
1873 process_event(Event, Template, State, Options).
1874
1875pengine_rpc_prompt(ID, Prompt, Term) :-
1876 prompt(ID, Prompt, Term0),
1877 !,
1878 Term = Term0.
1879pengine_rpc_prompt(_ID, Prompt, Term) :-
1880 setup_call_cleanup(
1881 prompt(Old, Prompt),
1882 read(Term),
1883 prompt(_, Old)).
1884
1885pengine_rpc_output(ID, Term) :-
1886 output(ID, Term),
1887 !.
1888pengine_rpc_output(_ID, Term) :-
1889 print(Term).
1890
1895
1896:- multifile prompt/3.
1897
1902
1903:- multifile output/2.
1904
1905
1908
1920
1921:- http_handler(root(pengine), http_404([]),
1922 [ id(pengines) ]).
1923:- http_handler(root(pengine/create), http_pengine_create,
1924 [ time_limit(infinite), spawn([]) ]).
1925:- http_handler(root(pengine/send), http_pengine_send,
1926 [ time_limit(infinite), spawn([]) ]).
1927:- http_handler(root(pengine/pull_response), http_pengine_pull_response,
1928 [ time_limit(infinite), spawn([]) ]).
1929:- http_handler(root(pengine/abort), http_pengine_abort, []).
1930:- http_handler(root(pengine/ping), http_pengine_ping, []).
1931:- http_handler(root(pengine/destroy_all), http_pengine_destroy_all, []).
1932
1933:- http_handler(root(pengine/'pengines.js'),
1934 http_reply_file(library('http/web/js/pengines.js'), []), []).
1935:- http_handler(root(pengine/'plterm.css'),
1936 http_reply_file(library('http/web/css/plterm.css'), []), []).
1937
1938
1962
1963http_pengine_create(Request) :-
1964 reply_options(Request, [post]),
1965 !.
1966http_pengine_create(Request) :-
1967 memberchk(content_type(CT), Request),
1968 sub_atom(CT, 0, _, _, 'application/json'),
1969 !,
1970 http_read_json_dict(Request, Dict),
1971 dict_atom_option(format, Dict, Format, prolog),
1972 dict_atom_option(application, Dict, Application, pengine_sandbox),
1973 http_pengine_create(Request, Application, Format, Dict).
1974http_pengine_create(Request) :-
1975 Optional = [optional(true)],
1976 OptString = [string|Optional],
1977 Form = [ format(Format, [default(prolog)]),
1978 application(Application, [default(pengine_sandbox)]),
1979 chunk(_, [integer, default(1)]),
1980 solutions(_, [oneof([all,chunked]), default(chunked)]),
1981 ask(_, OptString),
1982 template(_, OptString),
1983 src_text(_, OptString),
1984 disposition(_, OptString),
1985 src_url(_, Optional)
1986 ],
1987 http_parameters(Request, Form),
1988 form_dict(Form, Dict),
1989 http_pengine_create(Request, Application, Format, Dict).
1990
1991dict_atom_option(Key, Dict, Atom, Default) :-
1992 ( get_dict(Key, Dict, String)
1993 -> atom_string(Atom, String)
1994 ; Atom = Default
1995 ).
1996
1997form_dict(Form, Dict) :-
1998 form_values(Form, Pairs),
1999 dict_pairs(Dict, _, Pairs).
2000
2001form_values([], []).
2002form_values([H|T], Pairs) :-
2003 arg(1, H, Value),
2004 nonvar(Value),
2005 !,
2006 functor(H, Name, _),
2007 Pairs = [Name-Value|PairsT],
2008 form_values(T, PairsT).
2009form_values([_|T], Pairs) :-
2010 form_values(T, Pairs).
2011
2013
2014
2015http_pengine_create(Request, Application, Format, Dict) :-
2016 current_application(Application),
2017 !,
2018 allowed(Request, Application),
2019 authenticate(Request, Application, UserOptions),
2020 dict_to_options(Dict, Application, CreateOptions0, VarNames),
2021 append(UserOptions, CreateOptions0, CreateOptions),
2022 pengine_uuid(Pengine),
2023 message_queue_create(Queue, [max_size(25)]),
2024 setting(Application:time_limit, TimeLimit),
2025 get_time(Now),
2026 asserta(pengine_queue(Pengine, Queue, TimeLimit, Now)),
2027 broadcast(pengine(create(Pengine, Application, CreateOptions))),
2028 create(Queue, Pengine, CreateOptions, http, Application),
2029 create_wait_and_output_result(Pengine, Queue, Format,
2030 TimeLimit, VarNames, Dict),
2031 gc_abandoned_queues.
2032http_pengine_create(_Request, Application, Format, _Dict) :-
2033 Error = existence_error(pengine_application, Application),
2034 pengine_uuid(ID),
2035 output_result(Format, error(ID, error(Error, _))).
2036
2037
2038dict_to_options(Dict, Application, CreateOptions, VarNames) :-
2039 dict_pairs(Dict, _, Pairs),
2040 pairs_create_options(Pairs, Application, CreateOptions, VarNames).
2041
2042pairs_create_options([], _, [], _) :- !.
2043pairs_create_options(T0, App, [AskOpt, TemplateOpt|T], VarNames) :-
2044 selectchk(ask-Ask, T0, T1),
2045 selectchk(template-Template, T1, T2),
2046 !,
2047 format(string(AskTemplate), 't((~s),(~s))', [Ask, Template]),
2048 term_string(t(Ask1,Template1), AskTemplate,
2049 [ variable_names(Bindings),
2050 module(App)
2051 ]),
2052 template_varnames(Template1, Bindings, VarNames),
2053 AskOpt = ask(Ask1),
2054 TemplateOpt = template(Template1),
2055 pairs_create_options(T2, App, T, VarNames).
2056pairs_create_options([ask-String|T0], App,
2057 [ask(Ask),template(Template)|T], VarNames) :-
2058 !,
2059 term_string(Ask, String,
2060 [ variable_names(Bindings),
2061 module(App)
2062 ]),
2063 exclude(anon, Bindings, Bindings1),
2064 maplist(var_name, Bindings1, VarNames),
2065 dict_create(Template, json, Bindings1),
2066 pairs_create_options(T0, App, T, VarNames).
2067pairs_create_options([N-V0|T0], App, [Opt|T], VarNames) :-
2068 Opt =.. [N,V],
2069 pengine_create_option(Opt), N \== user,
2070 !,
2071 ( create_option_type(Opt, Type)
2072 -> ( Type == term
2073 -> atom_to_term(V0, V, _)
2074 ; Type == atom
2075 -> atom_string(V, V0)
2076 ; assertion(false)
2077 )
2078 ; V = V0
2079 ),
2080 pairs_create_options(T0, App, T, VarNames).
2081pairs_create_options([_|T0], App, T, VarNames) :-
2082 pairs_create_options(T0, App, T, VarNames).
2083
2084
2088
2089template_varnames(Template1, Bindings, VarNames) :-
2090 term_variables(Template1, TemplateVars),
2091 filter_template_varnames(TemplateVars, Bindings, VarNames).
2092
2093filter_template_varnames([], _, []).
2094filter_template_varnames([H|T0], Bindings, [Name|T]) :-
2095 member(Name=Var, Bindings),
2096 Var == H,
2097 !,
2098 filter_template_varnames(T0, Bindings, T).
2099
2100
2111
2112wait_and_output_result(Pengine, Queue, Format, TimeLimit) :-
2113 wait_and_output_result(Pengine, Queue, Format, TimeLimit, -).
2114
2115wait_and_output_result(Pengine, Queue, Format, TimeLimit, VarNames) :-
2116 ( catch(thread_get_message(Queue, pengine_event(_, Event),
2117 [ timeout(TimeLimit)
2118 ]),
2119 Error, true)
2120 -> ( var(Error)
2121 -> debug(pengine(wait), 'Got ~q from ~q', [Event, Queue]),
2122 ignore(destroy_queue_from_http(Pengine, Event, Queue)),
2123 output_result(Format, Event, VarNames)
2124 ; output_result(Format, died(Pengine))
2125 )
2126 ; output_result(Format, error(Pengine,
2127 error(time_limit_exceeded, _))),
2128 pengine_abort(Pengine)
2129 ).
2130
2137
2138create_wait_and_output_result(Pengine, Queue, Format,
2139 TimeLimit, VarNames, Dict) :-
2140 get_dict(solutions, Dict, all),
2141 !,
2142 between(1, infinite, Page),
2143 ( catch(thread_get_message(Queue, pengine_event(_, Event),
2144 [ timeout(TimeLimit)
2145 ]),
2146 Error, true)
2147 -> ( var(Error)
2148 -> debug(pengine(wait), 'Page ~D: got ~q from ~q', [Page, Event, Queue]),
2149 ( destroy_queue_from_http(Pengine, Event, Queue)
2150 -> output_result(Format, page(Page, Event), VarNames)
2151 ; pengine_thread(Pengine, Thread),
2152 thread_send_message(Thread, pengine_request(next)),
2153 output_result(Format, page(Page, Event), VarNames, Dict),
2154 fail
2155 )
2156 ; output_result(Format, died(Pengine))
2157 )
2158 ; output_result(Format, error(Pengine,
2159 error(time_limit_exceeded, _))),
2160 pengine_abort(Pengine)
2161 ),
2162 !.
2163create_wait_and_output_result(Pengine, Queue, Format,
2164 TimeLimit, VarNames, _Dict) :-
2165 wait_and_output_result(Pengine, Queue, Format, TimeLimit, VarNames).
2166
2167
2179
2180destroy_queue_from_http(ID, _, Queue) :-
2181 output_queue(ID, Queue, _),
2182 !,
2183 destroy_queue_if_empty(Queue).
2184destroy_queue_from_http(ID, Event, Queue) :-
2185 debug(pengine(destroy), 'DESTROY? ~p', [Event]),
2186 is_destroy_event(Event),
2187 !,
2188 message_queue_property(Queue, size(Waiting)),
2189 debug(pengine(destroy), 'Destroy ~p (waiting ~D)', [Queue, Waiting]),
2190 with_mutex(pengine, sync_destroy_queue_from_http(ID, Queue)).
2191
2192is_destroy_event(destroy(_)).
2193is_destroy_event(destroy(_,_)).
2194is_destroy_event(create(_, Options)) :-
2195 memberchk(answer(Event), Options),
2196 is_destroy_event(Event).
2197
2198destroy_queue_if_empty(Queue) :-
2199 thread_peek_message(Queue, _),
2200 !.
2201destroy_queue_if_empty(Queue) :-
2202 retractall(output_queue(_, Queue, _)),
2203 message_queue_destroy(Queue).
2204
2210
2211:- dynamic
2212 last_gc/1.
2213
2214gc_abandoned_queues :-
2215 consider_queue_gc,
2216 !,
2217 get_time(Now),
2218 ( output_queue(_, Queue, Time),
2219 Now-Time > 15*60,
2220 retract(output_queue(_, Queue, Time)),
2221 message_queue_destroy(Queue),
2222 fail
2223 ; retractall(last_gc(_)),
2224 asserta(last_gc(Now))
2225 ).
2226gc_abandoned_queues.
2227
2228consider_queue_gc :-
2229 predicate_property(output_queue(_,_,_), number_of_clauses(N)),
2230 N > 100,
2231 ( last_gc(Time),
2232 get_time(Now),
2233 Now-Time > 5*60
2234 -> true
2235 ; \+ last_gc(_)
2236 ).
2237
2253
2254:- dynamic output_queue_destroyed/1.
2255
2256sync_destroy_queue_from_http(ID, Queue) :-
2257 ( output_queue(ID, Queue, _)
2258 -> destroy_queue_if_empty(Queue)
2259 ; thread_peek_message(Queue, pengine_event(_, output(_,_)))
2260 -> debug(pengine(destroy), 'Delay destruction of ~p because of output',
2261 [Queue]),
2262 get_time(Now),
2263 asserta(output_queue(ID, Queue, Now))
2264 ; message_queue_destroy(Queue),
2265 asserta(output_queue_destroyed(Queue))
2266 ).
2267
2272
2273sync_destroy_queue_from_pengine(ID, Queue) :-
2274 ( retract(output_queue_destroyed(Queue))
2275 -> true
2276 ; get_time(Now),
2277 asserta(output_queue(ID, Queue, Now))
2278 ),
2279 retractall(pengine_queue(ID, Queue, _, _)).
2280
2281
2282http_pengine_send(Request) :-
2283 reply_options(Request, [get,post]),
2284 !.
2285http_pengine_send(Request) :-
2286 http_parameters(Request,
2287 [ id(ID, [ type(atom) ]),
2288 event(EventString, [optional(true)]),
2289 format(Format, [default(prolog)])
2290 ]),
2291 get_pengine_module(ID, Module),
2292 ( current_module(Module) 2293 -> catch(( read_event(Request, EventString, Module, Event0, Bindings),
2294 fix_bindings(Format, Event0, Bindings, VarNames, Event1)
2295 ),
2296 Error,
2297 true),
2298 ( var(Error)
2299 -> debug(pengine(event), 'HTTP send: ~p', [Event1]),
2300 ( pengine_thread(ID, Thread)
2301 -> pengine_queue(ID, Queue, TimeLimit, _),
2302 random_delay,
2303 broadcast(pengine(send(ID, Event1))),
2304 thread_send_message(Thread, pengine_request(Event1)),
2305 wait_and_output_result(ID, Queue, Format, TimeLimit, VarNames)
2306 ; atom(ID)
2307 -> pengine_died(Format, ID)
2308 ; http_404([], Request)
2309 )
2310 ; output_result(Format, error(ID, Error))
2311 )
2312 ; debug(pengine(event), 'Pengine module ~q vanished', [Module]),
2313 discard_post_data(Request),
2314 pengine_died(Format, ID)
2315 ).
2316
2317pengine_died(Format, Pengine) :-
2318 output_result(Format, error(Pengine,
2319 error(existence_error(pengine, Pengine),_))).
2320
2321
2326
2327read_event(_Request, EventString, Module, Event, Bindings) :-
2328 nonvar(EventString),
2329 !,
2330 term_string(Event, EventString,
2331 [ variable_names(Bindings),
2332 module(Module)
2333 ]).
2334read_event(Request, _EventString, Module, Event, Bindings) :-
2335 option(method(post), Request),
2336 http_read_data(Request, Event,
2337 [ content_type('application/x-prolog'),
2338 module(Module),
2339 variable_names(Bindings)
2340 ]).
2341
2345
2346discard_post_data(Request) :-
2347 option(method(post), Request),
2348 !,
2349 setup_call_cleanup(
2350 open_null_stream(NULL),
2351 http_read_data(Request, _, [to(stream(NULL))]),
2352 close(NULL)).
2353discard_post_data(_).
2354
2360
2361fix_bindings(Format,
2362 ask(Goal, Options0), Bindings, VarNames,
2363 ask(Goal, NewOptions)) :-
2364 json_lang(Format),
2365 !,
2366 template(Bindings, VarNames, Template, Options0, Options1),
2367 select_option(chunk(Paging), Options1, Options2, 1),
2368 NewOptions = [template(Template), chunk(Paging) | Options2].
2369fix_bindings(_, Command, _, -, Command).
2370
2371template(_, -, Template, Options0, Options) :-
2372 select_option(template(Template), Options0, Options),
2373 !.
2374template(Bindings, VarNames, Template, Options, Options) :-
2375 exclude(anon, Bindings, Bindings1),
2376 maplist(var_name, Bindings1, VarNames),
2377 dict_create(Template, json, Bindings1).
2378
2379anon(Name=_) :-
2380 sub_atom(Name, 0, _, _, '_'),
2381 sub_atom(Name, 1, 1, _, Next),
2382 char_type(Next, prolog_var_start).
2383
2384var_name(Name=_, Name).
2385
2386
2390
2391json_lang(json) :- !.
2392json_lang(Format) :-
2393 sub_atom(Format, 0, _, _, 'json-').
2394
2399
2400http_pengine_pull_response(Request) :-
2401 reply_options(Request, [get]),
2402 !.
2403http_pengine_pull_response(Request) :-
2404 http_parameters(Request,
2405 [ id(ID, []),
2406 format(Format, [default(prolog)])
2407 ]),
2408 ( ( pengine_queue(ID, Queue, TimeLimit, _)
2409 -> true
2410 ; output_queue(ID, Queue, _),
2411 TimeLimit = 0
2412 )
2413 -> wait_and_output_result(ID, Queue, Format, TimeLimit)
2414 ; http_404([], Request)
2415 ).
2416
2423
2424http_pengine_abort(Request) :-
2425 reply_options(Request, [get]),
2426 !.
2427http_pengine_abort(Request) :-
2428 http_parameters(Request,
2429 [ id(ID, []),
2430 format(Format, [default(prolog)])
2431 ]),
2432 ( pengine_thread(ID, _Thread),
2433 pengine_queue(ID, Queue, TimeLimit, _)
2434 -> broadcast(pengine(abort(ID))),
2435 abort_pending_output(ID),
2436 pengine_abort(ID),
2437 wait_and_output_result(ID, Queue, Format, TimeLimit)
2438 ; http_404([], Request)
2439 ).
2440
2441http_pengine_destroy_all(Request) :-
2442 reply_options(Request, [get]),
2443 !.
2444http_pengine_destroy_all(Request) :-
2445 http_parameters(Request,
2446 [ ids(IDsAtom, [])
2447 ]),
2448 atomic_list_concat(IDs, ',', IDsAtom),
2449 forall(member(ID, IDs),
2450 pengine_destroy(ID, [force(true)])),
2451 reply_json("ok").
2452
2458
2459http_pengine_ping(Request) :-
2460 reply_options(Request, [get]),
2461 !.
2462http_pengine_ping(Request) :-
2463 http_parameters(Request,
2464 [ id(Pengine, []),
2465 format(Format, [default(prolog)])
2466 ]),
2467 ( pengine_thread(Pengine, Thread),
2468 catch(thread_statistics(Thread, Stats), _, fail)
2469 -> output_result(Format, ping(Pengine, Stats))
2470 ; output_result(Format, died(Pengine))
2471 ).
2472
2473
2480
2481:- dynamic
2482 pengine_replying/2. 2483
2484output_result(Format, Event) :-
2485 output_result(Format, Event, -).
2486output_result(Format, Event, VarNames) :-
2487 arg(1, Event, Pengine),
2488 thread_self(Thread),
2489 setup_call_cleanup(
2490 asserta(pengine_replying(Pengine, Thread), Ref),
2491 catch(output_result(Format, Event, VarNames, _{}),
2492 pengine_abort_output,
2493 true),
2494 erase(Ref)).
2495
2496output_result(prolog, Event, _, _) :-
2497 !,
2498 format('Content-type: text/x-prolog; charset=UTF-8~n~n'),
2499 write_term(Event,
2500 [ quoted(true),
2501 ignore_ops(true),
2502 fullstop(true),
2503 blobs(portray),
2504 portray_goal(portray_blob),
2505 nl(true)
2506 ]).
2507output_result(Lang, Event, VarNames, Dict) :-
2508 write_result(Lang, Event, VarNames, Dict),
2509 !.
2510output_result(Lang, Event, VarNames, _) :- 2511 write_result(Lang, Event, VarNames),
2512 !.
2513output_result(Lang, Event, VarNames, _) :-
2514 json_lang(Lang),
2515 !,
2516 ( event_term_to_json_data(Event, JSON, Lang, VarNames)
2517 -> cors_enable,
2518 disable_client_cache,
2519 reply_json(JSON)
2520 ; assertion(event_term_to_json_data(Event, _, Lang))
2521 ).
2522output_result(Lang, _Event, _, _) :- 2523 domain_error(pengine_format, Lang).
2524
2532
2533:- public portray_blob/2. 2534portray_blob(Blob, _Options) :-
2535 blob(Blob, Type),
2536 writeq('$BLOB'(Type)).
2537
2542
2543abort_pending_output(Pengine) :-
2544 forall(pengine_replying(Pengine, Thread),
2545 abort_output_thread(Thread)).
2546
2547abort_output_thread(Thread) :-
2548 catch(thread_signal(Thread, throw(pengine_abort_output)),
2549 error(existence_error(thread, _), _),
2550 true).
2551
2557
2565
2571
2572disable_client_cache :-
2573 format('Cache-Control: no-cache, no-store, must-revalidate\r\n\c
2574 Pragma: no-cache\r\n\c
2575 Expires: 0\r\n').
2576
2577event_term_to_json_data(Event, JSON, Lang, VarNames) :-
2578 event_to_json(Event, JSON, Lang, VarNames),
2579 !.
2580event_term_to_json_data(Event, JSON, Lang, -) :-
2581 !,
2582 event_term_to_json_data(Event, JSON, Lang).
2583event_term_to_json_data(success(ID, Bindings0, Time, More),
2584 json{event:success, id:ID, time:Time,
2585 data:Bindings, more:More, projection:VarNames},
2586 json, VarNames) :-
2587 !,
2588 term_to_json(Bindings0, Bindings).
2589event_term_to_json_data(destroy(ID, Event),
2590 json{event:destroy, id:ID, data:JSON},
2591 Style, VarNames) :-
2592 !,
2593 event_term_to_json_data(Event, JSON, Style, VarNames).
2594event_term_to_json_data(create(ID, Features0), JSON, Style, VarNames) :-
2595 !,
2596 ( select(answer(First0), Features0, Features1)
2597 -> event_term_to_json_data(First0, First, Style, VarNames),
2598 Features = [answer(First)|Features1]
2599 ; Features = Features0
2600 ),
2601 dict_create(JSON, json, [event(create), id(ID)|Features]).
2602event_term_to_json_data(Event, JSON, Lang, _) :-
2603 event_term_to_json_data(Event, JSON, Lang).
2604
2605event_term_to_json_data(success(ID, Bindings0, Time, More),
2606 json{event:success, id:ID, time:Time,
2607 data:Bindings, more:More},
2608 json) :-
2609 !,
2610 term_to_json(Bindings0, Bindings).
2611event_term_to_json_data(create(ID, Features0), JSON, Style) :-
2612 !,
2613 ( select(answer(First0), Features0, Features1)
2614 -> event_term_to_json_data(First0, First, Style),
2615 Features = [answer(First)|Features1]
2616 ; Features = Features0
2617 ),
2618 dict_create(JSON, json, [event(create), id(ID)|Features]).
2619event_term_to_json_data(destroy(ID, Event),
2620 json{event:destroy, id:ID, data:JSON}, Style) :-
2621 !,
2622 event_term_to_json_data(Event, JSON, Style, -).
2623event_term_to_json_data(error(ID, ErrorTerm), Error, _Style) :-
2624 !,
2625 Error0 = json{event:error, id:ID, data:Message},
2626 add_error_details(ErrorTerm, Error0, Error),
2627 message_to_string(ErrorTerm, Message).
2628event_term_to_json_data(failure(ID, Time),
2629 json{event:failure, id:ID, time:Time}, _).
2630event_term_to_json_data(EventTerm, json{event:F, id:ID}, _) :-
2631 functor(EventTerm, F, 1),
2632 !,
2633 arg(1, EventTerm, ID).
2634event_term_to_json_data(EventTerm, json{event:F, id:ID, data:JSON}, _) :-
2635 functor(EventTerm, F, 2),
2636 arg(1, EventTerm, ID),
2637 arg(2, EventTerm, Data),
2638 term_to_json(Data, JSON).
2639
2640:- public add_error_details/3.
2641
2646
2647add_error_details(Error, JSON0, JSON) :-
2648 add_error_code(Error, JSON0, JSON1),
2649 add_error_location(Error, JSON1, JSON).
2650
2661
2662add_error_code(error(existence_error(Type, Obj), _), Error0, Error) :-
2663 atom(Type),
2664 !,
2665 to_atomic(Obj, Value),
2666 Error = Error0.put(_{code:existence_error, arg1:Type, arg2:Value}).
2667add_error_code(error(Formal, _), Error0, Error) :-
2668 callable(Formal),
2669 !,
2670 functor(Formal, Code, _),
2671 Error = Error0.put(code, Code).
2672add_error_code(_, Error, Error).
2673
2675to_atomic(Obj, Atomic) :- atom(Obj), !, Atomic = Obj.
2676to_atomic(Obj, Atomic) :- number(Obj), !, Atomic = Obj.
2677to_atomic(Obj, Atomic) :- string(Obj), !, Atomic = Obj.
2678to_atomic(Obj, Atomic) :- term_string(Obj, Atomic).
2679
2680
2686
2687add_error_location(error(_, file(Path, Line, -1, _CharNo)), Term0, Term) :-
2688 atom(Path), integer(Line),
2689 !,
2690 Term = Term0.put(_{location:_{file:Path, line:Line}}).
2691add_error_location(error(_, file(Path, Line, Ch, _CharNo)), Term0, Term) :-
2692 atom(Path), integer(Line), integer(Ch),
2693 !,
2694 Term = Term0.put(_{location:_{file:Path, line:Line, ch:Ch}}).
2695add_error_location(_, Term, Term).
2696
2697
2706
2708
2709
2710 2713
2718
2719allowed(Request, Application) :-
2720 setting(Application:allow_from, Allow),
2721 match_peer(Request, Allow),
2722 setting(Application:deny_from, Deny),
2723 \+ match_peer(Request, Deny),
2724 !.
2725allowed(Request, _Application) :-
2726 memberchk(request_uri(Here), Request),
2727 throw(http_reply(forbidden(Here))).
2728
2729match_peer(_, Allowed) :-
2730 memberchk(*, Allowed),
2731 !.
2732match_peer(_, []) :- !, fail.
2733match_peer(Request, Allowed) :-
2734 http_peer(Request, Peer),
2735 debug(pengine(allow), 'Peer: ~q, Allow: ~q', [Peer, Allowed]),
2736 ( memberchk(Peer, Allowed)
2737 -> true
2738 ; member(Pattern, Allowed),
2739 match_peer_pattern(Pattern, Peer)
2740 ).
2741
2742match_peer_pattern(Pattern, Peer) :-
2743 ip_term(Pattern, IP),
2744 ip_term(Peer, IP),
2745 !.
2746
2747ip_term(Peer, Pattern) :-
2748 split_string(Peer, ".", "", PartStrings),
2749 ip_pattern(PartStrings, Pattern).
2750
2751ip_pattern([], []).
2752ip_pattern([*], _) :- !.
2753ip_pattern([S|T0], [N|T]) :-
2754 number_string(N, S),
2755 ip_pattern(T0, T).
2756
2757
2762
2763authenticate(Request, Application, UserOptions) :-
2764 authentication_hook(Request, Application, User),
2765 !,
2766 must_be(ground, User),
2767 UserOptions = [user(User)].
2768authenticate(_, _, []).
2769
2789
2790pengine_register_user(Options) :-
2791 option(user(User), Options),
2792 !,
2793 pengine_self(Me),
2794 asserta(pengine_user(Me, User)).
2795pengine_register_user(_).
2796
2797
2805
2806pengine_user(User) :-
2807 pengine_self(Me),
2808 pengine_user(Me, User).
2809
2813
2814reply_options(Request, Allowed) :-
2815 option(method(options), Request),
2816 !,
2817 cors_enable(Request,
2818 [ methods(Allowed)
2819 ]),
2820 format('Content-type: text/plain\r\n'),
2821 format('~n'). 2822
2823
2824 2827
2834
2835pengine_src_text(Src, Module) :-
2836 pengine_self(Self),
2837 format(atom(ID), 'pengine://~w/src', [Self]),
2838 extra_load_options(Self, Options),
2839 setup_call_cleanup(
2840 open_chars_stream(Src, Stream),
2841 load_files(Module:ID,
2842 [ stream(Stream),
2843 module(Module),
2844 silent(true)
2845 | Options
2846 ]),
2847 close(Stream)),
2848 keep_source(Self, ID, Src).
2849
2857
2858pengine_src_url(URL, Module) :-
2859 pengine_self(Self),
2860 uri_encoded(path, URL, Path),
2861 format(atom(ID), 'pengine://~w/url/~w', [Self, Path]),
2862 extra_load_options(Self, Options),
2863 ( get_pengine_application(Self, Application),
2864 setting(Application:debug_info, false)
2865 -> setup_call_cleanup(
2866 http_open(URL, Stream, []),
2867 ( set_stream(Stream, encoding(utf8)),
2868 load_files(Module:ID,
2869 [ stream(Stream),
2870 module(Module)
2871 | Options
2872 ])
2873 ),
2874 close(Stream))
2875 ; setup_call_cleanup(
2876 http_open(URL, TempStream, []),
2877 ( set_stream(TempStream, encoding(utf8)),
2878 read_string(TempStream, _, Src)
2879 ),
2880 close(TempStream)),
2881 setup_call_cleanup(
2882 open_chars_stream(Src, Stream),
2883 load_files(Module:ID,
2884 [ stream(Stream),
2885 module(Module)
2886 | Options
2887 ]),
2888 close(Stream)),
2889 keep_source(Self, ID, Src)
2890 ).
2891
2892
(Pengine, Options) :-
2894 pengine_not_sandboxed(Pengine),
2895 !,
2896 Options = [].
2897extra_load_options(_, [sandboxed(true)]).
2898
2899
2900keep_source(Pengine, ID, SrcText) :-
2901 get_pengine_application(Pengine, Application),
2902 setting(Application:debug_info, true),
2903 !,
2904 to_string(SrcText, SrcString),
2905 assertz(pengine_data(Pengine, source(ID, SrcString))).
2906keep_source(_, _, _).
2907
2908to_string(String, String) :-
2909 string(String),
2910 !.
2911to_string(Atom, String) :-
2912 atom_string(Atom, String),
2913 !.
2914
2915
2916 2919
2920prolog:error_message(sandbox(time_limit_exceeded, Limit)) -->
2921 [ 'Could not prove safety of your goal within ~f seconds.'-[Limit], nl,
2922 'This is normally caused by an insufficiently instantiated'-[], nl,
2923 'meta-call (e.g., call(Var)) for which it is too expensive to'-[], nl,
2924 'find all possible instantations of Var.'-[]
2925 ].
2926
2927
2928 2931
2932:- multifile
2933 sandbox:safe_primitive/1, 2934 sandbox:safe_meta/2. 2935
2944
2945sandbox:safe_primitive(pengines:pengine_destroy(_,_)).
2946sandbox:safe_primitive(pengines:pengine_event(_, _)).
2947sandbox:safe_primitive(pengines:pengine_send(_, _, _)).
2948sandbox:safe_primitive(pengines:pengine_input(_, _)).
2949sandbox:safe_primitive(pengines:pengine_output(_)).
2950sandbox:safe_primitive(pengines:pengine_debug(_,_)).
2951sandbox:safe_primitive(pengines:pengine_ask(_, _, _)).
2952sandbox:safe_primitive(pengines:pengine_pull_response(_,_)).
2953sandbox:safe_primitive(pengines:pengine_user(_)).
2954
2960
2961sandbox:safe_meta(pengines:pengine_create(_), []).
2962sandbox:safe_meta(pengines:pengine_rpc(_, _, _), []).
2963sandbox:safe_meta(pengines:pengine_event_loop(_,Closure,_,_), [Closure1]) :-
2964 extend_goal(Closure, [_], Closure1).
2965
2966extend_goal(Var, _, _) :-
2967 var(Var),
2968 !,
2969 instantiation_error(Var).
2970extend_goal(M:Term0, Extra, M:Term) :-
2971 extend_goal(Term0, Extra, Term).
2972extend_goal(Atom, Extra, Goal) :-
2973 atom(Atom),
2974 !,
2975 Goal =.. [Atom|Extra].
2976extend_goal(Compound, Extra, Goal) :-
2977 compound(Compound),
2978 !,
2979 compound_name_arguments(Compound, Name, Args0),
2980 append(Args0, Extra, Args),
2981 compound_name_arguments(Goal, Name, Args).