Split platform code into Posix and Win32 modules

Network/Socket/Buffer.hs

@@ -0,0 +1,125 @@
+{-# LANGUAGE CPP #-}
+
+-- | Sending and receiving with buffers.  The work is done by
+--   "Network.Socket.Posix.Buffer" or "Network.Socket.Win32.Buffer".
+module Network.Socket.Buffer (
+    sendBufTo
+  , sendBuf
+  , recvBufFrom
+  , recvBuf
+  , recvBufNoWait
+  , recvBufNoWaitOr
+  , sendBufMsg
+  , recvBufMsg
+  ) where
+
+import GHC.IO.Exception (IOErrorType(InvalidArgument))
+import System.IO.Error (mkIOError, ioeSetErrorString)
+
+import Network.Socket.Flag
+import Network.Socket.Imports
+import Network.Socket.Types
+#if defined(mingw32_HOST_OS)
+import Network.Socket.Win32.Cmsg (Cmsg)
+import qualified Network.Socket.Win32.Buffer as P
+#else
+import Network.Socket.Posix.Cmsg (Cmsg)
+import qualified Network.Socket.Posix.Buffer as P
+#endif
+
+-- | Send data to the socket.  The recipient can be specified
+-- explicitly, so the socket need not be in a connected state.
+-- Returns the number of bytes sent.  Applications are responsible for
+-- ensuring that all data has been sent.
+sendBufTo :: SocketAddress sa =>
+             Socket -- (possibly) bound/connected Socket
+          -> Ptr a
+          -> Int         -- Data to send
+          -> sa
+          -> IO Int      -- Number of Bytes sent
+sendBufTo = P.sendBufTo
+
+-- | Send data to the socket. The socket must be connected to a remote
+-- socket. Returns the number of bytes sent.  Applications are
+-- responsible for ensuring that all data has been sent.
+sendBuf :: Socket    -- Bound/Connected Socket
+        -> Ptr Word8  -- Pointer to the data to send
+        -> Int        -- Length of the buffer
+        -> IO Int     -- Number of Bytes sent
+sendBuf = P.sendBuf
+
+-- | Receive data from the socket, writing it into buffer instead of
+-- creating a new string.  The socket need not be in a connected
+-- state. Returns @(nbytes, address)@ where @nbytes@ is the number of
+-- bytes received and @address@ is a 'SockAddr' representing the
+-- address of the sending socket.
+--
+-- If the first return value is zero, it means EOF.
+--
+-- For 'Stream' sockets, the second return value would be invalid.
+recvBufFrom :: SocketAddress sa => Socket -> Ptr a -> Int -> IO (Int, sa)
+recvBufFrom s ptr nbytes
+    | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvBufFrom")
+    | otherwise   = P.recvBufFrom s ptr nbytes
+
+-- | Receive data from the socket.  The socket must be in a connected
+-- state. This function may return fewer bytes than specified.  If the
+-- message is longer than the specified length, it may be discarded
+-- depending on the type of socket.  This function may block until a
+-- message arrives.
+--
+-- Considering hardware and network realities, the maximum number of
+-- bytes to receive should be a small power of 2, e.g., 4096.
+--
+-- The return value is the length of received data. Zero means
+-- EOF. Historical note: Version 2.8.x.y or earlier,
+-- an EOF error was thrown. This was changed in version 3.0.
+recvBuf :: Socket -> Ptr Word8 -> Int -> IO Int
+recvBuf s ptr nbytes
+    | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvBuf")
+    | otherwise   = P.recvBuf s ptr nbytes
+
+-- | Receive data from the socket. This function returns immediately
+--   even if data is not available. In other words, IO manager is NOT
+--   involved. The length of data is returned if received.
+--   -1 is returned in the case of EAGAIN or EWOULDBLOCK.
+--   -2 is returned in other error cases.
+recvBufNoWait :: Socket -> Ptr Word8 -> Int -> IO Int
+recvBufNoWait = recvBufNoWaitOr $ return (-2)
+
+-- | 'recvBufNoWait' which runs the action on an error, in place of
+--   answering -2.  The error is gone from the socket once read, so this
+--   is where to raise it.
+recvBufNoWaitOr :: IO CInt -> Socket -> Ptr Word8 -> Int -> IO Int
+recvBufNoWaitOr = P.recvBufNoWaitOr
+
+mkInvalidRecvArgError :: String -> IOError
+mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError
+                                    InvalidArgument
+                                    loc Nothing Nothing) "non-positive length"
+
+-- | Send data to the socket using sendmsg(2).
+sendBufMsg :: SocketAddress sa
+           => Socket            -- ^ Socket
+           -> sa                -- ^ Destination address
+           -> [(Ptr Word8,Int)] -- ^ Data to be sent
+           -> [Cmsg]            -- ^ Control messages
+           -> MsgFlag           -- ^ Message flags
+           -> IO Int            -- ^ The length actually sent
+sendBufMsg = P.sendBufMsg
+
+-- | Receive data from the socket using recvmsg(2). The supplied
+--   buffers are filled in order, with subsequent buffers used only
+--   after all the preceding buffers are full. If the message is short
+--   enough some of the supplied buffers may remain unused.
+recvBufMsg :: SocketAddress sa
+           => Socket            -- ^ Socket
+           -> [(Ptr Word8,Int)] -- ^ A list of (buffer, buffer-length) pairs.
+                                --   If the total length is not large enough,
+                                --   'MSG_TRUNC' is returned
+           -> Int               -- ^ The buffer size for control messages.
+                                --   If the length is not large enough,
+                                --   'MSG_CTRUNC' is returned
+           -> MsgFlag           -- ^ Message flags
+           -> IO (sa,Int,[Cmsg],MsgFlag) -- ^ Source address, total bytes received, control messages and message flags
+recvBufMsg = P.recvBufMsg

