Merge pull request #553 from haskell/kazu/unix-domain-for-win

supporting AF_UNIX on Windows

Author: kazu-yamamoto

Network/Socket/Unix.hsc

@@ -17,7 +17,9 @@ import System.Posix.Types (Fd(..))
 
 import Network.Socket.Buffer
 import Network.Socket.Imports
-#if !defined(mingw32_HOST_OS)
+#if defined(mingw32_HOST_OS)
+import Network.Socket.Win32.Cmsg
+#else
 import Network.Socket.Posix.Cmsg
 #endif
 import Network.Socket.Types

Network/Socket/Win32/Cmsg.hsc

@@ -12,6 +12,7 @@ module Network.Socket.Win32.Cmsg where
 #include "HsNet.h"
 
 import Data.ByteString.Internal
+import System.Posix.Types (Fd(..))
 import Foreign.ForeignPtr
 import System.IO.Unsafe (unsafeDupablePerformIO)
 
@@ -191,6 +192,9 @@ instance Storable IPv6PktInfo where
         n :: ULONG  <- (#peek IN6_PKTINFO, ipi6_ifindex) p
         return $ IPv6PktInfo (fromIntegral n) ha6
 
+instance ControlMessage Fd where
+    controlMessageId = CmsgIdFd
+
 cmsgIdBijection :: Bijection CmsgId String
 cmsgIdBijection =
     [ (UnsupportedCmsgId, "UnsupportedCmsgId")

include/HsNet.h

@@ -29,6 +29,7 @@
 # include <ws2tcpip.h>
 # include <mswsock.h>
 # include "win32defs.h"
+# include "afunix_compat.h"
 # define IPV6_V6ONLY 27
 #endif
 

include/HsNetDef.h

@@ -10,9 +10,7 @@
 #undef PACKAGE_TARNAME
 #undef PACKAGE_VERSION
 
-#if !defined(mingw32_HOST_OS) && !defined(_WIN32)
-# define DOMAIN_SOCKET_SUPPORT 1
-#endif
+#define DOMAIN_SOCKET_SUPPORT 1
 
 #if defined(HAVE_STRUCT_UCRED) && HAVE_DECL_SO_PEERCRED
 # define HAVE_STRUCT_UCRED_SO_PEERCRED 1

include/afunix_compat.h

@@ -0,0 +1,23 @@
+/* The version of afunix.h provided by the version of MSYS2 included with x86
+ * versions of GHC before GHC 9.2 excludes certain components introduced with
+ * Windows Vista.
+ */
+
+#ifndef AFUNIX_COMPAT_H
+#define AFUNIX_COMPAT_H
+
+#if defined(_AFUNIX_) || !defined(_WIN32) || __GLASGOW_HASKELL__ > 902
+# include <afunix.h>
+#else
+
+#define UNIX_PATH_MAX 108
+
+typedef struct sockaddr_un {
+  ADDRESS_FAMILY sun_family;
+  char sun_path[UNIX_PATH_MAX];
+} SOCKADDR_UN, *PSOCKADDR_UN;
+
+#define SIO_AF_UNIX_GETPEERPID _WSAIOR(IOC_VENDOR, 256)
+
+#endif /* GHC version check */
+#endif /* AFUNIX_COMPAT_H */

network.cabal

@@ -66,6 +66,7 @@ extra-source-files:
     include/HsNetworkConfig.h.in
     include/HsNet.h
     include/HsNetDef.h
+    include/afunix_compat.h
     cbits/asyncAccept.c
     cbits/initWinSock.c
     cbits/winSockErr.c

tests/Network/SocketSpec.hs

@@ -12,7 +12,7 @@ import Network.Socket
 import Network.Socket.ByteString
 import Network.Test.Common
 import System.Mem (performGC)
-import System.IO.Error (tryIOError, isAlreadyInUseError)
+import System.IO.Error (tryIOError)
 import System.IO.Temp (withSystemTempDirectory)
 import Foreign.C.Types ()
 
@@ -70,9 +70,12 @@ spec = do
             bind sock (addrAddress addr) `shouldThrow` anyIOException
 #endif
 
-        it "successfully binds to a unix socket, twice" $ do
+        it "successfully binds to a unix socket" $ do
             withSystemTempDirectory "haskell-network" $ \path -> do
                 let sfile = path ++ "/socket-file"
+                -- exist <- doesFileExist sfile
+                -- when exist $ removeFile sfile
+                -- removeFile sfile
                 let addr = SockAddrUnix sfile
                 when (isSupportedSockAddr addr) $ do
                     sock0 <- socket AF_UNIX Stream defaultProtocol
@@ -82,23 +85,10 @@ spec = do
                     sock1 <- socket AF_UNIX Stream defaultProtocol
                     tryIOError (bind sock1 addr) >>= \o -> case o of
                         Right () -> error "bind should have failed but succeeded"
-                        Left e | not (isAlreadyInUseError e) -> ioError e
-                        _ -> return ()
+                        _        -> return ()
 
                     close sock0
-
-                    -- Unix systems tend to leave the file existing, which is
-                    -- why our `bind` does its workaround. however if any
-                    -- system in the future does fix this issue, we don't want
-                    -- this test to fail, since that would defeat the purpose
-                    -- of our workaround. but you can uncomment the below lines
-                    -- if you want to play with this on your own system.
-                    --import System.Directory (doesPathExist)
-                    --ex <- doesPathExist sfile
-                    --unless ex $ error "socket file was deleted unexpectedly"
-
-                    sock2 <- socket AF_UNIX Stream defaultProtocol
-                    bind sock2 addr
+                    close sock1
 
     describe "UserTimeout" $ do
         it "can be set" $ do