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'). |