1		% (c) 2009-2019 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2		% Heinrich Heine Universitaet Duesseldorf
3		% This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5		:- module(prob_socketserver, [start/1]).
6
7		:- use_module(module_information,[module_info/2]).
8		:- module_info(group,cli).
9		:- module_info(description,'The socket server is used to interface to Java and other languages.').
10
11		:- use_module(version).
12		:- use_module(eclipse_interface).
13		:- use_module(prob2_interface).
14		:- use_module(extension('user_signal/user_signal'),[get_user_signal_ref/1,
15		user_interruptable_call_det/2,
16		ignore_user_interrupt_det/1]).
17
18		:- use_module(logger, [writeln_log/1, get_log_file/1,
19		writeln_log_time/1,
20		logging_is_enabled/0]).
21		:- use_module(library(sockets)).
22		:- use_module(library(lists)).
23
24		:- op(1150, fx, type).
25
26		%prolog_socket :- start(_).
27
28		:- dynamic socket_opened/1.
29
30		start(Port) :-
31		on_exception(E, ignore_user_interrupt_det(start2(Port)),
32		( E=halt(C) -> throw(halt(C))
33		; otherwise ->
34		my_format_error("Exception in Socket Server: ~w~n",[E]),fail)),
35		!.
36		start(Port) :- my_format_error("Listening to Port failed: ~w~n",[Port]),
37		retract(socket_opened(Socket)),
38		my_format("Attempting to close socket: ~w~n",[Socket]),
39		socket_server_close_sp4(Socket),
40		my_format("Socket closed: ~w~n",[Socket]).
41
42
43		socket_server_open_sp4(Port,Socket) :-
44		(socket_server_open(Port,Socket,[loopback(true)])
45		-> true
46		; my_format_error("Unable to bind sp4 socket: ~w to localhost:~w.~n",[Socket,Port]),fail).
47
48
49		socket_server_close_sp4(Socket) :- socket_server_close(Socket).
50
51		socket_accept_sp4(Socket, Stream) :-
52		socket_server_accept(Socket, Client, Stream, [type(text),encoding('UTF-8')]),
53		my_format("Connected: ~w~n",[Client]).
54
55		start2(Port) :-
56		% print(socket('AF_INET', Socket)),nl,
57		socket_server_open_sp4(Port,Socket),
58		assert(socket_opened(Socket)),
59		%open(prologport, write,Stream),
60		%format(Stream,'~w~n',[Port]),
61		%close(Stream),
62		prolog_flag(user_output, Stdout, Stdout),
63		format(Stdout,'Port: ~w~n', [Port]),
64		writeln_log(port(Port)),
65		revision(Revision),
66		format(Stdout,'probcli revision: ~w~n',[Revision]),
67		get_user_signal_ref(Ref),
68		format(Stdout,'user interrupt reference id: ~w~n',[Ref]),
69		format(Stdout,'-- starting command loop --~n', []),
70		flush_output(Stdout),
71		wait(Socket),
72		socket_server_close_sp4(Socket),!,
73		my_format("Socket closed: ~w~n",[Socket]),
74		writeln_log(socket_closed(Socket)).
75
76
77		%% Wait for a connection on the given socket
78		wait(Socket) :-
79		socket_accept_sp4(Socket, Stream),
80		read_socket(Socket, Stream).
81
82		% adding meta_predicate makes ProB2 fail:
83		%:- meta_predicate make_call(-,0,-).
84		%:- meta_predicate do_call(0,-,-).
85
86		%% We have a connection so just wait for valid terms, and return either
87		%% OK X=val\000Y=val1
88		%% FAIL\000
89		%% ERROR SHORT long message here\000
90		read_socket(Socket,Stream) :-
91		%print(listening_on_socket(Socket)),nl, flush_output(user_output),
92		on_exception(E,
93		read_term(Stream, Term, [variable_names(Vars)]),
94		(portray_clause(user_output,goal_parse_error),Parse=fail,exception(E,Stream))),
95
96		%print(received_term(Term)),nl, flush_output(user_output),
97		(Parse=ok ->
98		((Term == end_of_file ; Term==halt) ->
99		socket_server_close_sp4(Socket),
100		throw(halt(0))
101		; %portray_clause(user_output,calling(Term)),
102		make_call(Stream, Term, Vars)
103		%portray_clause(user_output,exit(Term))
104		)
105		;
106		%% Parse failed, but we have already written error message
107		%print(an_exception_occurred(E)),nl,
108		portray_clause(user_output, an_exception_occurred(E))
109		),
110		%print(done(Term)),nl,
111		%flush_output(user_output),
112		%flush_output,
113		%put_code(Stream, 1),
114
115		flush_output(Stream),
116		flush_output(user_output),
117		read_socket(Socket, Stream).
118
119
120		%% We have a valid term so make the call
121		make_call(Stream,Term, Vars) :-
122		% write(make_call(Term)),nl,flush_output(user_output),
123		on_exception(CallEx,
124		do_call(Term,Vars,Result),
125		(portray_clause(user_output, exception(make_call/3, CallEx)),
126		writeln_log(exception(CallEx)),
127		Result=exception(CallEx)
128		)),
129		write_canonical(Stream,Result), %writeln_log(result(Result)),
130		nl(Stream), put_code(Stream,1),
131		flush_output(Stream).
132
133		do_call(Call,Vars,ResOut) :- %print(do_call(Call)),nl,flush_output(user_output),
134		writeln_logtime_call_start(Call,Timer), %logger:writeln_log_time(do_call(Call)),
135		(white_list(Call)
136		-> (do_not_interrupt_this_call(Call)
137		-> call(Call),
138		IRes = ok
139		; user_interruptable_call_det(call(Call),IRes)
140		),
141		(IRes = interrupted -> ResOut = interrupted ; ResOut = yes(Vars))
142		; my_format_error('Call not on whitelist: ~w.\n',[Call]),fail
143		),
144		((ground(Vars);Call=debug_console(_,_);ResOut = interrupted)
145		% print(success(Call)),nl,flush_output(user_output),
146		-> writeln_logtime_call_end(Call,Timer)
147		%-> logger:writeln_log_time(success(Call))
148		; raise_exception(result_is_not_ground)),
149		% \+ next_char_is_semicolon(Stream), /*Otherwise force backtracking */
150		!.
151		do_call(_Call,_Vars,no) :-
152		writeln_log(no).
153
154		:- dynamic exported_by_eclipse_interface/2.
155		white_list(halt). % needed to stop ProB
156		white_list(true). % to prevent fails because of empty queries
157		white_list((A,B)) :- white_list(A),white_list(B). % concatenation used to send several commands at once
158		white_list(C) :- nonvar(C),functor(C,Functor,Arity), % all public predicates of the module
159		is_exported_by_eclipse_interface(Functor,Arity). % eclipse_interface can be used
160		is_exported_by_eclipse_interface(Functor,Arity) :-
161		exported_by_eclipse_interface(Functor,Arity),!.
162		is_exported_by_eclipse_interface(Functor,Arity) :-
163		% check that the list has not already been generated
164		\+ exported_by_eclipse_interface(_,_),
165		% generate the list
166		create_exported_by_eclipse_interface_list,
167		% do the check again
168		exported_by_eclipse_interface(Functor,Arity).
169		create_exported_by_eclipse_interface_list :-
170		% fail-driven loop over the predicates imported from eclipse_interface
171		predicate_property(prob_socketserver:P,imported_from(eclipse_interface)),
172		functor(P,Functor,Arity),
173		assert(exported_by_eclipse_interface(Functor,Arity)),
174		fail.
175		create_exported_by_eclipse_interface_list :-
176		% fail-driven loop over the predicates imported from prob2_interface
177		predicate_property(prob_socketserver:P,imported_from(prob2_interface)),
178		functor(P,Functor,Arity),
179		assert(exported_by_eclipse_interface(Functor,Arity)),
180		fail.
181		create_exported_by_eclipse_interface_list.
182
183
184		do_not_interrupt_this_call((A,B)) :-
185		(do_not_interrupt_this_call(A) ; do_not_interrupt_this_call(B)).
186		do_not_interrupt_this_call(do_modelchecking(_,_,_,_)). % interrupting prob can lead to spurious deadlocks at the moment
187
188		%next_char_is_semicolon(Stream) :- %print(peeking(Stream)),nl,
189		% peek_code(Stream,X),!,
190		% ((X=10;X=13)
191		% -> (get_code(Stream,_),next_char_is_semicolon(Stream))
192		% ; (X=59,get_code(Stream,_))).
193
194
195		get_stream_info(S,Info) :-
196		on_exception(E,get_stream_info1(S,Info),(portray_clause(user_output, exception(E)))).
197
198		get_stream_info1(S,blank):-
199		portray_clause(user_output, stream_is(S)),
200		%true.
201		fail.
202		get_stream_info1(S, Info) :-
203		stream_property(S,file_name(Info)),!.
204		get_stream_info1(S, Info) :-
205		stream_property(S,alias(Info)),
206		!.
207		get_stream_info1(_S, unknown).
208
209
210		tokens_to_string([],[]).
211		tokens_to_string([A|As], [B|Bs]) :-
212		token_to_string1(A,B),
213		tokens_to_string(As,Bs).
214
215		token_to_string1(atom(A)-_, A) :- !.
216		token_to_string1(var(_,S,_)-_, A) :- !,
217		atom_codes(A,S).
218		token_to_string1(A, A).
219
220
221		%% Exception handlers
222		%% First Argument is Sicstus exception, second is verbose message for user
223		exception(E,_Stream) :-
224		portray_clause(user_output,E),fail.
225
226
227		exception(syntax_error(Call, Pos, Msg, Tokens,Lineend),Stream) :-
228		!,
229		portray_clause(user_output,syntax_stream(Call)),
230		(Call = read_term(Err,_,_) ->
231		get_stream_info(Err,Info)
232		;
233		Info = unknown_stream
234		),
235		tokens_to_string(Tokens,Where),
236
237		my_format_error(Stream,'exception(ERR-~@PARSE~@~w in ~w\nlines::~w-~w\nCheck ~w)\n', [put_code(1),put_code(1),Msg,Info,Pos,Lineend,Where]),
238		put_code(Stream, 1).
239
240		exception(existence_error(_, _, _, _, past_end_of_stream),Stream) :-
241		!,
242		my_format_error(Stream,'exception(ERR-~@EXISTENCE~@Attempted to read past end of stream)', [put_code(1),put_code(1)]),
243		put_code(Stream, 1) .
244
245		exception(existence_error(_, _,procedure,PredSpec,_),Stream) :-
246		!,
247		my_format_error(Stream,'exception(ERR-~@EXISTENCE~@Unable to call predicate ~w)', [put_code(1),put_code(1),PredSpec]),
248		put_code(Stream, 1) .
249
250		exception(existence_error(_, _,file,PredSpec,_),Stream) :-
251		!,
252		my_format_error(Stream,'exception(ERR-~@EXISTENCE~@Unable to open file ~w)', [put_code(1),put_code(1),PredSpec]),
253		put_code(Stream, 1) .
254
255		exception(E,Stream) :-
256		my_format_error(Stream,'exception(ERR-~@UNKNOWN~@~w)', [put_code(1),put_code(1),E]),
257		put_code(Stream, 1),
258		portray_clause(user_output,unknown_exception(E)).
259
260
261
262		my_format(FS,Args) :- my_format(user_output,FS,Args).
263		my_format_error(FS,Args) :- my_format(user_error,FS,Args).
264		my_format_error(Stream,FS,Args) :- my_format(Stream,FS,Args).
265
266		my_format(Stream,FS,Args) :- format(Stream,FS,Args),
267		(get_log_file(F)
268		-> open(F,append,S),
269		format(S,FS,Args),
270		close(S)
271		; true
272		).
273
274		writeln_logtime_call_start(Term,timer(Time,WTime)) :-
275		((logging_is_enabled ; runtime_profile_available) ->
276		statistics(runtime,[Time,_]),
277		statistics(walltime,[WTime,_]),
278		(logging_is_enabled
279		-> get_functors(Term,Fs),
280		writeln_log(start_call(walltime(WTime),Fs))
281		; true)
282		; true).
283
284		:- use_module(runtime_profiler,[register_profiler_runtime/4, runtime_profile_available/0]).
285		writeln_logtime_call_end(Term,timer(Time,WTime)) :-
286		%format(user_output,'End for ~w~n',[Time]),
287		((logging_is_enabled ; runtime_profile_available) ->
288		statistics(runtime,[Time2,_]), RT is Time2-Time,
289		statistics(walltime,[WTime2,_]), WT is WTime2-WTime,
290		get_functors(Term,Fs),
291		(logging_is_enabled
292		-> statistics(memory_used,M), MB is M / 1048576,
293		writeln_log(end___call(walltime(WTime2),delta_rt_wt(RT,WT),mb_used(MB),Fs))
294		; true),
295		register_profiler_runtime(Fs,unknown,RT,WT)
296		; true).
297
298		get_functors(Var,V) :- var(Var),!, V='_'.
299		get_functors((A,B),(FA,FB)) :- !, get_functors(A,FA), get_functors(B,FB).
300		%get_functors(A,F/list(Len)) :- functor(A,F,1), arg(1,A,Ls), nonvar(Ls), Ls = [_|_],
301		% ground(Ls), length(Ls,Len),!.
302		get_functors(A,F/N) :- functor(A,F,N).
303
304		%runtime_entry(start) :- go_cli.
305
306		%save :- save_program('probcli.sav').