Network/Socket/ByteString/IO.hsc

@@ -63,25 +63,17 @@ import Network.Socket.Wait
 
 import Data.ByteString.Internal (create, ByteString(..))
 import Foreign.ForeignPtr (withForeignPtr)
-import Foreign.Marshal.Utils (with)
 import Network.Socket.Internal
 import System.Posix.Types (Fd(..))
 
 import Network.Socket.Flag
 import Network.Socket.SockAddr (annotateWithSocket)
-#if defined(mingw32_HOST_OS)
-import Network.Socket.Win32.Load
-#endif
-
 #if !defined(mingw32_HOST_OS)
 import Network.Socket.Posix.Cmsg
-import Network.Socket.Posix.IOVec
-import Network.Socket.Posix.MsgHdr (MsgHdr(..))
+import qualified Network.Socket.Posix.ByteString as P
 #else
-import Foreign.Marshal.Alloc (alloca)
 import Network.Socket.Win32.Cmsg
-import Network.Socket.Win32.WSABuf
-import Network.Socket.Win32.MsgHdr (MsgHdr(..))
+import qualified Network.Socket.Win32.ByteString as P
 #endif
 
 -- ----------------------------------------------------------------------------
@@ -200,22 +192,7 @@ sendMany s cs = sendMany' `annotateWithSocket` (s, Nothing)
 
 -- One gathering write, which may send only part of the data.
 sendManyOnce :: Socket -> [ByteString] -> IO Int
