1 ! Copyright (C) 2007, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types arrays assocs combinators
4 continuations environment io io.backend io.backend.unix
5 io.files io.files.private io.files.unix io.launcher io.pathnames
6 io.ports kernel math namespaces sequences strings system threads
7 unix unix.process unix.ffi simple-tokenizer ;
10 : get-arguments ( process -- seq )
11 command>> dup string? [ tokenize ] when ;
13 : assoc>env ( assoc -- env )
14 [ "=" glue ] { } assoc>map ;
16 : setup-priority ( process -- process )
19 { +lowest-priority+ 20 }
21 { +normal-priority+ 0 }
22 { +high-priority+ -10 }
23 { +highest-priority+ -20 }
24 { +realtime-priority+ -20 }
29 [ F_SETFL 0 fcntl io-error ] [ F_SETFD 0 fcntl io-error ] bi ;
31 : redirect-fd ( oldfd fd -- )
32 2dup = [ 2drop ] [ dup2 io-error ] if ;
34 : redirect-file ( obj mode fd -- )
35 [ [ normalize-path ] dip file-mode open-file ] dip redirect-fd ;
37 : redirect-file-append ( obj mode fd -- )
38 [ drop path>> normalize-path open-append ] dip redirect-fd ;
40 : redirect-closed ( obj mode fd -- )
41 [ drop "/dev/null" ] 2dip redirect-file ;
43 : redirect ( obj mode fd -- )
45 { [ pick not ] [ 3drop ] }
46 { [ pick string? ] [ redirect-file ] }
47 { [ pick appender? ] [ redirect-file-append ] }
48 { [ pick +closed+ eq? ] [ redirect-closed ] }
49 { [ pick fd? ] [ [ drop fd>> dup reset-fd ] dip redirect-fd ] }
50 [ [ underlying-handle ] 2dip redirect ]
53 : ?closed ( obj -- obj' )
54 dup +closed+ eq? [ drop "/dev/null" ] when ;
56 : setup-redirection ( process -- process )
57 dup stdin>> ?closed read-flags 0 redirect
58 dup stdout>> ?closed write-flags 1 redirect
59 dup stderr>> dup +stdout+ eq? [
60 drop 1 2 dup2 io-error
62 ?closed write-flags 2 redirect
65 : setup-environment ( process -- process )
66 dup pass-environment? [
67 dup get-environment set-os-envs
70 : spawn-process ( process -- * )
71 [ setup-priority ] [ 2drop 250 _exit ] recover
72 [ setup-redirection ] [ 2drop 251 _exit ] recover
73 [ current-directory get absolute-path cd ] [ 2drop 252 _exit ] recover
74 [ setup-environment ] [ 2drop 253 _exit ] recover
75 [ get-arguments exec-args-with-path ] [ 2drop 254 _exit ] recover
79 M: unix current-process-handle ( -- handle ) getpid ;
81 M: unix run-process* ( process -- pid )
82 [ spawn-process ] curry [ ] with-fork ;
84 M: unix kill-process* ( pid -- )
85 SIGTERM kill io-error ;
87 : find-process ( handle -- process )
88 processes get swap [ nip swap handle>> = ] curry
93 : code>status ( code -- obj )
94 dup WIFSIGNALED [ WTERMSIG signal boa ] [ WEXITSTATUS ] if ;
96 M: unix wait-for-processes ( -- ? )
97 0 <int> -1 over WNOHANG waitpid
102 [ swap *int code>status notify-exit f ] [ 2drop f ] if