Windows launcher work in progress

extra/io/windows/launcher/launcher.factor

@@ -1,9 +1,10 @@
 ! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays continuations destructors io
-io.windows libc io.nonblocking io.streams.duplex windows.types
-math windows.kernel32 windows namespaces io.launcher kernel
-sequences windows.errors assocs splitting system threads init ;
+io.windows io.windows.pipes libc io.nonblocking
+io.streams.duplex windows.types math windows.kernel32 windows
+namespaces io.launcher kernel sequences windows.errors assocs
+splitting system threads init strings combinators io.backend ;
 IN: io.windows.launcher
 
 TUPLE: CreateProcess-args
@@ -86,18 +87,73 @@ TUPLE: CreateProcess-args
         over set-CreateProcess-args-lpEnvironment
     ] when ;
 
+: (redirect) ( path access-mode create-mode -- handle )
+    >r >r
+    normalize-pathname
+    r> ! access-mode
+    share-mode
+    security-attributes-inherit
+    r> ! create-mode
+    FILE_ATTRIBUTE_NORMAL ! flags and attributes
+    f ! template file
+    CreateFile dup invalid-handle? dup close-later ;
+
+: redirect ( obj access-mode create-mode -- handle )
+    {
+        { [ pick not ] [ 3drop f ] }
+        { [ pick +closed+ eq? ] [ 3drop f ] }
+        { [ pick string? ] [ (redirect) ] }
+    } cond ;
+
+: inherited-stdout ( args -- handle )
+    CreateProcess-args-stdout-pipe
+    [ pipe-out ] [ STD_OUTPUT_HANDLE GetStdHandle ] if* ;
+
+: redirect-stdout ( args -- handle )
+    +stdout+ get GENERIC_WRITE CREATE_ALWAYS redirect
+    swap inherited-stdout or ;
+
+: inherited-stderr ( args -- handle )
+    CreateProcess-args-stdout-pipe
+    [ pipe-out ] [ STD_ERROR_HANDLE GetStdHandle ] if* ;
+
+: redirect-stderr ( args -- handle )
+    +stderr+ get GENERIC_WRITE CREATE_ALWAYS redirect
+    swap inherited-stderr or ;
+
+: inherited-stdin ( args -- handle )
+    CreateProcess-args-stdin-pipe
+    [ pipe-in ] [ STD_INPUT_HANDLE GetStdHandle ] if* ;
+
+: redirect-stdin ( args -- handle )
+    +stdin+ get GENERIC_READ OPEN_EXISTING redirect
+    swap inherited-stdin or ;
+
+: fill-startup-info
+    dup CreateProcess-args-lpStartupInfo
+    STARTF_USESTDHANDLES over set-STARTUPINFO-dwFlags
+
+    over redirect-stdout over set-STARTUPINFO-hStdOutput
+    over redirect-stderr over set-STARTUPINFO-hStdError
+    over redirect-stdin over set-STARTUPINFO-hStdInput
+
+    drop ;
+
 : make-CreateProcess-args ( -- args )
     default-CreateProcess-args
     wince? [ fill-lpApplicationName ] [ fill-lpCommandLine ] if
     fill-dwCreateFlags
-    fill-lpEnvironment ;
+    fill-lpEnvironment
+    fill-startup-info ;
 
 M: windows-io run-process* ( desc -- handle )
     [
-        make-CreateProcess-args
-        dup call-CreateProcess
-        CreateProcess-args-lpProcessInformation <process>
-    ] with-descriptor ;
+        [
+            make-CreateProcess-args
+            dup call-CreateProcess
+            CreateProcess-args-lpProcessInformation <process>
+        ] with-descriptor
+    ] with-destructors ;
 
 : dispose-process ( process-information -- )
     #! From MSDN: "Handles in PROCESS_INFORMATION must be closed

extra/io/windows/nt/launcher/launcher.factor

@@ -4,7 +4,7 @@ USING: alien alien.c-types arrays continuations destructors io
 io.windows libc io.nonblocking io.streams.duplex windows.types
 math windows.kernel32 windows namespaces io.launcher kernel
 sequences windows.errors assocs splitting system
-io.windows.launcher io.windows.nt.pipes ;
+io.windows.launcher io.windows.pipes ;
 IN: io.windows.nt.launcher
 
 ! The below code is based on the example given in
@@ -30,17 +30,6 @@ IN: io.windows.nt.launcher
     dup pipe-out f set-inherit
     over set-CreateProcess-args-stdin-pipe ;
 
-: fill-startup-info
-    dup CreateProcess-args-lpStartupInfo
-    STARTF_USESTDHANDLES over set-STARTUPINFO-dwFlags
-
-    over CreateProcess-args-stdout-pipe
-        pipe-out over set-STARTUPINFO-hStdOutput
-    over CreateProcess-args-stdout-pipe
-        pipe-out over set-STARTUPINFO-hStdError
-    over CreateProcess-args-stdin-pipe
-        pipe-in swap set-STARTUPINFO-hStdInput ;
-
 M: windows-io process-stream*
     [
         [
@@ -49,7 +38,6 @@ M: windows-io process-stream*
 
             fill-stdout-pipe
             fill-stdin-pipe
-            fill-startup-info
 
             dup call-CreateProcess
 

extra/io/windows/pipes/pipes.factor

@@ -3,19 +3,11 @@
 USING: alien alien.c-types arrays destructors io io.windows libc
 windows.types math windows.kernel32 windows namespaces kernel
 sequences windows.errors assocs math.parser system random ;
-IN: io.windows.nt.pipes
+IN: io.windows.pipes
 
 ! This code is based on
 ! http://twistedmatrix.com/trac/browser/trunk/twisted/internet/iocpreactor/process.py
 
-: default-security-attributes ( -- obj )
-    "SECURITY_ATTRIBUTES" <c-object>
-    "SECURITY_ATTRIBUTES" heap-size over set-SECURITY_ATTRIBUTES-nLength ;
-
-: security-attributes-inherit ( -- obj )
-    default-security-attributes
-    TRUE over set-SECURITY_ATTRIBUTES-bInheritHandle ; foldable
-
 : create-named-pipe ( name mode -- handle )
     FILE_FLAG_OVERLAPPED bitor
     PIPE_TYPE_BYTE

extra/io/windows/windows.factor

@@ -4,7 +4,7 @@ USING: alien alien.c-types arrays destructors io io.backend
 io.buffers io.files io.nonblocking io.sockets io.binary
 io.sockets.impl windows.errors strings io.streams.duplex kernel
 math namespaces sequences windows windows.kernel32
-windows.shell32 windows.winsock splitting ;
+windows.shell32 windows.types windows.winsock splitting ;
 IN: io.windows
 
 TUPLE: windows-nt-io ;
@@ -34,6 +34,14 @@ M: windows-io normalize-directory ( string -- string )
     FILE_SHARE_READ FILE_SHARE_WRITE bitor
     FILE_SHARE_DELETE bitor ; foldable
 
+: default-security-attributes ( -- obj )
+    "SECURITY_ATTRIBUTES" <c-object>
+    "SECURITY_ATTRIBUTES" heap-size over set-SECURITY_ATTRIBUTES-nLength ;
+
+: security-attributes-inherit ( -- obj )
+    default-security-attributes
+    TRUE over set-SECURITY_ATTRIBUTES-bInheritHandle ; foldable
+
 M: win32-file init-handle ( handle -- )
     drop ;