Enable RemoteGHCi on Windows

Makes the needed changes to make RemoteGHCi work on Windows.
The approach passes OS Handles areound instead of the Posix Fd
as on Linux.

The reason is that I could not find any real documentation about
the behaviour of Windows w.r.t inheritance and Posix FDs.

The implementation with Fd did not seem to be able to find the Fd
in the child process. Instead I'm using the much better documented
approach of passing inheriting handles.

This requires a small modification to the `process` library.
https://github.com/haskell/process/pull/52

Test Plan: ./validate On Windows x86_64

Reviewers: thomie, erikd, bgamari, simonmar, austin, hvr

Reviewed By: simonmar

Subscribers: #ghc_windows_task_force

Differential Revision: https://phabricator.haskell.org/D1836

GHC Trac Issues: #11100

4 files changed, 36 insertions, 7 deletions

diff --git a/iserv/iservmain.c b/iserv/cbits/iservmain.c
index f7eb5664c5..f7eb5664c5 100644
--- a/iserv/iservmain.c
+++ b/iserv/cbits/iservmain.c
diff --git a/iserv/iserv-bin.cabal b/iserv/iserv-bin.cabal
index a770b4fc99..3fd5d2bd28 100644
--- a/iserv/iserv-bin.cabal
+++ b/iserv/iserv-bin.cabal
@@ -15,12 +15,16 @@ cabal-version: >=1.10
 Executable iserv
     Default-Language: Haskell2010
     Main-Is: Main.hs
-    C-Sources: iservmain.c
+    C-Sources: cbits/iservmain.c
+    Hs-Source-Dirs: src
+    Other-Modules: GHCi.Utils
     Build-Depends: array      >= 0.5 && < 0.6,
                    base       >= 4   && < 5,
-                   unix       >= 2.7 && < 2.8,
                    binary     >= 0.7 && < 0.9,
                    bytestring >= 0.10 && < 0.11,
                    containers >= 0.5 && < 0.6,
                    deepseq    >= 1.4 && < 1.5,
                    ghci       == 8.1
+
+    if !os(windows)
+        Build-Depends: unix   >= 2.7 && < 2.8
diff --git a/iserv/src/GHCi/Utils.hsc b/iserv/src/GHCi/Utils.hsc
new file mode 100644
index 0000000000..b90cfacb5f
--- /dev/null
+++ b/iserv/src/GHCi/Utils.hsc
@@ -0,0 +1,25 @@
+{-# LANGUAGE CPP #-}
+module GHCi.Utils
+    ( getGhcHandle
+    ) where
+
+import Foreign.C
+import GHC.IO.Handle (Handle())
+#ifdef mingw32_HOST_OS
+import GHC.IO.Handle.FD (fdToHandle)
+#else
+import System.Posix
+#endif
+
+#include <fcntl.h>     /* for _O_BINARY */
+
+-- | Gets a GHC Handle File description from the given OS Handle or POSIX fd.
+getGhcHandle :: CInt -> IO Handle
+#ifdef mingw32_HOST_OS
+getGhcHandle handle = _open_osfhandle handle (#const _O_BINARY) >>= fdToHandle
+
+foreign import ccall "io.h _open_osfhandle" _open_osfhandle ::
+    CInt -> CInt -> IO CInt
+#else
+getGhcHandle fd     = fdToHandle $ Fd fd
+#endif
diff --git a/iserv/Main.hs b/iserv/src/Main.hs
index cbaf9277d5..46ae82b464 100644
--- a/iserv/Main.hs
+++ b/iserv/src/Main.hs
@@ -5,6 +5,7 @@ import GHCi.Run
 import GHCi.TH
 import GHCi.Message
 import GHCi.Signals
+import GHCi.Utils
 
 import Control.DeepSeq
 import Control.Exception
@@ -13,7 +14,6 @@ import Data.Binary
 import Data.IORef
 import System.Environment
 import System.Exit
-import System.Posix
 import Text.Printf
 
 main :: IO ()
@@ -22,13 +22,13 @@ main = do
   let wfd1 = read arg0; rfd2 = read arg1
   verbose <- case rest of
     ["-v"] -> return True
-    [] -> return False
-    _ -> die "iserv: syntax: iserv <write-fd> <read-fd> [-v]"
+    []     -> return False
+    _      -> die "iserv: syntax: iserv <write-fd> <read-fd> [-v]"
   when verbose $ do
     printf "GHC iserv starting (in: %d; out: %d)\n"
       (fromIntegral rfd2 :: Int) (fromIntegral wfd1 :: Int)
-  inh <- fdToHandle rfd2
-  outh <- fdToHandle wfd1
+  inh  <- getGhcHandle rfd2
+  outh <- getGhcHandle wfd1
   installSignalHandlers
   lo_ref <- newIORef Nothing
   let pipe = Pipe{pipeRead = inh, pipeWrite = outh, pipeLeftovers = lo_ref}