socketPair for Windows

Author: kazu-yamamoto

Network/Socket/Unix.hsc

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 #include "HsNet.h"
 ##include "HsNetDef.h"
@@ -13,28 +14,32 @@ module Network.Socket.Unix (
   , getPeerEid
   ) where
 
-import System.Posix.Types (Fd(..))
-
+import Foreign.Marshal.Alloc (allocaBytes)
 import Network.Socket.Buffer
+import Network.Socket.Fcntl
 import Network.Socket.Imports
+import Network.Socket.Types
+import System.Posix.Types (Fd(..))
+
 #if defined(mingw32_HOST_OS)
+import Network.Socket.Syscall
 import Network.Socket.Win32.Cmsg
+import System.Directory
+import System.IO
+import System.IO.Temp
 #else
+import Foreign.Marshal.Array (peekArray)
+import Network.Socket.Internal
 import Network.Socket.Posix.Cmsg
 #endif
-import Network.Socket.Types
 
 #if defined(HAVE_GETPEEREID)
 import System.IO.Error (catchIOError)
 #endif
 #ifdef HAVE_GETPEEREID
 import Foreign.Marshal.Alloc (alloca)
 #endif
-import Foreign.Marshal.Alloc (allocaBytes)
-import Foreign.Marshal.Array (peekArray)
 
-import Network.Socket.Fcntl
-import Network.Socket.Internal
 #ifdef HAVE_STRUCT_UCRED_SO_PEERCRED
 import Network.Socket.Options
 #endif
@@ -165,6 +170,21 @@ socketPair :: Family              -- Family Name (usually AF_UNIX)
            -> SocketType          -- Socket Type (usually Stream)
            -> ProtocolNumber      -- Protocol Number
            -> IO (Socket, Socket) -- unnamed and connected.
+#if defined(mingw32_HOST_OS)
+socketPair _ _ _ = withSystemTempFile "temp-for-pair" $ \file hdl -> do
+    hClose hdl
+    removeFile file
+    listenSock <- socket AF_UNIX Stream defaultProtocol
+    bind listenSock $ SockAddrUnix file
+    listen listenSock 10
+    clientSock <- socket AF_UNIX Stream defaultProtocol
+    connect clientSock $ SockAddrUnix file
+    (serverSock, _ :: SockAddr) <- accept listenSock
+    close listenSock
+    withFdSocket clientSock setNonBlockIfNeeded
+    withFdSocket serverSock setNonBlockIfNeeded
+    return (clientSock, serverSock)
+#else
 socketPair family stype protocol =
     allocaBytes (2 * sizeOf (1 :: CInt)) $ \ fdArr -> do
       let c_stype = packSocketType stype
@@ -179,3 +199,4 @@ socketPair family stype protocol =
 
 foreign import ccall unsafe "socketpair"
   c_socketpair :: CInt -> CInt -> CInt -> Ptr CInt -> IO CInt
+#endif

network.cabal

@@ -168,6 +168,9 @@ library
             cpp-options: -D_WIN32_WINNT=0x0600
             cc-options:  -D_WIN32_WINNT=0x0600
 
+        build-depends:
+            temporary
+
 test-suite spec
     type:             exitcode-stdio-1.0
     main-is:          Spec.hs