Fix Win32 linking issues. now need to fixtest failures

Author: Mistuke

Network/Socket/Buffer.hsc

@@ -302,10 +302,10 @@ foreign import CALLCONV SAFE_ON_WIN "ioctlsocket"
   c_ioctlsocket :: CInt -> CLong -> Ptr CULong -> IO CInt
 foreign import CALLCONV SAFE_ON_WIN "WSAGetLastError"
   c_WSAGetLastError :: IO CInt
-foreign import CALLCONV SAFE_ON_WIN "sendmsg"
+foreign import CALLCONV SAFE_ON_WIN "WSASendMsg"
   -- fixme Handle for SOCKET, see #426
   c_sendmsg :: CInt -> Ptr (MsgHdr sa) -> DWORD -> LPDWORD -> Ptr () -> Ptr ()  -> IO CInt
-foreign import CALLCONV SAFE_ON_WIN "recvmsg"
+foreign import CALLCONV SAFE_ON_WIN "WSARecvMsg"
   c_recvmsg :: CInt -> Ptr (MsgHdr sa) -> LPDWORD -> Ptr () -> Ptr () -> IO CInt
 #endif
 

Network/Socket/ByteString/Internal.hs

@@ -62,10 +62,10 @@ foreign import ccall unsafe "recvmsg"
   c_recvmsg :: CInt -> Ptr (MsgHdr SockAddr) -> CInt -> IO CSsize
 #else
   -- fixme Handle for SOCKET, see #426
-foreign import CALLCONV SAFE_ON_WIN "wsasend"
+foreign import CALLCONV SAFE_ON_WIN "WSASend"
   c_wsasend :: CInt -> Ptr WSABuf -> DWORD -> LPDWORD -> DWORD -> Ptr () -> Ptr () -> IO CInt
-foreign import CALLCONV SAFE_ON_WIN "sendmsg"
+foreign import CALLCONV SAFE_ON_WIN "WSASendMsg"
   c_sendmsg :: CInt -> Ptr (MsgHdr SockAddr) -> DWORD -> LPDWORD -> Ptr () -> Ptr ()  -> IO CInt
-foreign import CALLCONV SAFE_ON_WIN "recvmsg"
+foreign import CALLCONV SAFE_ON_WIN "WSARecvMsg"
   c_recvmsg :: CInt -> Ptr (MsgHdr SockAddr) -> LPDWORD -> Ptr () -> Ptr () -> IO CInt
 #endif

cbits/cmsg.c

@@ -3,11 +3,11 @@
 
 #ifdef _WIN32
 
