{-# LANGUAGE CPP #-}
#include "HsNetDef.h"
module Network.Socket.Buffer (
sendBufTo
, sendBuf
, recvBufFrom
, recvBuf
) where
import qualified Control.Exception as E
import Foreign.Marshal.Alloc (alloca)
import GHC.IO.Exception (IOErrorType(InvalidArgument))
import System.IO.Error (mkIOError, ioeSetErrorString)
#if defined(mingw32_HOST_OS)
import GHC.IO.FD (FD(..), readRawBufferPtr, writeRawBufferPtr)
#endif
import Network.Socket.Imports
import Network.Socket.Internal
import Network.Socket.Name
import Network.Socket.Types
sendBufTo :: SocketAddress sa =>
Socket
-> Ptr a
-> Int
-> sa
-> IO Int
sendBufTo s ptr nbytes sa =
withSocketAddress sa $ \p_sa siz -> fromIntegral <$> do
withFdSocket s $ \fd -> do
let sz = fromIntegral siz
n = fromIntegral nbytes
flags = 0
throwSocketErrorWaitWrite s "Network.Socket.sendBufTo" $
c_sendto fd ptr n flags p_sa sz
#if defined(mingw32_HOST_OS)
socket2FD :: Socket -> IO FD
socket2FD s = do
fd <- fdSocket s
return $ FD{ fdFD = fd, fdIsSocket_ = 1 }
#endif
sendBuf :: Socket
-> Ptr Word8
-> Int
-> IO Int
sendBuf s str len = fromIntegral <$> do
#if defined(mingw32_HOST_OS)
fd <- socket2FD s
let clen = fromIntegral len
throwSocketErrorIfMinus1Retry "Network.Socket.sendBuf" $
writeRawBufferPtr "Network.Socket.sendBuf" fd (castPtr str) 0 clen
#else
withFdSocket s $ \fd -> do
let flags = 0
clen = fromIntegral len
throwSocketErrorWaitWrite s "Network.Socket.sendBuf" $
c_send fd str clen flags
#endif
recvBufFrom :: SocketAddress sa => Socket -> Ptr a -> Int -> IO (Int, sa)
recvBufFrom s ptr nbytes
| nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvBufFrom")
| otherwise = withNewSocketAddress $ \ptr_sa sz -> alloca $ \ptr_len ->
withFdSocket s $ \fd -> do
poke ptr_len (fromIntegral sz)
let cnbytes = fromIntegral nbytes
flags = 0
len <- throwSocketErrorWaitRead s "Network.Socket.recvBufFrom" $
c_recvfrom fd ptr cnbytes flags ptr_sa ptr_len
sockaddr <- peekSocketAddress ptr_sa
`E.catch` \(E.SomeException _) -> getPeerName s
return (fromIntegral len, sockaddr)
recvBuf :: Socket -> Ptr Word8 -> Int -> IO Int
recvBuf s ptr nbytes
| nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvBuf")
| otherwise = do
#if defined(mingw32_HOST_OS)
fd <- socket2FD s
let cnbytes = fromIntegral nbytes
len <- throwSocketErrorIfMinus1Retry "Network.Socket.recvBuf" $
readRawBufferPtr "Network.Socket.recvBuf" fd ptr 0 cnbytes
#else
len <- withFdSocket s $ \fd ->
throwSocketErrorWaitRead s "Network.Socket.recvBuf" $
c_recv fd (castPtr ptr) (fromIntegral nbytes) 0
#endif
return $ fromIntegral len
mkInvalidRecvArgError :: String -> IOError
mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError
InvalidArgument
loc Nothing Nothing) "non-positive length"
#if !defined(mingw32_HOST_OS)
foreign import ccall unsafe "send"
c_send :: CInt -> Ptr a -> CSize -> CInt -> IO CInt
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"
c_recvfrom :: CInt -> Ptr a -> CSize -> CInt -> Ptr sa -> Ptr CInt -> IO CInt