Working on Unix io.launcher redirection
parent
9cc5f5c78e
commit
00d2122a4c
|
@ -31,6 +31,36 @@ HELP: +environment-mode+
|
||||||
"Default value is " { $link append-environment } "."
|
"Default value is " { $link append-environment } "."
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
|
HELP: +stdin+
|
||||||
|
{ $description "Launch descriptor key. Must equal one of the following:"
|
||||||
|
{ $list
|
||||||
|
{ { $link f } " - standard input is inherited" }
|
||||||
|
{ { $link +closed+ } " - standard input is closed" }
|
||||||
|
{ "a path name - standard input is read from the given file, which must exist" }
|
||||||
|
}
|
||||||
|
} ;
|
||||||
|
|
||||||
|
HELP: +stdout+
|
||||||
|
{ $description "Launch descriptor key. Must equal one of the following:"
|
||||||
|
{ $list
|
||||||
|
{ { $link f } " - standard output is inherited" }
|
||||||
|
{ { $link +closed+ } " - standard output is closed" }
|
||||||
|
{ "a path name - standard output is written to the given file, which is overwritten if it already exists" }
|
||||||
|
}
|
||||||
|
} ;
|
||||||
|
|
||||||
|
HELP: +stderr+
|
||||||
|
{ $description "Launch descriptor key. Must equal one of the following:"
|
||||||
|
{ $list
|
||||||
|
{ { $link f } " - standard error is inherited" }
|
||||||
|
{ { $link +closed+ } " - standard error is closed" }
|
||||||
|
{ "a path name - standard error is written to the given file, which is overwritten if it already exists" }
|
||||||
|
}
|
||||||
|
} ;
|
||||||
|
|
||||||
|
HELP: +closed+
|
||||||
|
{ $description "Possible value for " { $link +stdin+ } ", " { $link +stdout+ } ", and " { $link +stderr+ } " launch descriptors." } ;
|
||||||
|
|
||||||
HELP: prepend-environment
|
HELP: prepend-environment
|
||||||
{ $description "Possible value of " { $link +environment-mode+ } " launch descriptor key. The child process environment consists of the value of the " { $link +environment+ } " key together with the current environment, with entries from the current environment taking precedence."
|
{ $description "Possible value of " { $link +environment-mode+ } " launch descriptor key. The child process environment consists of the value of the " { $link +environment+ } " key together with the current environment, with entries from the current environment taking precedence."
|
||||||
$nl
|
$nl
|
||||||
|
|
|
@ -30,6 +30,10 @@ SYMBOL: +arguments+
|
||||||
SYMBOL: +detached+
|
SYMBOL: +detached+
|
||||||
SYMBOL: +environment+
|
SYMBOL: +environment+
|
||||||
SYMBOL: +environment-mode+
|
SYMBOL: +environment-mode+
|
||||||
|
SYMBOL: +stdin+
|
||||||
|
SYMBOL: +stdout+
|
||||||
|
SYMBOL: +stderr+
|
||||||
|
SYMBOL: +closed+
|
||||||
|
|
||||||
SYMBOL: prepend-environment
|
SYMBOL: prepend-environment
|
||||||
SYMBOL: replace-environment
|
SYMBOL: replace-environment
|
||||||
|
|
|
@ -4,13 +4,15 @@ USING: io.backend io.nonblocking io.unix.backend io.files io
|
||||||
unix kernel math continuations ;
|
unix kernel math continuations ;
|
||||||
IN: io.unix.files
|
IN: io.unix.files
|
||||||
|
|
||||||
|
: read-flags O_RDONLY ; inline
|
||||||
|
|
||||||
: open-read ( path -- fd )
|
: open-read ( path -- fd )
|
||||||
O_RDONLY file-mode open dup io-error ;
|
O_RDONLY file-mode open dup io-error ;
|
||||||
|
|
||||||
M: unix-io <file-reader> ( path -- stream )
|
M: unix-io <file-reader> ( path -- stream )
|
||||||
open-read <reader> ;
|
open-read <reader> ;
|
||||||
|
|
||||||
: write-flags O_WRONLY O_CREAT O_TRUNC bitor bitor ;
|
: write-flags O_WRONLY O_CREAT O_TRUNC bitor bitor ; inline
|
||||||
|
|
||||||
: open-write ( path -- fd )
|
: open-write ( path -- fd )
|
||||||
write-flags file-mode open dup io-error ;
|
write-flags file-mode open dup io-error ;
|
||||||
|
@ -18,7 +20,7 @@ M: unix-io <file-reader> ( path -- stream )
|
||||||
M: unix-io <file-writer> ( path -- stream )
|
M: unix-io <file-writer> ( path -- stream )
|
||||||
open-write <writer> ;
|
open-write <writer> ;
|
||||||
|
|
||||||
: append-flags O_WRONLY O_APPEND O_CREAT bitor bitor ;
|
: append-flags O_WRONLY O_APPEND O_CREAT bitor bitor ; inline
|
||||||
|
|
||||||
: open-append ( path -- fd )
|
: open-append ( path -- fd )
|
||||||
append-flags file-mode open dup io-error
|
append-flags file-mode open dup io-error
|
||||||
|
|
|
@ -42,8 +42,21 @@ MEMO: 'arguments' ( -- parser )
|
||||||
: assoc>env ( assoc -- env )
|
: assoc>env ( assoc -- env )
|
||||||
[ "=" swap 3append ] { } assoc>map ;
|
[ "=" swap 3append ] { } assoc>map ;
|
||||||
|
|
||||||
|
: redirect ( obj mode fd -- )
|
||||||
|
{
|
||||||
|
{ [ pick not ] [ 3drop ] }
|
||||||
|
{ [ pick +closed+ eq? ] [ close 3drop ] }
|
||||||
|
{ [ t ] [ >r file-mode open dup io-error r> dup2 io-error ] }
|
||||||
|
} cond ;
|
||||||
|
|
||||||
|
: setup-redirection ( -- )
|
||||||
|
+stdin+ get read-flags 0 redirect
|
||||||
|
+stdout+ get write-flags 1 redirect
|
||||||
|
+stderr+ get read-flags 2 redirect ;
|
||||||
|
|
||||||
: spawn-process ( -- )
|
: spawn-process ( -- )
|
||||||
[
|
[
|
||||||
|
setup-redirection
|
||||||
get-arguments
|
get-arguments
|
||||||
pass-environment?
|
pass-environment?
|
||||||
[ get-environment assoc>env exec-args-with-env ]
|
[ get-environment assoc>env exec-args-with-env ]
|
||||||
|
|
Loading…
Reference in New Issue