# Copyright Hubert Tonneau hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
module "/pliant/language/compiler.pli"
module "/pliant/language/os.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/stream/handle.pli"
module "/pliant/admin/file.pli"
if os_api="linux"
module "/pliant/language/schedule/threads_engine.pli"
function close_handles
var Int maxi := stream_maximum_handle+stream_pending_handles+5
for (var Int h) 3 maxi
os_close h
gcc_off
function execute1 cmd path root user group input output err envptr detached id -> retcode
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
var Address args := (memory_allocate 8*Address:size+(cmd:len+1)*Address:size null) translate Address 8
var Int nb := 0
var Int base := 0
var Char stop := " "
for (var Int i) 0 cmd:len
if i=cmd:len or cmd:i=stop
if i>base or stop="'"
var Pointer:Address arg :> (args translate Address nb) map Address
arg := memory_allocate i-base+1 args
for (var Int j) base i-1
(arg translate Byte j-base) map uInt8 := cmd:j:number
(arg translate Byte i-base) map uInt8 := 0
nb := nb+1
stop := " "
base := i+1
eif i=base and cmd:i="'" and stop=" "
base := i+1
stop := "'"
var Address pathz
if path<>""
pathz := memory_allocate path:len+1 null
memory_copy path:characters pathz path:len
(pathz translate Byte path:len) map uInt8 := 0
else
pathz := null
var Address rootz
if root<>""
rootz := memory_allocate root:len+1 null
memory_copy root:characters rootz root:len
(rootz translate Byte root:len) map uInt8 := 0
else
rootz := null
(args translate Address -1) map Address := pathz
(args translate Address -2) map Address := rootz
(args translate Address -3) map Int := user
(args translate Address -4) map Int := group
(args translate Address -5) map Int := input
(args translate Address -6) map Int := output
(args translate Address -7) map Int := err
(args translate Address -8) map Address := envptr
(args translate Address nb) map Address := null
if nb<>0
var Pointer:ThreadHeader h :> allocate_stack
if addressof:h=null
retcode := undefined
return
h address := args
if detached
var Int pid := os_clone 8000h (addressof:h translate Byte -256)
if pid=0
h :> current_thread_header
h pid := os_getpid
os_setsid
if ((h:address translate Address -1) map Address)<>null
os_chdir ((h:address translate Address -1) map CStr)
if ((h:address translate Address -2) map Address)<>null
os_chroot ((h:address translate Address -2) map CStr)
if ((h:address translate Address -4) map Int)=defined
os_setgid ((h:address translate Address -4) map Int)
if ((h:address translate Address -3) map Int)=defined
os_setuid ((h:address translate Address -3) map Int)
if ((h:address translate Address -5) map Int)=defined
os_dup2 ((h:address translate Address -5) map Int) 0
if ((h:address translate Address -6) map Int)=defined
os_dup2 ((h:address translate Address -6) map Int) 1
if ((h:address translate Address -7) map Int)=defined
os_dup2 ((h:address translate Address -7) map Int) 2
close_handles
os_execve (h:address map CStr) h:address ((h:address translate Address -8) map Address)
os_exit 99
eif pid=(-1)
retcode := undefined
else
id := pid
var os_timespec spec
spec tv_sec := 0
spec tv_nsec := 100*1000^2
os_nanosleep spec (null map os_timespec)
retcode := 0
free_stack h
else
var Int pid := os_clone 0 (addressof:h translate Byte -256)
if pid=0
h :> current_thread_header
h pid := os_getpid
if ((h:address translate Address -1) map Address)<>null
os_chdir ((h:address translate Address -1) map CStr)
if ((h:address translate Address -2) map Address)<>null
os_chroot ((h:address translate Address -2) map CStr)
if ((h:address translate Address -4) map Int)=defined
os_setgid ((h:address translate Address -4) map Int)
if ((h:address translate Address -3) map Int)=defined
os_setuid ((h:address translate Address -3) map Int)
if ((h:address translate Address -5) map Int)=defined
os_dup2 ((h:address translate Address -5) map Int) 0
if ((h:address translate Address -6) map Int)=defined
os_dup2 ((h:address translate Address -6) map Int) 1
if ((h:address translate Address -7) map Int)=defined
os_dup2 ((h:address translate Address -7) map Int) 2
close_handles
os_execve (h:address map CStr) h:address ((h:address translate Address -8) map Address)
os_exit 99
eif pid=(-1)
retcode := undefined
else
id := pid
os_waitpid pid (var Int status) 80000000h
retcode := (status .and. 0FF00h)\100h
free_stack h
else
retcode := undefined
for (var Int i) -2 nb-1
memory_free ((args translate Address i) map Address)
memory_free (args translate Address -8)
gvar Array:Str paths
paths += "/sbin/"
paths += "/bin/"
paths += "/usr/sbin/"
paths += "/usr/bin/"
paths += "/usr/local/sbin/"
paths += "/usr/local/bin/"
paths += "/usr/X11R6/bin/"
gvar List pids
gvar Sem sem
function restore_execute_pids p fh
arg Address p ; arg Int fh
pids := var List empty_list
gvar DelayedAction restore
restore function :> the_function restore_execute_pids Address Int
pliant_restore_actions append addressof:restore
function execute2 cmd path root user group input output err env detached id -> retcode
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
sem request
var Pointer:Arrow c :> pids first
while c<>null
if (os_waitpid (c map Int) (var Int status) 80000001h)=(c map Int)
c :> pids remove c
else
c :> pids next c
sem release
id := undefined
var Stream in_stream out_stream err_stream
if input<>"" and output=input
in_stream open input "inherit" in+out+safe
if in_stream:stream_handle=undefined
return -6
out_stream stream_handle := in_stream stream_handle
else
if input<>""
in_stream open input "inherit" in+safe
if in_stream:stream_handle=undefined
return -6
if output<>""
out_stream open output "inherit" out+safe
if out_stream:stream_handle=undefined
return -7
if err<>"" and err<>"mixed"
err_stream open err "inherit" out+safe
if err_stream:stream_handle=undefined
return -8
var Str cmd2
if (cmd 0 1)<>"/" and (cmd 0 2)<>"./"
if path<>"" and (os_lstat file_os_name:path+(cmd 0 (cmd search " " cmd:len)) (var os_stat stat))=0
cmd2 := cmd
else
var Str os_root := file_os_name root ; os_root := os_root 0 (max os_root:len-1 0)
part scan
for (var Int i) 0 paths:size-1
if (os_lstat os_root+paths:i+(cmd 0 (cmd search " " cmd:len)) (var os_stat stat))=0
cmd2 := paths:i+cmd
leave scan
return (-1)
else
cmd2 := cmd
var Address envptr
if env=""
envptr := linux_process_env
else
var Array:Address ptrs
var Int i := 0
while { var Int j := (env i env:len) search "[0]" -1 ; j<>(-1) }
ptrs += env:characters translate Byte i
i += j+1
ptrs += null
envptr := addressof ptrs:0
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
if detached and retcode=0
sem request
pids append addressof:(new Int id)
sem release
eif os_api="posix"
function execute1 cmd path user group input output err -> retcode
arg Str cmd path ; arg Int user group input output err ; arg Int retcode
var Address args := memory_allocate (cmd:len+1)*Address:size null
var Int nb := 0
var Int base := 0
for (var Int i) 0 cmd:len
if i=cmd:len or cmd:i=" "
if i>base
var Pointer:Address arg :> (args translate Address nb) map Address
arg := memory_allocate i-base+1 args
for (var Int j) base i-1
(arg translate Byte j-base) map uInt8 := cmd:j:number
(arg translate Byte i-base) map uInt8 := 0
nb := nb+1
base := i+1
if path<>""
os_chdir path
if group=defined
os_setgid group
if user=defined
os_setuid user
if input=defined
os_dup2 input 0
if output=defined
os_dup2 output 1
if err=defined
os_dup2 err 2
os_execvp (args map CStr) args
for (var Int i) 0 nb-1
memory_free ((args translate Address i) map Address)
memory_free args
gvar Array:Str paths
paths += "/sbin/"
paths += "/bin/"
paths += "/usr/sbin/"
paths += "/usr/bin/"
paths += "/usr/local/sbin/"
paths += "/usr/local/bin/"
paths += "/usr/X11R6/bin/"
function execute2 cmd path root user group input output err env detached id -> retcode
|
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
|
arg Str cmd path root ; arg Int user group ; arg Str input output err ; arg Str env ; arg CBool detached ; arg_w Int id ; arg Int retcode
|
id := undefined
if root<>""
return -3
if detached
return -9
var Stream in_stream out_stream err_stream
if input<>"" and output=input
in_stream open input "inherit" in+out+safe
if in_stream:stream_handle=undefined
return -6
out_stream stream_handle := in_stream stream_handle
else
if input<>""
in_stream open input "inherit" in+safe
if in_stream:stream_handle=undefined
return -6
if output<>""
out_stream open output "inherit" out+safe
if out_stream:stream_handle=undefined
return -7
if err<>"" and err<>"mixed"
err_stream open err "inherit" out+safe
if out_stream:stream_handle=undefined
return -8
var Str cmd2
if (cmd 0 1)<>"/" and (cmd 0 2)<>"./"
if path<>"" and (os_lstat file_os_name:path+(cmd 0 (cmd search " " cmd:len)) (var os_stat stat))=0
cmd2 := cmd
else
part scan
for (var Int i) 0 paths:size-1
if (os_lstat paths:i+(cmd 0 (cmd search " " cmd:len)) (var os_stat stat))=0
cmd2 := paths:i+cmd
leave scan
return (-1)
else
cmd2 := cmd
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)
eif os_api="os2"
function execute2 cmd path root user group in out err env detached id -> retcode
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
id := undefined
if path<>""
return -2
if root<>""
return -3
if user<>""
return -4
if group<>""
return -5
if in<>""
return -6
if out<>""
return -7
if err<>""
return -8
if detached
return -9
var Int l := cmd search " " cmd:len
var Str progname := (cmd 0 l)+"[0]"
var Str args := progname+(cmd l+1 cmd:len)+"[0][0]"
var Array:uInt8 buf ; buf size := 260
var os_RESULTCODES returncodes
if (os_DosExecPgm (addressof buf:0) buf:size EXEC_SYNC args:characters null returncodes progname:characters)<>0
retcode := undefined ; return
return returncodes:codeResult
else
function execute2 cmd path root user group in out err env detached id -> retcode
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
return -1
meta execute e
if e:size<1 or not (e:0 cast Str)
return
var Link:Argument path :> argument constant Str ""
var Link:Argument root :> argument constant Str ""
var Link:Argument user :> argument constant Int undefined
var Link:Argument group :> argument constant Int undefined
var Link:Argument input :> argument constant Str ""
var Link:Argument output :> argument constant Str ""
var Link:Argument output0 :> output
var Link:Argument err :> argument constant Str ""
var Link:Argument env :> argument constant Str ""
var Link:Argument detached :> argument constant CBool false
var Link:Argument id :> argument local Int
var Int i := 1
while i<e:size
if e:i:ident="path" and i+1<e:size and (e:(i+1) cast Str)
e suckup e:(i+1)
path :> e:(i+1) result
i += 2
eif e:i:ident="root" and i+1<e:size and (e:(i+1) cast Str)
e suckup e:(i+1)
root :> e:(i+1) result
i += 2
eif e:i:ident="user" and i+1<e:size and (e:(i+1) cast Int)
e suckup e:(i+1)
user :> e:(i+1) result
i += 2
eif e:i:ident="group" and i+1<e:size and (e:(i+1) cast Int)
e suckup e:(i+1)
group :> e:(i+1) result
i += 2
eif e:i:ident="input" and i+1<e:size and (e:(i+1) cast Str)
e suckup e:(i+1)
input :> e:(i+1) result
i += 2
eif e:i:ident="output" and i+1<e:size and (e:(i+1) cast Str)
e suckup e:(i+1)
output :> e:(i+1) result
i += 2
eif e:i:ident="error" and i+1<e:size and (e:(i+1) cast Str)
e suckup e:(i+1)
err :> e:(i+1) result
i += 2
|
eif e:i:ident="environment" and i+1<e:size and (e:(i+1) cast Str)
e suckup e:(i+1)
env :> e:(i+1) result
i += 2
|
eif e:i:ident="mixed"
err :> argument constant Str "mixed"
i += 1
eif e:i:ident="quiet"
if addressof:output=addressof:output0
output :> argument constant Str "device:/null"
err :> argument constant Str "device:/null"
i += 1
|
eif e:i:ident="environment" and i+1<e:size and (e:(i+1) cast Str)
e suckup e:(i+1)
env :> e:(i+1) result
i += 2
|
eif e:i:ident="detached"
detached :> argument constant CBool true
i += 1
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
e suckup e:(i+1)
id :> e:(i+1) result
i += 2
else
return
var Link:Argument r :> argument local Int
e suckup e:0
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)
e set_result r access_read
export execute
|