packages feed

network-bytestring 0.1.3.3 → 0.1.3.4

raw patch · 6 files changed

+590/−6 lines, 6 filesdep +unixdep ~network

Dependencies added: unix

Dependency ranges changed: network

Files

Network/Socket/ByteString.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, ForeignFunctionInterface, PackageImports #-}+{-# LANGUAGE CPP, ForeignFunctionInterface #-}  -- | -- Module      : Network.Socket.ByteString@@ -40,4 +40,344 @@     -- $example   ) where -import "network" Network.Socket.ByteString+import Control.Monad (liftM, when)+import Data.ByteString (ByteString)+import Data.ByteString.Internal (createAndTrim)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.Word (Word8)+import Foreign.C.Types (CInt)+import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.Ptr (Ptr, castPtr)+import Network.Socket (SockAddr, Socket(..), sendBufTo, recvBufFrom)++import qualified Data.ByteString as B++import Network.Socket.ByteString.Internal++#if !defined(mingw32_HOST_OS)+import Control.Monad (zipWithM_)+import Foreign.C.Types (CChar, CSize)+import Foreign.Marshal.Array (allocaArray)+import Foreign.Marshal.Utils (with)+import Foreign.Ptr (plusPtr)+import Foreign.Storable (Storable(..))+import Network.Socket.Internal (throwSocketErrorIfMinus1RetryMayBlock,+                                withSockAddr)++import Network.Socket.ByteString.IOVec (IOVec(..))+import Network.Socket.ByteString.MsgHdr (MsgHdr(..))++#  if defined(__GLASGOW_HASKELL__)+import GHC.Conc (threadWaitRead, threadWaitWrite)+#  endif+#else+#  if defined(__GLASGOW_HASKELL__)+#    if __GLASGOW_HASKELL__ >= 611+import GHC.IO.FD+#    else+import GHC.Handle (readRawBufferPtr, writeRawBufferPtr)+#    endif+#  endif+#endif++#if defined(HAVE_WINSOCK_H) && !defined(cygwin32_HOST_OS)+#  define WITH_WINSOCK 1+#endif++#if !defined(CALLCONV)+#  ifdef WITH_WINSOCK+#    define CALLCONV stdcall+#  else+#    define CALLCONV ccall+#  endif+#endif++#if !defined(mingw32_HOST_OS)+foreign import CALLCONV unsafe "send"+  c_send :: CInt -> Ptr a -> CSize -> CInt -> IO CInt+foreign import CALLCONV unsafe "recv"+  c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt+#endif++-- ----------------------------------------------------------------------------+-- Sending++-- | 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.+send :: Socket      -- ^ Connected socket+     -> ByteString  -- ^ Data to send+     -> IO Int      -- ^ Number of bytes sent+send (MkSocket s _ _ _ _) xs =+    unsafeUseAsCStringLen xs $ \(str, len) ->+    liftM fromIntegral $+#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS)+#  if __GLASGOW_HASKELL__ >= 611+        writeRawBufferPtr "Network.Socket.ByteString.send"+        (FD s 1) (castPtr str) 0 (fromIntegral len)+#  else+        writeRawBufferPtr "Network.Socket.ByteString.send"+        (fromIntegral s) True str 0 (fromIntegral len)+#  endif+#else+#  if !defined(__HUGS__)+        throwSocketErrorIfMinus1RetryMayBlock "send"+        (threadWaitWrite (fromIntegral s)) $+#  endif+        c_send s str (fromIntegral len) 0+#endif++-- | Send data to the socket.  The socket must be connected to a+-- remote socket.  Unlike 'send', this function continues to send data+-- until either all data has been sent or an error occurs.  On error,+-- an exception is raised, and there is no way to determine how much+-- data, if any, was successfully sent.+sendAll :: Socket      -- ^ Connected socket+        -> ByteString  -- ^ Data to send+        -> IO ()+sendAll sock bs = do+    sent <- send sock bs+    when (sent < B.length bs) $ sendAll sock (B.drop sent bs)++-- | 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.+sendTo :: Socket      -- ^ Socket+       -> ByteString  -- ^ Data to send+       -> SockAddr    -- ^ Recipient address+       -> IO Int      -- ^ Number of bytes sent+sendTo sock xs addr =+    unsafeUseAsCStringLen xs $ \(str, len) -> sendBufTo sock str len addr++-- | Send data to the socket. The recipient can be specified+-- explicitly, so the socket need not be in a connected state.  Unlike+-- 'sendTo', this function continues to send data until either all+-- data has been sent or an error occurs.  On error, an exception is+-- raised, and there is no way to determine how much data, if any, was+-- successfully sent.+sendAllTo :: Socket      -- ^ Socket+          -> ByteString  -- ^ Data to send+          -> SockAddr    -- ^ Recipient address+          -> IO ()+sendAllTo sock xs addr = do+    sent <- sendTo sock xs addr+    when (sent < B.length xs) $ sendAllTo sock (B.drop sent xs) addr++-- ----------------------------------------------------------------------------+-- ** Vectored I/O++-- $vectored+--+-- Vectored I\/O, also known as scatter\/gather I\/O, allows multiple+-- data segments to be sent using a single system call, without first+-- concatenating the segments.  For example, given a list of+-- @ByteString@s, @xs@,+--+-- > sendMany sock xs+--+-- is equivalent to+--+-- > sendAll sock (concat xs)+--+-- but potentially more efficient.+--+-- Vectored I\/O are often useful when implementing network protocols+-- that, for example, group data into segments consisting of one or+-- more fixed-length headers followed by a variable-length body.++-- | Send data to the socket.  The socket must be in a connected+-- state.  The data is sent as if the parts have been concatenated.+-- This function continues to send data until either all data has been+-- sent or an error occurs.  On error, an exception is raised, and+-- there is no way to determine how much data, if any, was+-- successfully sent.+sendMany :: Socket        -- ^ Connected socket+         -> [ByteString]  -- ^ Data to send+         -> IO ()+#if !defined(mingw32_HOST_OS)+sendMany sock@(MkSocket fd _ _ _ _) cs = do+    sent <- sendManyInner+    when (sent < totalLength cs) $ sendMany sock (remainingChunks sent cs)+  where+    sendManyInner =+      liftM fromIntegral . withIOVec cs $ \(iovsPtr, iovsLen) ->+          throwSocketErrorIfMinus1RetryMayBlock "writev"+              (threadWaitWrite (fromIntegral fd)) $+              c_writev (fromIntegral fd) iovsPtr (fromIntegral iovsLen)+#else+sendMany sock = sendAll sock . B.concat+#endif++-- | Send data to the socket.  The recipient can be specified+-- explicitly, so the socket need not be in a connected state.  The+-- data is sent as if the parts have been concatenated.  This function+-- continues to send data until either all data has been sent or an+-- error occurs.  On error, an exception is raised, and there is no+-- way to determine how much data, if any, was successfully sent.+sendManyTo :: Socket        -- ^ Socket+           -> [ByteString]  -- ^ Data to send+           -> SockAddr      -- ^ Recipient address+           -> IO ()+#if !defined(mingw32_HOST_OS)+sendManyTo sock@(MkSocket fd _ _ _ _) cs addr = do+    sent <- liftM fromIntegral sendManyToInner+    when (sent < totalLength cs) $ sendManyTo sock (remainingChunks sent cs) addr+  where+    sendManyToInner =+      withSockAddr addr $ \addrPtr addrSize ->+        withIOVec cs $ \(iovsPtr, iovsLen) -> do+          let msgHdr = MsgHdr+                addrPtr (fromIntegral addrSize)+                iovsPtr (fromIntegral iovsLen)+          with msgHdr $ \msgHdrPtr ->+            throwSocketErrorIfMinus1RetryMayBlock "sendmsg"+              (threadWaitWrite (fromIntegral fd)) $+              c_sendmsg (fromIntegral fd) msgHdrPtr 0+#else+sendManyTo sock cs = sendAllTo sock (B.concat cs)+#endif++-- ----------------------------------------------------------------------------+-- Receiving++-- | 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.+--+-- For TCP sockets, a zero length return value means the peer has+-- closed its half side of the connection.+recv :: Socket         -- ^ Connected socket+     -> Int            -- ^ Maximum number of bytes to receive+     -> IO ByteString  -- ^ Data received+recv (MkSocket s _ _ _ _) nbytes+    | nbytes < 0 = ioError (mkInvalidRecvArgError "Network.Socket.ByteString.recv")+    | otherwise  = createAndTrim nbytes $ recvInner s nbytes++recvInner :: CInt -> Int -> Ptr Word8 -> IO Int+recvInner s nbytes ptr =+    fmap fromIntegral $+#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS)+#  if __GLASGOW_HASKELL__ >= 611+        readRawBufferPtr "Network.Socket.ByteString.recv" (FD s 1) ptr 0 (fromIntegral nbytes)+#  else+        readRawBufferPtr "Network.Socket.ByteString.recv" (fromIntegral s)+        True (castPtr ptr) 0 (fromIntegral nbytes)+#  endif+#else+#  if !defined(__HUGS__)+        throwSocketErrorIfMinus1RetryMayBlock "recv"+        (threadWaitRead (fromIntegral s)) $+#  endif+        c_recv s (castPtr ptr) (fromIntegral nbytes) 0+#endif++-- | Receive data from the socket.  The socket need not be in a+-- connected state.  Returns @(bytes, address)@ where @bytes@ is a+-- 'ByteString' representing the data received and @address@ is a+-- 'SockAddr' representing the address of the sending socket.+recvFrom :: Socket                     -- ^ Socket+         -> Int                        -- ^ Maximum number of bytes to receive+         -> IO (ByteString, SockAddr)  -- ^ Data received and sender address+recvFrom sock nbytes =+    allocaBytes nbytes $ \ptr -> do+        (len, sockaddr) <- recvBufFrom sock ptr nbytes+        str <- B.packCStringLen (ptr, len)+        return (str, sockaddr)++-- ----------------------------------------------------------------------------+-- Not exported++#if !defined(mingw32_HOST_OS)+-- | Suppose we try to transmit a list of chunks @cs@ via a gathering write+-- operation and find that @n@ bytes were sent. Then @remainingChunks n cs@ is+-- list of chunks remaining to be sent.+remainingChunks :: Int -> [ByteString] -> [ByteString]+remainingChunks _ [] = []+remainingChunks i (x:xs)+    | i < len        = B.drop i x : xs+    | otherwise      = let i' = i - len in i' `seq` remainingChunks i' xs+  where+    len = B.length x++-- | @totalLength cs@ is the sum of the lengths of the chunks in the list @cs@.+totalLength :: [ByteString] -> Int+totalLength = sum . map B.length++-- | @withIOVec 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/.+withIOVec :: [ByteString] -> ((Ptr IOVec, Int) -> IO a) -> IO a+withIOVec cs f =+    allocaArray csLen $ \aPtr -> do+        zipWithM_ pokeIov (ptrs aPtr) cs+        f (aPtr, csLen)+  where+    csLen = length cs+    ptrs = iterate (`plusPtr` sizeOf (undefined :: IOVec))+    pokeIov ptr s =+        unsafeUseAsCStringLen s $ \(sPtr, sLen) ->+        poke ptr $ IOVec sPtr (fromIntegral sLen)+#endif++-- ---------------------------------------------------------------------+-- Example++-- $example+--+-- Here are two minimal example programs using the TCP/IP protocol: a+-- server that echoes all data that it receives back (servicing only+-- one client) and a client using it.+--+-- > -- Echo server program+-- > module Main where+-- >+-- > import Control.Monad (unless)+-- > import Network.Socket hiding (recv)+-- > import qualified Data.ByteString as S+-- > import Network.Socket.ByteString (recv, sendAll)+-- >+-- > main :: IO ()+-- > main = withSocketsDo $+-- >     do addrinfos <- getAddrInfo+-- >                     (Just (defaultHints {addrFlags = [AI_PASSIVE]}))+-- >                     Nothing (Just "3000")+-- >        let serveraddr = head addrinfos+-- >        sock <- socket (addrFamily serveraddr) Stream defaultProtocol+-- >        bindSocket sock (addrAddress serveraddr)+-- >        listen sock 1+-- >        (conn, _) <- accept sock+-- >        talk conn+-- >        sClose conn+-- >        sClose sock+-- >+-- >     where+-- >       talk :: Socket -> IO ()+-- >       talk conn =+-- >           do msg <- recv conn 1024+-- >              unless (S.null msg) $ sendAll conn msg >> talk conn+--+-- > -- Echo client program+-- > module Main where+-- >+-- > import Network.Socket hiding (recv)+-- > import Network.Socket.ByteString (recv, sendAll)+-- > import qualified Data.ByteString.Char8 as C+-- >+-- > main :: IO ()+-- > main = withSocketsDo $+-- >     do addrinfos <- getAddrInfo Nothing (Just "") (Just "3000")+-- >        let serveraddr = head addrinfos+-- >        sock <- socket (addrFamily serveraddr) Stream defaultProtocol+-- >        connect sock (addrAddress serveraddr)+-- >        sendAll sock $ C.pack "Hello, world!"+-- >        msg <- recv sock 1024+-- >        sClose sock+-- >        putStr "Received "+-- >        C.putStrLn msg
+ Network/Socket/ByteString/IOVec.hsc view
@@ -0,0 +1,28 @@+-- | Support module for the POSIX writev system call.+module Network.Socket.ByteString.IOVec+  ( IOVec(..)+  ) where++import Foreign.C.Types (CChar, CInt, CSize)+import Foreign.Ptr (Ptr)+import Foreign.Storable (Storable(..))++#include <sys/uio.h>++data IOVec = IOVec+    { iovBase :: Ptr CChar+    , iovLen  :: CSize+    }++instance Storable IOVec where+  sizeOf _    = (#const sizeof(struct iovec))+  alignment _ = alignment (undefined :: CInt)++  peek p = do+    base <- (#peek struct iovec, iov_base) p+    len  <- (#peek struct iovec, iov_len)  p+    return $ IOVec base len++  poke p iov = do+    (#poke struct iovec, iov_base) p (iovBase iov)+    (#poke struct iovec, iov_len)  p (iovLen  iov)
+ Network/Socket/ByteString/Internal.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}++module Network.Socket.ByteString.Internal+  ( mkInvalidRecvArgError+#if !defined(mingw32_HOST_OS)+  , c_writev+  , c_sendmsg+#endif+  ) where++import System.IO.Error (ioeSetErrorString, mkIOError)++#if !defined(mingw32_HOST_OS)+import Foreign.C.Types (CInt)+import Foreign.Ptr (Ptr)+import System.Posix.Types (CSsize)++import Network.Socket.ByteString.IOVec (IOVec)+import Network.Socket.ByteString.MsgHdr (MsgHdr)+#endif++#ifdef __GLASGOW_HASKELL__+# if __GLASGOW_HASKELL__ < 611+import GHC.IOBase (IOErrorType(..))+# else+import GHC.IO.Exception (IOErrorType(..))+# endif+#elif __HUGS__+import Hugs.Prelude (IOErrorType(..))+#endif++mkInvalidRecvArgError :: String -> IOError+mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError+#ifdef __GLASGOW_HASKELL__+                                    InvalidArgument+#else+                                    IllegalOperation+#endif+                                    loc Nothing Nothing) "non-positive length"++#if !defined(mingw32_HOST_OS)+foreign import ccall unsafe "writev"+  c_writev :: CInt -> Ptr IOVec -> CInt -> IO CSsize++foreign import ccall unsafe "sendmsg"+  c_sendmsg :: CInt -> Ptr MsgHdr -> CInt -> IO CSsize+#endif
Network/Socket/ByteString/Lazy.hsc view
@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, PackageImports #-}+{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface #-}  -- | -- Module      : Network.Socket.ByteString.Lazy@@ -34,4 +34,120 @@       recv   ) where -import "network" Network.Socket.ByteString+import Control.Monad (liftM)+import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)+import Data.Int (Int64)+import Network.Socket (Socket(..), ShutdownCmd(..), shutdown)+import Prelude hiding (getContents)+import System.IO.Unsafe (unsafeInterleaveIO)++import qualified Data.ByteString as S+import qualified Network.Socket.ByteString as N++#if !defined(mingw32_HOST_OS)+import Control.Monad (unless)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Foreign.Marshal.Array (allocaArray)+import Foreign.Ptr (plusPtr)+import Foreign.Storable (Storable(..))+import Network.Socket.ByteString.IOVec (IOVec(IOVec))+import Network.Socket.ByteString.Internal (c_writev)+import Network.Socket.Internal (throwSocketErrorIfMinus1RetryMayBlock)++import qualified Data.ByteString.Lazy as L++#  if defined(__GLASGOW_HASKELL__)+import GHC.Conc (threadWaitWrite)+#  endif+#endif++#if !defined(mingw32_HOST_OS)+-- -----------------------------------------------------------------------------+-- Sending++-- | Send data to the socket. The socket must be in a connected state.+-- Returns the number of bytes sent. Applications are responsible for+-- ensuring that all data has been sent.+--+-- Because a lazily generated 'ByteString' may be arbitrarily long,+-- this function caps the amount it will attempt to send at 4MB.  This+-- number is large (so it should not penalize performance on fast+-- networks), but not outrageously so (to avoid demanding lazily+-- computed data unnecessarily early).  Before being sent, the lazy+-- 'ByteString' will be converted to a list of strict 'ByteString's+-- with 'L.toChunks'; at most 1024 chunks will be sent.  /Unix only/.+send :: Socket      -- ^ Connected socket+     -> ByteString  -- ^ Data to send+     -> IO Int64    -- ^ Number of bytes sent+send (MkSocket fd _ _ _ _) s = do+  let cs  = take maxNumChunks (L.toChunks s)+      len = length cs+  liftM fromIntegral . allocaArray len $ \ptr ->+    withPokes cs ptr $ \niovs ->+#  if !defined(__HUGS__)+      throwSocketErrorIfMinus1RetryMayBlock "writev"+        (threadWaitWrite (fromIntegral fd)) $+#  endif+        c_writev (fromIntegral fd) ptr niovs+  where+    withPokes ss p f = loop ss p 0 0+      where loop (c:cs) q k !niovs+                | k < maxNumBytes =+                    unsafeUseAsCStringLen c $ \(ptr,len) -> do+                      poke q $ IOVec ptr (fromIntegral len)+                      loop cs (q `plusPtr` sizeOf (undefined :: IOVec))+                              (k + fromIntegral len) (niovs + 1)+                | otherwise = f niovs+            loop _ _ _ niovs = f niovs+    maxNumBytes  = 4194304 :: Int  -- maximum number of bytes to transmit in one system call+    maxNumChunks = 1024    :: Int  -- maximum number of chunks to transmit in one system call++-- | Send data to the socket.  The socket must be in a connected+-- state. This function continues to send data until either all data+-- has been sent or an error occurs.  If there is an error, an+-- exception is raised, and there is no way to determine how much data+-- was sent.  /Unix only/.+sendAll :: Socket      -- ^ Connected socket+        -> ByteString  -- ^ Data to send+        -> IO ()+sendAll sock bs = do+  sent <- send sock bs+  let bs' = L.drop sent bs+  unless (L.null bs') $ sendAll sock bs'+#endif++-- -----------------------------------------------------------------------------+-- Receiving++-- | Receive data from the socket.  The socket must be in a connected+-- state.  Data is received on demand, in chunks; each chunk will be+-- sized to reflect the amount of data received by individual 'recv'+-- calls.+--+-- All remaining data from the socket is consumed.  When there is no+-- more data to be received, the receiving side of the socket is shut+-- down.  If there is an error and an exception is thrown, the socket+-- is not shut down.+getContents :: Socket         -- ^ Connected socket+            -> IO ByteString  -- ^ Data received+getContents sock = loop where+  loop = unsafeInterleaveIO $ do+    s <- N.recv sock defaultChunkSize+    if S.null s+      then shutdown sock ShutdownReceive >> return Empty+      else Chunk s `liftM` loop++-- | Receive data from the socket.  The socket must be in a connected+-- state.  This function may return fewer bytes than specified.  If+-- the received data is longer than the specified length, it may be+-- discarded depending on the type of socket.  This function may block+-- until a message arrives.+--+-- If there is no more data to be received, returns an empty 'ByteString'.+recv :: Socket         -- ^ Connected socket+     -> Int64          -- ^ Maximum number of bytes to receive+     -> IO ByteString  -- ^ Data received+recv sock nbytes = chunk `liftM` N.recv sock (fromIntegral nbytes) where+  chunk k+    | S.null k  = Empty+    | otherwise = Chunk k Empty
+ Network/Socket/ByteString/MsgHdr.hsc view
@@ -0,0 +1,42 @@+{-# LANGUAGE CPP #-}++-- | Support module for the POSIX 'sendmsg' system call.+module Network.Socket.ByteString.MsgHdr+  ( MsgHdr(..)+  ) where++#include <sys/types.h>+#include <sys/socket.h>++import Foreign.C.Types (CInt, CSize)+import Foreign.Ptr (Ptr)+import Foreign.Storable (Storable(..))+import Network.Socket (SockAddr)++import Network.Socket.ByteString.IOVec (IOVec)++-- We don't use msg_control, msg_controllen, and msg_flags as these+-- don't exist on OpenSolaris.+data MsgHdr = MsgHdr+    { msgName    :: Ptr SockAddr+    , msgNameLen :: CSize+    , msgIov     :: Ptr IOVec+    , msgIovLen  :: CSize+    }++instance Storable MsgHdr where+  sizeOf _    = (#const sizeof(struct msghdr))+  alignment _ = alignment (undefined :: CInt)++  peek p = do+    name       <- (#peek struct msghdr, msg_name)       p+    nameLen    <- (#peek struct msghdr, msg_namelen)    p+    iov        <- (#peek struct msghdr, msg_iov)        p+    iovLen     <- (#peek struct msghdr, msg_iovlen)     p+    return $ MsgHdr name nameLen iov iovLen++  poke p mh = do+    (#poke struct msghdr, msg_name)       p (msgName       mh)+    (#poke struct msghdr, msg_namelen)    p (msgNameLen    mh)+    (#poke struct msghdr, msg_iov)        p (msgIov        mh)+    (#poke struct msghdr, msg_iovlen)     p (msgIovLen     mh)
network-bytestring.cabal view
@@ -1,5 +1,5 @@ name:                network-bytestring-version:             0.1.3.3+version:             0.1.3.4 synopsis:            Fast, memory-efficient, low-level networking description:         Fast, memory-efficient, low-level socket functions                      that use 'Data.ByteString's instead of 'String's.@@ -17,11 +17,22 @@   exposed-modules:     Network.Socket.ByteString     Network.Socket.ByteString.Lazy+  other-modules:+    Network.Socket.ByteString.Internal +  if !os(windows)+    other-modules:+      Network.Socket.ByteString.IOVec+      Network.Socket.ByteString.MsgHdr+   build-depends:     base       < 4.4,     bytestring < 1.0,-    network    >= 2.3 && < 2.4+    network    >= 2.2.1.1 && < 2.3++  if !os(windows)+    build-depends:+      unix >= 2 && < 3    extensions: CPP, ForeignFunctionInterface   ghc-options: -Wall