1 % (c) 2009-2026 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(system_call,[system_call/4, system_call_with_options/5,
6 system_call/5, system_call_with_options/6,
7 system_call_keep_open/7,
8 system_call_keep_open_no_stdin/6,
9 system_call_keep_open_no_pipes/4,
10 get_writable_compiled_filename/3,
11 get_writable_compiled_filename/4, generate_temporary_cspm_file/2,
12 get_temporary_filename/2,
13 get_command_path/2,
14 safe_process_create/3]).
15 :- use_module(module_information).
16 :- module_info(group,tools).
17 :- module_info(description,'Tools for calling underlying system procedures or binaries (java, dot, krt,...).').
18
19 :- use_module(library(process)).
20 :- use_module(library(file_systems)).
21 :- use_module(error_manager).
22
23 :- use_module(tools,[ajoin/2]).
24 :- use_module(tools_meta,[safe_on_exception/3]).
25
26 safe_process_create(Command,Args,ProcessCreateOptions) :-
27 safe_on_exception(E,
28 process:process_create(Command, Args, ProcessCreateOptions),
29 ( ajoin(['Could not execute command "',Command,'" due to exception: '],Msg),
30 add_error(system_call,Msg,E),fail)).
31 % for existence error we could check if Command has .exe extension on Windows
32
33 % a version where we do not return a stream for stdin
34 system_call_keep_open_no_stdin(Command,Args,Process,STDOut,STDErr,Env) :-
35 safe_process_create(Command,Args,
36 [process(Process),
37 stdout(pipe(STDOut,[encoding(utf8)])),
38 stderr(pipe(STDErr,[encoding(utf8)])),
39 environment(Env)]).
40
41 system_call_keep_open(Command,Args,Process,STDIn,STDOut,STDErr,Env) :-
42 safe_process_create(Command,Args,
43 [process(Process),
44 stdout(pipe(STDOut,[encoding(utf8)])),
45 stdin(pipe(STDIn,[encoding(utf8)])),
46 stderr(pipe(STDErr,[encoding(utf8)])),
47 environment(Env)]).
48
49 system_call_keep_open_no_pipes(Command,Args,Process,Env) :-
50 safe_process_create(Command, Args,
51 [process(Process),environment(Env)]).
52
53 system_call(Command,Args,ErrorTextAsCodeList,ExitCode) :-
54 system_call_with_options(Command,Args,[],ErrorTextAsCodeList,ExitCode).
55
56 system_call_with_options(Command,Args,Options,ErrorTextAsCodeList,ExitCode) :-
57 safe_process_create(Command, Args,
58 [process(Process),stderr(pipe(JStderr,[encoding(utf8)]))|Options]),
59
60 read_all(JStderr,Command,stderr,ErrorTextAsCodeList),
61 my_process_wait(Process,ExitCode).
62
63 system_call(Command,Args,OutputTextAsCodeList,ErrorTextAsCodeList,ExitCode) :-
64 system_call_with_options(Command,Args,[],OutputTextAsCodeList,ErrorTextAsCodeList,ExitCode).
65
66 system_call_with_options(Command,Args,Options,OutputTextAsCodeList,ErrorTextAsCodeList,ExitCode) :-
67 %StreamOptions = [encoding('UTF-8')], % we could use pipe(JStdout,StreamOptions), ... below
68 safe_process_create(Command, Args,
69 [process(Process),
70 stdout(pipe(JStdout,[encoding(utf8)])),stderr(pipe(JStderr,[encoding(utf8)]))|Options]),
71 read_all(JStdout,Command,stdout,OutputTextAsCodeList),
72 read_all(JStderr,Command,stderr,ErrorTextAsCodeList),
73 my_process_wait(Process,ExitCode).
74
75 my_process_wait(Process,ExitCode) :- (ExitCode == no_process_wait -> true ; process_wait(Process,ExitCode)).
76
77 get_command_path(CmdName,CmdPath) :-
78 absolute_file_name(path(CmdName),
79 CmdPath,
80 [access(exist),extensions(['.exe','']),solutions(all),file_errors(fail)]),!.
81 get_command_path(CmdName,_) :-
82 add_error_fail(get_command_path,'Could not get path to command: ',CmdName).
83
84
85 :- use_module(library(lists)).
86
87 % read all characters from a stream
88 read_all(S,Command,Pipe,Text) :-
89 call_cleanup(read_all1(S,Command,Pipe,Text),
90 close(S)).
91 read_all1(S,Command,Pipe,Text) :-
92 catch(read_all2(S,Lines), error(_,E), ( % E could be system_error('SPIO_E_ENCODING_INVALID')
93 ajoin(['Error reading ',Pipe,' for "',Command,'" due to exception: '],Msg),
94 add_error(system_call,Msg,E),
95 fail
96 )),
97 append(Lines,Text).
98 read_all2(S,Text) :-
99 read_line(S,Line),
100 ( Line==end_of_file ->
101 Text=[[]]
102 ;
103 Text = [Line, [0'\n] | Rest],
104 read_all2(S,Rest)).
105
106 :- use_module(tools,[get_tail_filename/2]).
107 generate_temporary_cspm_file(CSPFile,CSPFileNameTemp):-
108 get_writable_compiled_filename(CSPFile,'.tmp',CSPFileNameTemp).
109
110 :- use_module(debug,[debug_println/2]).
111 get_writable_compiled_filename(SourceFile,Extension,WritableFile) :-
112 get_writable_compiled_filename(SourceFile,Extension,WritableFile,_).
113 get_writable_compiled_filename(SourceFile,Extension,WritableFile,IsTemporaryFile) :-
114 atom_concat(SourceFile,Extension,WFile),
115 debug_println(9,generating_writable_file(SourceFile,Extension)),
116 (file_exists(WFile),
117 file_property(WFile,writable)
118 -> debug_println(9,file_writable(WFile)), IsTemporaryFile=false,
119 WritableFile=WFile
120 ; get_tail_filename(WFile,TFile),
121 safe_on_exception(_E,
122 (open(WFile,write,S1,[]),close(S1),WritableFile=WFile,
123 IsTemporaryFile=false),
124 (IsTemporaryFile=true,
125 get_temporary_filename(TFile,WritableFile)) )
126 ).
127
128 :- use_module(tools, [open_temp_file/3]).
129 get_temporary_filename(PreferredFileName,WritableFile) :-
130 debug_println(9,trying_to_get_temporary_filename(PreferredFileName)),
131 open_temp_file(PreferredFileName, WritableFile, S1),
132 debug_println(9,temporary_file(WritableFile)),
133 close(S1).