Created
August 3, 2019 11:33
-
-
Save Mistuke/1a69e57cd17c59f3e809274500cc5ec0 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| commit bfc8afc301ff998293a1a425515eab3ea122d534 | |
| Author: Tamar Christina <[email protected]> | |
| Date: Sat Aug 3 11:31:29 2019 +0100 | |
| Add windows implementation | |
| diff --git a/Network/Socket/Buffer.hs b/Network/Socket/Buffer.hsc | |
| similarity index 86% | |
| rename from Network/Socket/Buffer.hs | |
| rename to Network/Socket/Buffer.hsc | |
| index 38a5390..1beb84d 100644 | |
| --- a/Network/Socket/Buffer.hs | |
| +++ b/Network/Socket/Buffer.hsc | |
| @@ -1,6 +1,9 @@ | |
| {-# LANGUAGE CPP #-} | |
| -#include "HsNetDef.h" | |
| +##include "HsNetDef.h" | |
| +#if defined(mingw32_HOST_OS) | |
| +# include "windows.h" | |
| +#endif | |
| module Network.Socket.Buffer ( | |
| sendBufTo | |
| @@ -10,7 +13,9 @@ module Network.Socket.Buffer ( | |
| , recvBufNoWait | |
| ) where | |
| +#if !defined(mingw32_HOST_OS) | |
| import Foreign.C.Error (getErrno, eAGAIN, eWOULDBLOCK) | |
| +#endif | |
| import Foreign.Marshal.Alloc (alloca) | |
| import GHC.IO.Exception (IOErrorType(InvalidArgument)) | |
| import System.IO.Error (mkIOError, ioeSetErrorString, catchIOError) | |
| @@ -138,6 +143,26 @@ recvBuf s ptr nbytes | |
| -- -2 is returned in other error cases. | |
| recvBufNoWait :: Socket -> Ptr Word8 -> Int -> IO Int | |
| recvBufNoWait s ptr nbytes = withFdSocket s $ \fd -> do | |
| +#if defined(mingw32_HOST_OS) | |
| + alloca $ \ptr_bytes -> do | |
| + avail <- c_ioctlsocket fd #{const FIONREAD} ptr_bytes | |
| + r <- if avail > 0 then | |
| + c_recv fd (castPtr ptr) (fromIntegral nbytes) 0{-flags-} | |
| + else if avail == 0 then | |
| + -- Socket would block, could also mean socket is closed but | |
| + -- can't distinguish | |
| + return (-1) | |
| + else return avail | |
| + if r >= 0 then | |
| + return $ fromIntegral r | |
| + else do | |
| + err <- c_WSAGetLastError | |
| + if err == #{const WSAEWOULDBLOCK} | |
| + || err == #{const WSAEINPROGRESS} then | |
| + return (-1) | |
| + else | |
| + return (-2) | |
| +#else | |
| r <- c_recv fd (castPtr ptr) (fromIntegral nbytes) 0{-flags-} | |
| if r >= 0 then | |
| return $ fromIntegral r | |
| @@ -147,6 +172,7 @@ recvBufNoWait s ptr nbytes = withFdSocket s $ \fd -> do | |
| return (-1) | |
| else | |
| return (-2) | |
| +#endif | |
| mkInvalidRecvArgError :: String -> IOError | |
| mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError | |
| @@ -156,9 +182,14 @@ mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError | |
| #if !defined(mingw32_HOST_OS) | |
| foreign import ccall unsafe "send" | |
| c_send :: CInt -> Ptr a -> CSize -> CInt -> IO CInt | |
| +#else | |
| +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 | |
| +#endif | |
| foreign import ccall unsafe "recv" | |
| c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt | |
| -#endif | |
| foreign import CALLCONV SAFE_ON_WIN "sendto" | |
| c_sendto :: CInt -> Ptr a -> CSize -> CInt -> Ptr sa -> CInt -> IO CInt | |
| foreign import CALLCONV SAFE_ON_WIN "recvfrom" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment