Working on Unix io.launcher redirection

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

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

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 <file-reader> ( path -- stream )
     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 )
     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 )
     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 )
     append-flags file-mode open dup io-error

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 ]