-struct LPCMSGHDR cmsg_firsthdr(LPWSAMSG mhdr) {
+LPWSACMSGHDR cmsg_firsthdr(LPWSAMSG mhdr) {
   return (WSA_CMSG_FIRSTHDR(mhdr));
 }
 
-struct LPCMSGHDR cmsg_nxthdr(LPWSAMSG mhdr, LPWSACMSGHDR cmsg) {
+LPWSACMSGHDR cmsg_nxthdr(LPWSAMSG mhdr, LPWSACMSGHDR cmsg) {
   return (WSA_CMSG_NXTHDR(mhdr, cmsg));
 }
 
@@ -22,6 +22,49 @@ unsigned int cmsg_space(unsigned int l) {
 unsigned int cmsg_len(unsigned int l) {
   return (WSA_CMSG_LEN(l));
 }
+
+static LPFN_WSASENDMSG ptr_SendMsg;
+static LPFN_WSARECVMSG ptr_RecvMsg;
+/* GUIDS to lookup WSASend/RecvMsg */
+static GUID WSARecvMsgGUID = WSAID_WSARECVMSG;
+static GUID WSASendMsgGUID = WSAID_WSASENDMSG;
+
+int WINAPI
+WSASendMsg (SOCKET s, LPWSAMSG lpMsg, DWORD flags,
+            LPDWORD lpdwNumberOfBytesRecvd, LPWSAOVERLAPPED lpOverlapped,
+            LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine) {
+
+  if (!ptr_SendMsg) {
+    DWORD len;
+    if (WSAIoctl(s, SIO_GET_EXTENSION_FUNCTION_POINTER,
+        &WSASendMsgGUID, sizeof(WSASendMsgGUID), &ptr_SendMsg,
+        sizeof(ptr_SendMsg), &len, NULL, NULL) != 0)
+      return -1;
+  }
+
+  return ptr_SendMsg (s, lpMsg, flags, lpdwNumberOfBytesRecvd, lpOverlapped,
+                      lpCompletionRoutine);
+}
+
+/**
+ * WSARecvMsg function
+ */
+int WINAPI
+WSARecvMsg (SOCKET s, LPWSAMSG lpMsg, LPDWORD lpdwNumberOfBytesRecvd,
+            LPWSAOVERLAPPED lpOverlapped,
+            LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine) {
+
+  if (!ptr_RecvMsg) {
+    DWORD len;
+    if (WSAIoctl(s, SIO_GET_EXTENSION_FUNCTION_POINTER,
+        &WSARecvMsgGUID, sizeof(WSARecvMsgGUID), &ptr_RecvMsg,
+        sizeof(ptr_RecvMsg), &len, NULL, NULL) != 0)
+      return -1;
+  }
+
+  return ptr_RecvMsg (s, lpMsg, lpdwNumberOfBytesRecvd, lpOverlapped,
+                      lpCompletionRoutine);
+}
 #else
 struct cmsghdr *cmsg_firsthdr(struct msghdr *mhdr) {
   return (CMSG_FIRSTHDR(mhdr));

include/HsNet.h

@@ -82,7 +82,7 @@ extern void* newAcceptParams(int sock,
 extern int   acceptNewSock(void* d);
 extern int   acceptDoProc(void* param);
 
-extern struct LPWSACMSGHDR
+extern LPWSACMSGHDR
 cmsg_firsthdr(LPWSAMSG mhdr);
 
 extern LPWSACMSGHDR
@@ -96,6 +96,20 @@ cmsg_space(unsigned int l);
 
 extern unsigned int
 cmsg_len(unsigned int l);
+
+/**
+ * WSASendMsg function
+ */
+extern WINAPI int
+WSASendMsg (SOCKET, LPWSAMSG, DWORD, LPDWORD,
+            LPWSAOVERLAPPED, LPWSAOVERLAPPED_COMPLETION_ROUTINE);
+
+/**
+ * WSARecvMsg function
+ */
+extern WINAPI int
+WSARecvMsg (SOCKET, LPWSAMSG, LPDWORD,
+            LPWSAOVERLAPPED, LPWSAOVERLAPPED_COMPLETION_ROUTINE);
 #else  /* _WIN32 */
 extern int
 sendFd(int sock, int outfd);

network.cabal

@@ -88,7 +88,7 @@ library
   include-dirs: include
   includes: HsNet.h HsNetDef.h alignment.h win32defs.h
   install-includes: HsNet.h HsNetDef.h win32defs.h
-  c-sources: cbits/HsNet.c
+  c-sources: cbits/HsNet.c cbits/cmsg.c
   ghc-options: -Wall -fwarn-tabs
   build-tools: hsc2hs
 
@@ -102,8 +102,6 @@ library
       Network.Socket.Posix.IOVec
       Network.Socket.Posix.MsgHdr
       Network.Socket.Unix
-    c-sources: cbits/cmsg.c
-
 
   if os(solaris)
     extra-libraries: nsl, socket
@@ -116,10 +114,11 @@ library
       Network.Socket.Win32.WSABuf
       Network.Socket.Win32.MsgHdr
     c-sources: cbits/initWinSock.c, cbits/winSockErr.c, cbits/asyncAccept.c
-    extra-libraries: ws2_32, iphlpapi
+    extra-libraries: ws2_32, iphlpapi, mswsock
     -- See https://github.com/haskell/network/pull/362
     if impl(ghc >= 7.10)
       cpp-options: -D_WIN32_WINNT=0x0600
+      cc-options: -D_WIN32_WINNT=0x0600
 
 test-suite spec
   default-language: Haskell2010

tests/Network/SocketSpec.hs

@@ -126,6 +126,7 @@ spec = do
             -- check if an exception is not thrown.
             isSupportedSockAddr addr `shouldBe` True
 
+#if !defined(mingw32_HOST_OS)
     when isUnixDomainSocketAvailable $ do
         context "unix sockets" $ do
             it "basic unix sockets end-to-end" $ do
@@ -134,6 +135,7 @@ spec = do
                         recv sock 1024 `shouldReturn` testMsg
                         addr `shouldBe` (SockAddrUnix "")
                 test . setClientAction client $ unixWithUnlink unixAddr server
+#endif
 
 #ifdef linux_HOST_OS
             it "can end-to-end with an abstract socket" $ do
@@ -152,6 +154,7 @@ spec = do
                     bind sock (SockAddrUnix abstractAddress) `shouldThrow` anyErrorCall
 #endif
 
+#if !defined(mingw32_HOST_OS)
             describe "socketPair" $ do
                 it "can send and recieve bi-directionally" $ do
                     (s1, s2) <- socketPair AF_UNIX Stream defaultProtocol
@@ -206,6 +209,7 @@ spec = do
                     cred1 <- getPeerCredential s
                     cred1 `shouldBe` (Nothing,Nothing,Nothing)
             -}
+#endif
 
     describe "gracefulClose" $ do
         it "does not send TCP RST back" $ do