-sendManyOnce s cs =
-#if !defined(mingw32_HOST_OS)
-      fmap fromIntegral . withIOVecfromBS cs $ \(iovsPtr, iovsLen) ->
-          withFdSocket s $ \fd -> do
-              let len =  fromIntegral $ min iovsLen (#const IOV_MAX)
-              throwSocketErrorWaitWrite s "Network.Socket.ByteString.sendMany" $
-                  c_writev fd iovsPtr len
-#else
-      fmap fromIntegral . withWSABuffromBS cs $ \(wsabsPtr, wsabsLen) ->
-          withFdSocket s $ \fd -> do
-              let len =  fromIntegral wsabsLen
-              alloca $ \send_ptr -> do
-                  _ <- throwSocketErrorWaitWrite s "Network.Socket.ByteString.sendMany" $
-                         c_wsasend fd wsabsPtr len send_ptr  0 nullPtr nullPtr
-                  peek send_ptr
-#endif
+sendManyOnce = P.sendManyOnce
 
 -- | 'sendMany' which the caller can give up on.  Parts may have been
 --   sent before it gives up, so a stream given up on is to be closed.
@@ -243,45 +220,9 @@ sendManyTo _ [] _    = return ()
 sendManyTo s cs addr = sendManyTo' `annotateWithSocket` (s, Nothing)
   where
     sendManyTo' =  do
-        sent <- fromIntegral <$> sendManyToInner
+        sent <- P.sendManyToOnce s cs addr
         waitWhen0 sent s
         when (sent >= 0) $ sendManyTo s (remainingChunks sent cs) addr
-    sendManyToInner =
-      withSockAddr addr $ \addrPtr addrSize ->
-#if !defined(mingw32_HOST_OS)
-        withIOVecfromBS cs $ \(iovsPtr, iovsLen) -> do
-          let msgHdr = MsgHdr {
-                  msgName    = addrPtr
-                , msgNameLen = fromIntegral addrSize
-                , msgIov     = iovsPtr
-                , msgIovLen  = fromIntegral iovsLen
-                , msgCtrl    = nullPtr
-                , msgCtrlLen = 0
-                , msgFlags   = 0
-                }
-          withFdSocket s $ \fd ->
-              with msgHdr $ \msgHdrPtr ->
-                throwSocketErrorWaitWrite s "Network.Socket.ByteString.sendManyTo" $
-                  c_sendmsg fd msgHdrPtr 0
-#else
-        withWSABuffromBS cs $ \(wsabsPtr, wsabsLen) -> do
-          let msgHdr = MsgHdr {
-                  msgName      = addrPtr
-                , msgNameLen   = fromIntegral addrSize
-                , msgBuffer    = wsabsPtr
-                , msgBufferLen = fromIntegral wsabsLen
-                , msgCtrl      = nullPtr
-                , msgCtrlLen   = 0
-                , msgFlags     = 0
-                }
-          withFdSocket s $ \fd -> do
-              sendMsg <- mkSendMsgUnsafe <$> getWSASendMsg fd
-              with msgHdr $ \msgHdrPtr ->
-                alloca $ \send_ptr -> do
-                  _ <- throwSocketErrorWaitWrite s "Network.Socket.ByteString.sendManyTo" $
-                          sendMsg fd (castPtr msgHdrPtr) 0 send_ptr nullPtr nullPtr
-                  peek send_ptr
-#endif
 
 -- | Send data and file descriptors over a UNIX-domain socket in
 --   a single system call. This function does not work on Windows.
@@ -395,29 +336,6 @@ remainingChunks i (x:xs)
   where
     len = B.length x
 
-#if !defined(mingw32_HOST_OS)
--- | @withIOVecfromBS cs f@ executes the computation @f@, passing as argument a pair
--- consisting of a pointer to a temporarily allocated array of pointers to
--- IOVec made from @cs@ and the number of pointers (@length cs@).
--- /Unix only/.
-withIOVecfromBS :: [ByteString] -> ((Ptr IOVec, Int) -> IO a) -> IO a
-withIOVecfromBS cs f = withBufSizs cs $ \bufsizs -> withIOVec bufsizs f
-#else
--- | @withWSABuffromBS cs f@ executes the computation @f@, passing as argument a pair
--- consisting of a pointer to a temporarily allocated array of pointers to
--- WSABuf made from @cs@ and the number of pointers (@length cs@).
--- /Windows only/.
-withWSABuffromBS :: [ByteString] -> ((Ptr WSABuf, Int) -> IO a) -> IO a
-withWSABuffromBS cs f = withBufSizs cs $ \bufsizs -> withWSABuf bufsizs f
-#endif
-
-withBufSizs :: [ByteString] -> ([(Ptr Word8, Int)] -> IO a) -> IO a
-withBufSizs bss0 f = loop bss0 id
-  where
-    loop []                    build = f $ build []
-    loop (PS fptr off len:bss) build = withForeignPtr fptr $ \ptr -> do
-        let ptr' = ptr `plusPtr` off
-        loop bss (build . ((ptr',len) :))
 
 -- | Send data to the socket using sendmsg(2).
 sendMsg :: Socket       -- ^ Socket

Network/Socket/ByteString/Internal.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE CPP #-}
-
 -- |
 -- Module      : Network.Socket.ByteString.Internal
 -- Copyright   : (c) Johan Tibell 2007-2010
@@ -12,57 +10,26 @@
 module Network.Socket.ByteString.Internal
     (
       mkInvalidRecvArgError
-#if !defined(mingw32_HOST_OS)
-    , c_writev
-    , c_sendmsg
-    , c_recvmsg
-#else
-    , c_wsasend
-#endif
+    , withBufSizs
     ) where
 
-#include "HsNetDef.h"
-
+import Data.ByteString.Internal (ByteString (..))
+import Foreign.ForeignPtr (withForeignPtr)
 import GHC.IO.Exception (IOErrorType(..))
 import System.IO.Error (ioeSetErrorString, mkIOError)
 
-#if !defined(mingw32_HOST_OS)
-import System.Posix.Types (CSsize(..))
-
 import Network.Socket.Imports
-import Network.Socket.Posix.IOVec (IOVec)
-import Network.Socket.Posix.MsgHdr (MsgHdr)
-import Network.Socket.Types
-#else
-import Data.Word
-import Foreign.C.Types
-import Foreign.Ptr
-
-import Network.Socket.Win32.WSABuf (WSABuf)
-import Network.Socket.Types
-
-type DWORD   = Word32
-type LPDWORD = Ptr DWORD
-#endif
 
 mkInvalidRecvArgError :: String -> IOError
 mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError
                                     InvalidArgument
                                     loc Nothing Nothing) "non-positive length"
 
-#if !defined(mingw32_HOST_OS)
-foreign import ccall unsafe "writev"
-  c_writev :: CSocket -> Ptr IOVec -> CInt -> IO CSsize
-
-foreign import ccall unsafe "sendmsg"
-  c_sendmsg :: CSocket -> Ptr (MsgHdr SockAddr) -> CInt -> IO CSsize
-
-foreign import ccall unsafe "recvmsg"
-  c_recvmsg :: CSocket -> Ptr (MsgHdr SockAddr) -> CInt -> IO CSsize
-#else
-  -- fixme Handle for SOCKET, see #426
-foreign import CALLCONV unsafe "WSASend"
-  c_wsasend :: CSocket -> Ptr WSABuf -> DWORD -> LPDWORD -> DWORD -> Ptr () -> Ptr () -> IO CInt
--- WSASendMsg and WSARecvMsg are extension functions and cannot be
--- imported by name; see Network.Socket.Win32.Load.
-#endif
+-- | The buffers of the parts, with their lengths.
+withBufSizs :: [ByteString] -> ([(Ptr Word8, Int)] -> IO a) -> IO a
+withBufSizs bss0 f = loop bss0 id
+  where
+    loop []                    build = f $ build []
+    loop (PS fptr off len:bss) build = withForeignPtr fptr $ \ptr -> do
+        let ptr' = ptr `plusPtr` off
+        loop bss (build . ((ptr',len) :))

Network/Socket/ByteString/Lazy.hs

@@ -45,19 +45,17 @@ import System.Posix.Types (Fd (..))
 import Prelude hiding (getContents)
 
 #if defined(mingw32_HOST_OS)
-import Network.Socket.ByteString.Lazy.Windows  (send, sendAll)
+import Network.Socket.Win32.ByteString.Lazy (send, sendAll)
 #else
-import Network.Socket.ByteString.Lazy.Posix    (send, sendAll)
+import Network.Socket.Posix.ByteString.Lazy (send, sendAll)
 #endif
 
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
 import qualified Network.Socket.ByteString as N
 import Network.Socket.Imports
 import Network.Socket.Types
-#if !defined(mingw32_HOST_OS)
 import Network.Socket.Wait (withWritable)
-#endif
 
 -- | Send data and file descriptors over a UNIX-domain socket in
 --   a single system call. This function does not work on Windows.
@@ -77,17 +75,7 @@ sendWithFds s lbs fds = N.sendManyWithFds s (L.toChunks lbs) fds
 --
 --   @since 3.2.12.0
 sendWith :: Socket -> ByteString -> STM a -> IO (Either a Int64)
-#if defined(mingw32_HOST_OS)
--- 'send' sends the first chunk here, and so does this, through the
--- strict one, whose give-up cancels its own operation alone.
-sendWith s lbs giveUp = fmap fromIntegral <$> N.sendWith s chunk giveUp
-  where
-    chunk = case L.toChunks lbs of
-        [] -> S.empty
-        x : _ -> x
-#else
 sendWith s lbs giveUp = withWritable s giveUp $ send s lbs
-#endif
 
 -- | 'sendAll' which the caller can give up on.  Part of the data may
 --   have been sent before it gives up, so a stream given up on is to be