diff --git a/extra/io/launcher/launcher-docs.factor b/extra/io/launcher/launcher-docs.factor index 2c30431714..495894b25d 100755 --- a/extra/io/launcher/launcher-docs.factor +++ b/extra/io/launcher/launcher-docs.factor @@ -31,6 +31,36 @@ HELP: +environment-mode+ "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 { $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 diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor index c646358b2e..fe3244916d 100755 --- a/extra/io/launcher/launcher.factor +++ b/extra/io/launcher/launcher.factor @@ -30,6 +30,10 @@ SYMBOL: +arguments+ SYMBOL: +detached+ SYMBOL: +environment+ SYMBOL: +environment-mode+ +SYMBOL: +stdin+ +SYMBOL: +stdout+ +SYMBOL: +stderr+ +SYMBOL: +closed+ SYMBOL: prepend-environment SYMBOL: replace-environment diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index f9d642d661..b56e62d3c4 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -4,13 +4,15 @@ USING: io.backend io.nonblocking io.unix.backend io.files io unix kernel math continuations ; IN: io.unix.files +: read-flags O_RDONLY ; inline + : open-read ( path -- fd ) O_RDONLY file-mode open dup io-error ; M: unix-io ( path -- stream ) open-read ; -: 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 ) write-flags file-mode open dup io-error ; @@ -18,7 +20,7 @@ M: unix-io ( path -- stream ) M: unix-io ( path -- stream ) open-write ; -: 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 ) append-flags file-mode open dup io-error diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 50c41380d0..6439fc0848 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -42,8 +42,21 @@ MEMO: 'arguments' ( -- parser ) : assoc>env ( assoc -- env ) [ "=" 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 ( -- ) [ + setup-redirection get-arguments pass-environment? [ get-environment assoc>env exec-args-with-env ]