Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge network and network-bytestring repos

  • Loading branch information...
commit 64407cdb9a8db680bb4339dfbf078cf0dcd3badb 2 parents bd7b43d + 50d5c7e
@tibbe tibbe authored
View
16 .gitignore
@@ -0,0 +1,16 @@
+*.hi
+*.o
+*~
+.hpc/*
+Setup
+Setup.exe*
+TAGS
+autom4te.cache/*
+config.log
+config.mk
+config.status
+configure
+dist/*
+include/HsNetworkConfig.h
+include/HsNetworkConfig.h.in
+network.buildinfo
View
12 LICENSE
@@ -1,21 +1,19 @@
-The Glasgow Haskell Compiler License
-
-Copyright 2002, The University Court of the University of Glasgow.
-All rights reserved.
+Copyright 2002, The University Court of the University of Glasgow.
+Copyright 2007, Johan Tibell
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
- Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
-
+
- Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
-
+
- Neither name of the University nor the names of its contributors may be
used to endorse or promote products derived from this software without
-specific prior written permission.
+specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
View
383 Network/Socket/ByteString.hs
@@ -0,0 +1,383 @@
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
+
+-- |
+-- Module : Network.Socket.ByteString
+-- Copyright : (c) Johan Tibell 2007
+-- License : BSD-style
+--
+-- Maintainer : johan.tibell@gmail.com
+-- Stability : experimental
+-- Portability : portable
+--
+-- This module provides access to the BSD /socket/ interface. This
+-- module is generally more efficient than the 'String' based network
+-- functions in 'Network.Socket'. For detailed documentation, consult
+-- your favorite POSIX socket reference. All functions communicate
+-- failures by converting the error number to 'System.IO.IOError'.
+--
+-- This module is made to be imported with 'Network.Socket' like so:
+--
+-- > import Network.Socket hiding (send, sendTo, recv, recvFrom)
+-- > import Network.Socket.ByteString
+--
+module Network.Socket.ByteString
+ ( -- * Send data to a socket
+ send
+ , sendAll
+ , sendTo
+ , sendAllTo
+
+ -- ** Vectored I/O
+ -- $vectored
+ , sendMany
+ , sendManyTo
+
+ -- * Receive data from a socket
+ , recv
+ , recvFrom
+
+ -- * Example
+ -- $example
+ ) where
+
+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
View
28 Network/Socket/ByteString/IOVec.hsc
@@ -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)
View
47 Network/Socket/ByteString/Internal.hs
@@ -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
View
153 Network/Socket/ByteString/Lazy.hsc
@@ -0,0 +1,153 @@
+{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface #-}
+
+-- |
+-- Module : Network.Socket.ByteString.Lazy
+-- Copyright : (c) Bryan O'Sullivan 2009
+-- License : BSD-style
+--
+-- Maintainer : bos@serpentine.com
+-- Stability : experimental
+-- Portability : POSIX, GHC
+--
+-- This module provides access to the BSD /socket/ interface. This
+-- module is generally more efficient than the 'String' based network
+-- functions in 'Network.Socket'. For detailed documentation, consult
+-- your favorite POSIX socket reference. All functions communicate
+-- failures by converting the error number to 'System.IO.IOError'.
+--
+-- This module is made to be imported with 'Network.Socket' like so:
+--
+-- > import Network.Socket hiding (send, sendTo, recv, recvFrom)
+-- > import Network.Socket.ByteString.Lazy
+-- > import Prelude hiding (getContents)
+--
+module Network.Socket.ByteString.Lazy
+ (
+#if !defined(mingw32_HOST_OS)
+ -- * Send data to a socket
+ send,
+ sendAll,
+#endif
+
+ -- * Receive data from a socket
+ getContents,
+ recv
+ ) where
+
+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
View
42 Network/Socket/ByteString/MsgHdr.hsc
@@ -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)
View
15 Setup.hs
@@ -1,6 +1,17 @@
module Main (main) where
-import Distribution.Simple
+import Control.Monad (unless)
+import Distribution.Simple (defaultMainWithHooks, runTests, simpleUserHooks)
+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
+import Distribution.Simple.Utils (die)
+import System.Cmd (system)
+import System.Directory (doesDirectoryExist)
main :: IO ()
-main = defaultMainWithHooks defaultUserHooks
+main = defaultMainWithHooks $ simpleUserHooks { runTests = runTests' }
+ where
+ runTests' _ _ _ lbi = do
+ built <- doesDirectoryExist $ buildDir lbi
+ unless built $ die "Run the 'build' command first."
+ system "runhaskell -i./dist/build tests/Simple.hs"
+ return ()
View
18 examples/EchoClient.hs
@@ -0,0 +1,18 @@
+-- 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
View
27 examples/EchoServer.hs
@@ -0,0 +1,27 @@
+-- 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
View
33 network.cabal
@@ -1,9 +1,10 @@
name: network
-version: 2.2.1.10
+version: 2.2.2.10
license: BSD3
license-file: LICENSE
maintainer: Johan Tibell <johan.tibell@gmail.com>
-synopsis: Networking-related facilities
+synopsis: Low-level networking interface
+description: Low-level networking interface
category: Network
build-type: Configure
cabal-version: >=1.6
@@ -11,6 +12,7 @@ extra-tmp-files:
config.log config.status autom4te.cache
network.buildinfo include/HsNetworkConfig.h
extra-source-files:
+ README examples/*.hs tests/*.hs
config.guess config.sub install-sh
configure.ac configure
network.buildinfo.in include/HsNetworkConfig.h.in
@@ -18,15 +20,36 @@ extra-source-files:
-- C sources only used on some systems
cbits/ancilData.c
cbits/asyncAccept.c cbits/initWinSock.c cbits/winSockErr.c
+homepage: http://github.com/haskell/network
bug-reports: http://trac.haskell.org/network/
flag base4
library
exposed-modules:
- Network Network.BSD Network.Socket.Internal Network.Socket
- Network.URI
- build-depends: base < 5, parsec
+ Network
+ Network.BSD
+ Network.Socket
+ Network.Socket.ByteString
+ Network.Socket.ByteString.Lazy
+ Network.Socket.Internal
+ Network.URI
+ other-modules:
+ Network.Socket.ByteString.Internal
+
+ if !os(windows)
+ other-modules:
+ Network.Socket.ByteString.IOVec
+ Network.Socket.ByteString.MsgHdr
+
+ build-depends:
+ base < 5,
+ bytestring < 1.0,
+ parsec
+
+ if !os(windows)
+ build-depends:
+ unix >= 2 && < 3
if flag(base4)
build-depends: base >= 4 && < 4.4
View
141 tests/Simple.hs
@@ -0,0 +1,141 @@
+module Main where
+
+import Control.Concurrent (forkIO)
+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
+import Control.Exception (bracket)
+import Control.Monad (when)
+import Network.Socket hiding (recv, recvFrom, send)
+import System.Exit (exitFailure)
+import Test.HUnit (Counts(..), Test(..), (@=?), runTestTT)
+
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Char8 as C
+import qualified Data.ByteString.Lazy.Char8 as L
+
+import Network.Socket.ByteString (recv, recvFrom, send, sendAll, sendMany)
+import qualified Network.Socket.ByteString.Lazy as NSBL
+
+------------------------------------------------------------------------
+
+port :: PortNumber
+port = fromIntegral (3000 :: Int)
+
+testMsg :: S.ByteString
+testMsg = C.pack "This is a test message."
+
+testLazySend :: Test
+testLazySend = TestCase $ connectedTest client server
+ where
+ server sock = recv sock 1024 >>= (@=?) (C.take 1024 strictTestMsg)
+ client sock = NSBL.send sock lazyTestMsg >>= (@=?) 1024
+
+ -- message containing too many chunks to be sent in one system call
+ lazyTestMsg = let alphabet = map C.singleton ['a'..'z']
+ in L.fromChunks (concat (replicate 100 alphabet))
+
+ strictTestMsg = C.concat . L.toChunks $ lazyTestMsg
+
+------------------------------------------------------------------------
+-- Tests
+
+testSendAll :: Test
+testSendAll = TestCase $ connectedTest client server
+ where
+ server sock = recv sock 1024 >>= (@=?) testMsg
+ client sock = sendAll sock testMsg
+
+testSendMany :: Test
+testSendMany = TestCase $ connectedTest client server
+ where
+ server sock = recv sock 1024 >>= (@=?) (S.append seg1 seg2)
+ client sock = sendMany sock [seg1, seg2]
+
+ seg1 = C.pack "This is a "
+ seg2 = C.pack "test message."
+
+testRecv :: Test
+testRecv = TestCase $ connectedTest client server
+ where
+ server sock = recv sock 1024 >>= (@=?) testMsg
+ client sock = send sock testMsg
+
+testOverFlowRecv :: Test
+testOverFlowRecv = TestCase $ connectedTest client server
+ where
+ server sock = do seg1 <- recv sock (S.length testMsg - 3)
+ seg2 <- recv sock 1024
+ let msg = S.append seg1 seg2
+ testMsg @=? msg
+
+ client sock = send sock testMsg
+
+testRecvFrom :: Test
+testRecvFrom = TestCase $ connectedTest client server
+ where
+ server sock = do (msg, _) <- recvFrom sock 1024
+ testMsg @=? msg
+
+ client sock = send sock testMsg
+
+testOverFlowRecvFrom :: Test
+testOverFlowRecvFrom = TestCase $ connectedTest client server
+ where
+ server sock = do (seg1, _) <- recvFrom sock (S.length testMsg - 3)
+ (seg2, _) <- recvFrom sock 1024
+ let msg = S.append seg1 seg2
+ testMsg @=? msg
+
+ client sock = send sock testMsg
+
+------------------------------------------------------------------------
+-- Test helpers
+
+-- | Run a client/server pair and synchronize them so that the server
+-- is started before the client and the specified server action is
+-- finished before the client closes the connection.
+connectedTest :: (Socket -> IO a) -> (Socket -> IO b) -> IO ()
+connectedTest clientAct serverAct = do
+ barrier <- newEmptyMVar
+ forkIO $ server barrier
+ client barrier
+ where
+ server barrier = do
+ addr <- inet_addr "127.0.0.1"
+ bracket (socket AF_INET Stream defaultProtocol) sClose $ \sock -> do
+ setSocketOption sock ReuseAddr 1
+ bindSocket sock (SockAddrInet port addr)
+ listen sock 1
+ serverReady
+ (clientSock, _) <- accept sock
+ serverAct clientSock
+ sClose clientSock
+ putMVar barrier ()
+ where
+ -- | Signal to the client that it can proceed.
+ serverReady = putMVar barrier ()
+
+ client barrier = do
+ takeMVar barrier
+ bracket (socket AF_INET Stream defaultProtocol) sClose $ \sock -> do
+ addr <- inet_addr "127.0.0.1"
+ connect sock $ SockAddrInet port addr
+ clientAct sock
+ takeMVar barrier
+
+------------------------------------------------------------------------
+-- Test harness
+
+main :: IO ()
+main = withSocketsDo $ do
+ counts <- runTestTT tests
+ when (errors counts + failures counts > 0) exitFailure
+
+tests :: Test
+tests = TestList [ TestLabel "testLazySend" testLazySend
+ , TestLabel "testSendAll" testSendMany
+ , TestLabel "testSendMany" testSendMany
+ , TestLabel "testRecv" testRecv
+ , TestLabel "testOverFlowRecv" testOverFlowRecv
+ , TestLabel "testRecvFrom" testRecvFrom
+ , TestLabel "testOverFlowRecvFrom" testOverFlowRecvFrom
+ ]
Please sign in to comment.
Something went wrong with that request. Please try again.