/pliant/admin/execute.pli
1	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
2	#
3	# This program is free software; you can redistribute it and/or
4	# modify it under the terms of the GNU General Public License version 2
5	# as published by the Free Software Foundation.
6	#
7	# This program is distributed in the hope that it will be useful,
8	# but WITHOUT ANY WARRANTY; without even the implied warranty of
9	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
10	# GNU General Public License for more details.
11	#
12	# You should have received a copy of the GNU General Public License
13	# version 2 along with this program; if not, write to the Free Software
14	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
15
16	module "/pliant/language/compiler.pli"
17	module "/pliant/language/os.pli"
18	module "/pliant/language/stream.pli"
19	module "/pliant/language/stream/handle.pli"
20	module "/pliant/admin/file.pli"
21
22
23	if os_api="linux"
24	module "/pliant/language/schedule/threads_engine.pli"
25
26	function close_handles
27	var Int maxi := stream_maximum_handle+stream_pending_handles+5
28	for (var Int h) 3 maxi
29	os_close h
30
31	gcc_off
32
33	function execute1 cmd path root user group input output err envptr detached id -> retcode
34	arg Str cmd path root ; arg Int user group input output err ; arg Address envptr ; arg CBool detached ; arg_rw Int id ; arg Int retcode
35	var Address args := (memory_allocate 8*Address:size+(cmd:len+1)*Address:size null) translate Address 8
36	var Int nb := 0
37	var Int base := 0
38	var Char stop := " "
39	for (var Int i) 0 cmd:len
40	if i=cmd:len or cmd:i=stop
41	if i>base or stop="'"
42	var Pointer:Address arg :> (args translate Address nb) map Address
43	arg := memory_allocate i-base+1 args
44	for (var Int j) base i-1
45	(arg translate Byte j-base) map uInt8 := cmd:j:number
46	(arg translate Byte i-base) map uInt8 := 0
47	nb := nb+1
48	stop := " "
49	base := i+1
50	eif i=base and cmd:i="'" and stop=" "
51	base := i+1
52	stop := "'"
53	var Address pathz
54	if path<>""
55	pathz := memory_allocate path:len+1 null
56	memory_copy path:characters pathz path:len
57	(pathz translate Byte path:len) map uInt8 := 0
58	else
59	pathz := null
60	var Address rootz
61	if root<>""
62	rootz := memory_allocate root:len+1 null
63	memory_copy root:characters rootz root:len
64	(rootz translate Byte root:len) map uInt8 := 0
65	else
66	rootz := null
67	(args translate Address -1) map Address := pathz
68	(args translate Address -2) map Address := rootz
69	(args translate Address -3) map Int := user
70	(args translate Address -4) map Int := group
71	(args translate Address -5) map Int := input
72	(args translate Address -6) map Int := output
73	(args translate Address -7) map Int := err
74	(args translate Address -8) map Address := envptr
75	(args translate Address nb) map Address := null
76	if nb<>0
77	var Pointer:ThreadHeader h :> allocate_stack
78	if addressof:h=null
79	retcode := undefined
80	return
81	h address := args
82	if detached
83	var Int pid := os_clone 8000h (addressof:h translate Byte -256)
84	if pid=0
85	h :> current_thread_header
86	h pid := os_getpid
87	os_setsid
88	if ((h:address translate Address -1) map Address)<>null
89	os_chdir ((h:address translate Address -1) map CStr)
90	if ((h:address translate Address -2) map Address)<>null
91	os_chroot ((h:address translate Address -2) map CStr)
92	if ((h:address translate Address -4) map Int)=defined
93	os_setgid ((h:address translate Address -4) map Int)
94	if ((h:address translate Address -3) map Int)=defined
95	os_setuid ((h:address translate Address -3) map Int)
96	if ((h:address translate Address -5) map Int)=defined
97	os_dup2 ((h:address translate Address -5) map Int) 0
98	if ((h:address translate Address -6) map Int)=defined
99	os_dup2 ((h:address translate Address -6) map Int) 1
100	if ((h:address translate Address -7) map Int)=defined
101	os_dup2 ((h:address translate Address -7) map Int) 2
102	close_handles
103	os_execve (h:address map CStr) h:address ((h:address translate Address -8) map Address)
104	os_exit 99
105	eif pid=(-1)
106	retcode := undefined
107	else
108	id := pid
109	var os_timespec spec
110	spec tv_sec := 0
111	spec tv_nsec := 100*1000^2
112	os_nanosleep spec (null map os_timespec)
113	retcode := 0
114	free_stack h
115	else
116	var Int pid := os_clone 0 (addressof:h translate Byte -256)
117	if pid=0
118	h :> current_thread_header
119	h pid := os_getpid
120	if ((h:address translate Address -1) map Address)<>null
121	os_chdir ((h:address translate Address -1) map CStr)
122	if ((h:address translate Address -2) map Address)<>null
123	os_chroot ((h:address translate Address -2) map CStr)
124	if ((h:address translate Address -4) map Int)=defined
125	os_setgid ((h:address translate Address -4) map Int)
126	if ((h:address translate Address -3) map Int)=defined
127	os_setuid ((h:address translate Address -3) map Int)
128	if ((h:address translate Address -5) map Int)=defined
129	os_dup2 ((h:address translate Address -5) map Int) 0
130	if ((h:address translate Address -6) map Int)=defined
131	os_dup2 ((h:address translate Address -6) map Int) 1
132	if ((h:address translate Address -7) map Int)=defined
133	os_dup2 ((h:address translate Address -7) map Int) 2
134	close_handles
135	os_execve (h:address map CStr) h:address ((h:address translate Address -8) map Address)
136	os_exit 99
137	eif pid=(-1)
138	retcode := undefined
139	else
140	id := pid
141	os_waitpid pid (var Int status) 80000000h
142	retcode := (status .and. 0FF00h)\100h
143	free_stack h
144	else
145	retcode := undefined
146	for (var Int i) -2 nb-1
147	memory_free ((args translate Address i) map Address)
148	memory_free (args translate Address -8)
149
150	gvar Array:Str paths
151	paths += "/sbin/"
152	paths += "/bin/"
153	paths += "/usr/sbin/"
154	paths += "/usr/bin/"
155	paths += "/usr/local/sbin/"
156	paths += "/usr/local/bin/"
157	paths += "/usr/X11R6/bin/"
158
159	gvar List pids
160	gvar Sem sem
161
162	function restore_execute_pids p fh
163	arg Address p ; arg Int fh
164	pids := var List empty_list
165	gvar DelayedAction restore
166	restore function :> the_function restore_execute_pids Address Int
167	pliant_restore_actions append addressof:restore
168
169	function execute2 cmd path root user group input output err env detached id -> retcode
170	arg Str cmd path root ; arg Int user group ; arg Str input output err env ; arg CBool detached ; arg_w Int id ; arg Int retcode
171	sem request
172	var Pointer:Arrow c :> pids first
173	while c<>null
174	if (os_waitpid (c map Int) (var Int status) 80000001h)=(c map Int)
175	c :> pids remove c
176	else
177	c :> pids next c
178	sem release
179	id := undefined
180	var Stream in_stream out_stream err_stream
181	if input<>"" and output=input
182	in_stream open input "inherit" in+out+safe
183	if in_stream:stream_handle=undefined
184	return -6
185	out_stream stream_handle := in_stream stream_handle
186	else
187	if input<>""
188	in_stream open input "inherit" in+safe
189	if in_stream:stream_handle=undefined
190	return -6
191	if output<>""
192	out_stream open output "inherit" out+safe
193	if out_stream:stream_handle=undefined
194	return -7
195	if err<>"" and err<>"mixed"
196	err_stream open err "inherit" out+safe
197	if err_stream:stream_handle=undefined
198	return -8
199	var Str cmd2
200	if (cmd 0 1)<>"/" and (cmd 0 2)<>"./"
201	if path<>"" and (os_lstat file_os_name:path+(cmd 0 (cmd search " " cmd:len)) (var os_stat stat))=0
202	cmd2 := cmd
203	else
204	var Str os_root := file_os_name root ; os_root := os_root 0 (max os_root:len-1 0)
205	part scan
206	for (var Int i) 0 paths:size-1
207	if (os_lstat os_root+paths:i+(cmd 0 (cmd search " " cmd:len)) (var os_stat stat))=0
208	cmd2 := paths:i+cmd
209	leave scan
210	return (-1)
211	else
212	cmd2 := cmd
213	var Address envptr
214	if env=""
215	envptr := linux_process_env
216	else
217	var Array:Address ptrs
218	var Int i := 0
219	while { var Int j := (env i env:len) search "[0]" -1 ; j<>(-1) }
220	ptrs += env:characters translate Byte i
221	i += j+1
222	ptrs += null
223	envptr := addressof ptrs:0
224	retcode := execute1 cmd2 file_os_name:path file_os_name:root user group in_stream:stream_handle out_stream:stream_handle (shunt err<>"mixed" err_stream:stream_handle out_stream:stream_handle) envptr detached id
225	if detached and retcode=0
226	sem request
227	pids append addressof:(new Int id)
228	sem release
229
230	eif os_api="posix"
231
232	function execute1 cmd path user group input output err -> retcode
233	arg Str cmd path ; arg Int user group input output err ; arg Int retcode
234	var Address args := memory_allocate (cmd:len+1)*Address:size null
235	var Int nb := 0
236	var Int base := 0
237	for (var Int i) 0 cmd:len
238	if i=cmd:len or cmd:i=" "
239	if i>base
240	var Pointer:Address arg :> (args translate Address nb) map Address
241	arg := memory_allocate i-base+1 args
242	for (var Int j) base i-1
243	(arg translate Byte j-base) map uInt8 := cmd:j:number
244	(arg translate Byte i-base) map uInt8 := 0
245	nb := nb+1
246	base := i+1
247	if path<>""
248	os_chdir path
249	if group=defined
250	os_setgid group
251	if user=defined
252	os_setuid user
253	if input=defined
254	os_dup2 input 0
255	if output=defined
256	os_dup2 output 1
257	if err=defined
258	os_dup2 err 2
259	os_execvp (args map CStr) args
260	for (var Int i) 0 nb-1
261	memory_free ((args translate Address i) map Address)
262	memory_free args
263
264	gvar Array:Str paths
265	paths += "/sbin/"
266	paths += "/bin/"
267	paths += "/usr/sbin/"
268	paths += "/usr/bin/"
269	paths += "/usr/local/sbin/"
270	paths += "/usr/local/bin/"
271	paths += "/usr/X11R6/bin/"
272
273	function execute2 cmd path root user group input output err env detached id -> retcode
274	arg Str cmd path root ; arg Int user group ; arg Str input output err env ; arg CBool detached ; arg_w Int id ; arg Int retcode
275	id := undefined
276	if root<>""
277	return -3
278	if detached
279	return -9
280	var Stream in_stream out_stream err_stream
281	if input<>"" and output=input
282	in_stream open input "inherit" in+out+safe
283	if in_stream:stream_handle=undefined
284	return -6
285	out_stream stream_handle := in_stream stream_handle
286	else
287	if input<>""
288	in_stream open input "inherit" in+safe
289	if in_stream:stream_handle=undefined
290	return -6
291	if output<>""
292	out_stream open output "inherit" out+safe
293	if out_stream:stream_handle=undefined
294	return -7
295	if err<>"" and err<>"mixed"
296	err_stream open err "inherit" out+safe
297	if out_stream:stream_handle=undefined
298	return -8
299	var Str cmd2
300	if (cmd 0 1)<>"/" and (cmd 0 2)<>"./"
301	if path<>"" and (os_lstat file_os_name:path+(cmd 0 (cmd search " " cmd:len)) (var os_stat stat))=0
302	cmd2 := cmd
303	else
304	part scan
305	for (var Int i) 0 paths:size-1
306	if (os_lstat paths:i+(cmd 0 (cmd search " " cmd:len)) (var os_stat stat))=0
307	cmd2 := paths:i+cmd
308	leave scan
309	return (-1)
310	else
311	cmd2 := cmd
312	retcode := execute1 cmd2 file_os_name:path user group in_stream:stream_handle out_stream:stream_handle (shunt err<>"mixed" err_stream:stream_handle out_stream:stream_handle)
313
314	eif os_api="os2"
315
316	function execute2 cmd path root user group in out err env detached id -> retcode
317	arg Str cmd path root ; arg Int user group ; arg Str in out err env ; arg CBool detached ; arg_w Int id ; arg Int retcode
318	id := undefined
319	if path<>""
320	return -2
321	if root<>""
322	return -3
323	if user<>""
324	return -4
325	if group<>""
326	return -5
327	if in<>""
328	return -6
329	if out<>""
330	return -7
331	if err<>""
332	return -8
333	if detached
334	return -9
335	var Int l := cmd search " " cmd:len
336	var Str progname := (cmd 0 l)+"[0]"
337	var Str args := progname+(cmd l+1 cmd:len)+"[0][0]"
338	var Array:uInt8 buf ; buf size := 260
339	var os_RESULTCODES returncodes
340	if (os_DosExecPgm (addressof buf:0) buf:size EXEC_SYNC args:characters null returncodes progname:characters)<>0
341	retcode := undefined ; return
342	return returncodes:codeResult
343
344	else
345
346	function execute2 cmd path root user group in out err env detached id -> retcode
347	arg Str cmd path root ; arg Int user group ; arg Str in out err env ; arg CBool detached ; arg_w Int id ; arg Int retcode
348	return -1
349
350
351	meta execute e
352	if e:size<1 or not (e:0 cast Str)
353	return
354	var Link:Argument path :> argument constant Str ""
355	var Link:Argument root :> argument constant Str ""
356	var Link:Argument user :> argument constant Int undefined
357	var Link:Argument group :> argument constant Int undefined
358	var Link:Argument input :> argument constant Str ""
359	var Link:Argument output :> argument constant Str ""
360	var Link:Argument output0 :> output
361	var Link:Argument err :> argument constant Str ""
362	var Link:Argument env :> argument constant Str ""
363	var Link:Argument detached :> argument constant CBool false
364	var Link:Argument id :> argument local Int
365	var Int i := 1
366	while i<e:size
367	if e:i:ident="path" and i+1<e:size and (e:(i+1) cast Str)
368	e suckup e:(i+1)
369	path :> e:(i+1) result
370	i += 2
371	eif e:i:ident="root" and i+1<e:size and (e:(i+1) cast Str)
372	e suckup e:(i+1)
373	root :> e:(i+1) result
374	i += 2
375	eif e:i:ident="user" and i+1<e:size and (e:(i+1) cast Int)
376	e suckup e:(i+1)
377	user :> e:(i+1) result
378	i += 2
379	eif e:i:ident="group" and i+1<e:size and (e:(i+1) cast Int)
380	e suckup e:(i+1)
381	group :> e:(i+1) result
382	i += 2
383	eif e:i:ident="input" and i+1<e:size and (e:(i+1) cast Str)
384	e suckup e:(i+1)
385	input :> e:(i+1) result
386	i += 2
387	eif e:i:ident="output" and i+1<e:size and (e:(i+1) cast Str)
388	e suckup e:(i+1)
389	output :> e:(i+1) result
390	i += 2
391	eif e:i:ident="error" and i+1<e:size and (e:(i+1) cast Str)
392	e suckup e:(i+1)
393	err :> e:(i+1) result
394	i += 2
395	eif e:i:ident="mixed"
396	err :> argument constant Str "mixed"
397	i += 1
398	eif e:i:ident="quiet"
399	if addressof:output=addressof:output0
400	output :> argument constant Str "device:/null"
401	err :> argument constant Str "device:/null"
402	i += 1
403	eif e:i:ident="environment" and i+1<e:size and (e:(i+1) cast Str)
404	e suckup e:(i+1)
405	env :> e:(i+1) result
406	i += 2
407	eif e:i:ident="detached"
408	detached :> argument constant CBool true
409	i += 1
410	eif e:i:ident="id" and i+1<e:size and (e:(i+1) cast Int) and (e:(i+1):access .and. access_write)<>0
411	e suckup e:(i+1)
412	id :> e:(i+1) result
413	i += 2
414	else
415	return
416	var Link:Argument r :> argument local Int
417	e suckup e:0
418	e add (instruction (the_function execute2 Str Str Str Int Int Str Str Str Str CBool Int -> Int) e:0:result path root user group input output err env detached id r)
419	e set_result r access_read
420
421	export execute
422