Use the correct return type for Windows' send()/recv() (Fix #12010)

Summary:
They return signed 32 bit ints on Windows, even on a 64 bit OS, rather than
Linux's 64 bit ssize_t. This means when recv() returned -1 to signal an error we
thought it was 4294967295. It was converted to an int, -1 and the buffer was
memcpy'd which caused a segfault. Other bad stuff happened with send()s.

See also note CSsize in System.Posix.Internals.

Add a test for #12010

Test Plan:
- GHC testsuite (T12010)
- http-conduit test (https://github.com/snoyberg/http-client/issues/191)

Reviewers: austin, hvr, bgamari, Phyx

Reviewed By: Phyx

Subscribers: thomie

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

GHC Trac Issues: #12010

5 files changed, 103 insertions, 0 deletions

diff --git a/libraries/base/tests/IO/T12010/Makefile b/libraries/base/tests/IO/T12010/Makefile
new file mode 100644
index 0000000000..112e1f19fc
--- /dev/null
+++ b/libraries/base/tests/IO/T12010/Makefile
@@ -0,0 +1,10 @@
+TOP=../../../../../testsuite
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+.PHONY: T12010
+T12010:
+	'$(HSC2HS)' -I ../../../include/ -I ../../../../../includes/ T12010.hsc
+	'$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -c cbits/initWinSock.c
+	'$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -fno-warn-unsupported-calling-conventions cbits/initWinSock.o T12010.hs
+	./T12010
diff --git a/libraries/base/tests/IO/T12010/T12010.hsc b/libraries/base/tests/IO/T12010/T12010.hsc
new file mode 100644
index 0000000000..fa566e0025
--- /dev/null
+++ b/libraries/base/tests/IO/T12010/T12010.hsc
@@ -0,0 +1,40 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Main where
+import Control.Exception
+import Control.Monad
+import Foreign.C.Types
+import Foreign.Marshal.Alloc
+import GHC.IO.FD
+import System.Exit
+
+-- HsBase includes WinSock on Windows, on POSIX we need to explicitly ask for
+-- sockets.
+#include "HsBase.h"
+#ifndef _WIN32
+#include <sys/socket.h>
+#endif
+
+aF_INET :: CInt
+aF_INET = #const AF_INET
+
+sOCK_STREAM :: CInt
+sOCK_STREAM = #const SOCK_STREAM
+
+main :: IO ()
+main = do
+#ifdef _WIN32
+  void $ initWinSock
+#endif
+  sock <- c_socket aF_INET sOCK_STREAM 0
+  let fd = FD sock 1
+  res <- try $ allocaBytes 1024 (\ptr -> readRawBufferPtr "T12010" fd ptr 0 1024)
+  case res of
+    Left (_ex :: IOException) -> exitSuccess
+    Right res'                -> print res' >> exitFailure
+
+foreign import stdcall unsafe "socket"
+  c_socket :: CInt -> CInt -> CInt -> IO CInt
+
+#ifdef _WIN32
+foreign import ccall unsafe "initWinSock" initWinSock :: IO Int
+#endif
diff --git a/libraries/base/tests/IO/T12010/T12010.stdout b/libraries/base/tests/IO/T12010/T12010.stdout
new file mode 100644
index 0000000000..dec7b86bee
--- /dev/null
+++ b/libraries/base/tests/IO/T12010/T12010.stdout
@@ -0,0 +1,2 @@
+[1 of 1] Compiling Main             ( T12010.hs, T12010.o )
+Linking T12010 ...
diff --git a/libraries/base/tests/IO/T12010/cbits/initWinSock.c b/libraries/base/tests/IO/T12010/cbits/initWinSock.c
new file mode 100644
index 0000000000..be517edc35
--- /dev/null
+++ b/libraries/base/tests/IO/T12010/cbits/initWinSock.c
@@ -0,0 +1,43 @@
+#include "HsBase.h"
+#include "HsFFI.h"
+
+#if defined(HAVE_WINSOCK_H) && !defined(__CYGWIN__)
+
+static int winsock_inited = 0;
+
+static void
+shutdownHandler(void)
+{
+  WSACleanup();
+}
+
+/* Initialising WinSock... */
+int
+initWinSock ()
+{
+  WORD wVersionRequested;
+  WSADATA wsaData;
+  int err;
+
+  if (!winsock_inited) {
+    wVersionRequested = MAKEWORD( 2, 2 );
+
+    err = WSAStartup ( wVersionRequested, &wsaData );
+
+    if ( err != 0 ) {
+       return err;
+    }
+
+    if ( LOBYTE( wsaData.wVersion ) != 2 ||
+       HIBYTE( wsaData.wVersion ) != 2 ) {
+      WSACleanup();
+      return (-1);
+    }
+
+    atexit(shutdownHandler);
+    winsock_inited = 1;
+  }
+  return 0;
+}
+
+#endif
diff --git a/libraries/base/tests/IO/T12010/test.T b/libraries/base/tests/IO/T12010/test.T
new file mode 100644
index 0000000000..178814fff3
--- /dev/null
+++ b/libraries/base/tests/IO/T12010/test.T
@@ -0,0 +1,8 @@
+test('T12010',
+     [
+        extra_clean(['cbits/initWinSock.o', 'T12010.hi', 'T12010.hs']),
+        only_ways(['threaded1']),
+        extra_ways(['threaded1']),
+        cmd_prefix('WAY_FLAGS="' + ' '.join(config.way_flags('T12010')['threaded1']) + '"')],
+     run_command,
+     ['$MAKE -s --no-print-directory T12010'])