1{-# LANGUAGE RecordWildCards #-} 2{-# LANGUAGE OverloadedStrings #-} 3 4#include "HsNet.h" 5 6-- | 7-- Module : Network.Socket.ByteString 8-- Copyright : (c) Johan Tibell 2007-2010 9-- License : BSD-style 10-- 11-- Maintainer : johan.tibell@gmail.com 12-- Stability : stable 13-- Portability : portable 14-- 15-- This module provides access to the BSD /socket/ interface. This 16-- module is generally more efficient than the 'String' based network 17-- functions in 'Network.Socket'. For detailed documentation, consult 18-- your favorite POSIX socket reference. All functions communicate 19-- failures by converting the error number to 'System.IO.IOError'. 20-- 21-- This module is made to be imported with 'Network.Socket' like so: 22-- 23-- > import Network.Socket hiding (send, sendTo, recv, recvFrom) 24-- > import Network.Socket.ByteString 25-- 26module Network.Socket.ByteString.IO 27 ( 28 -- * Send data to a socket 29 send 30 , sendAll 31 , sendTo 32 , sendAllTo 33 34 -- ** Vectored I/O 35 -- $vectored 36 , sendMany 37 , sendManyTo 38 39 -- * Receive data from a socket 40 , recv 41 , recvFrom 42 , waitWhen0 43 ) where 44 45import Control.Concurrent (threadWaitWrite, rtsSupportsBoundThreads) 46import Data.ByteString (ByteString) 47import qualified Data.ByteString as B 48import Data.ByteString.Internal (createAndTrim) 49import Data.ByteString.Unsafe (unsafeUseAsCStringLen) 50import Foreign.Marshal.Alloc (allocaBytes) 51import Foreign.Ptr (castPtr) 52 53import Network.Socket.Buffer 54import Network.Socket.ByteString.Internal 55import Network.Socket.Imports 56import Network.Socket.Types 57 58#if !defined(mingw32_HOST_OS) 59import Control.Monad (zipWithM_) 60import Foreign.Marshal.Array (allocaArray) 61import Foreign.Marshal.Utils (with) 62import Foreign.Ptr (Ptr, plusPtr) 63import Foreign.Storable (Storable(..)) 64import Network.Socket.Internal 65 66import Network.Socket.ByteString.IOVec (IOVec(..)) 67import Network.Socket.ByteString.MsgHdr (MsgHdr(..)) 68#endif 69 70-- ---------------------------------------------------------------------------- 71-- Sending 72 73-- | Send data to the socket. The socket must be connected to a 74-- remote socket. Returns the number of bytes sent. Applications are 75-- responsible for ensuring that all data has been sent. 76send :: Socket -- ^ Connected socket 77 -> ByteString -- ^ Data to send 78 -> IO Int -- ^ Number of bytes sent 79send s xs = unsafeUseAsCStringLen xs $ \(str, len) -> 80 sendBuf s (castPtr str) len 81 82waitWhen0 :: Int -> Socket -> IO () 83waitWhen0 0 s = when rtsSupportsBoundThreads $ 84 withFdSocket s $ \fd -> threadWaitWrite $ fromIntegral fd 85waitWhen0 _ _ = return () 86 87-- | Send data to the socket. The socket must be connected to a 88-- remote socket. Unlike 'send', this function continues to send data 89-- until either all data has been sent or an error occurs. On error, 90-- an exception is raised, and there is no way to determine how much 91-- data, if any, was successfully sent. 92sendAll :: Socket -- ^ Connected socket 93 -> ByteString -- ^ Data to send 94 -> IO () 95sendAll _ "" = return () 96sendAll s bs = do 97 sent <- send s bs 98 waitWhen0 sent s 99 when (sent >= 0) $ sendAll s $ B.drop sent bs 100 101-- | Send data to the socket. The recipient can be specified 102-- explicitly, so the socket need not be in a connected state. 103-- Returns the number of bytes sent. Applications are responsible for 104-- ensuring that all data has been sent. 105sendTo :: SocketAddress sa => 106 Socket -- ^ Socket 107 -> ByteString -- ^ Data to send 108 -> sa -- ^ Recipient address 109 -> IO Int -- ^ Number of bytes sent 110sendTo s xs sa = 111 unsafeUseAsCStringLen xs $ \(str, len) -> sendBufTo s str len sa 112 113-- | Send data to the socket. The recipient can be specified 114-- explicitly, so the socket need not be in a connected state. Unlike 115-- 'sendTo', this function continues to send data until either all 116-- data has been sent or an error occurs. On error, an exception is 117-- raised, and there is no way to determine how much data, if any, was 118-- successfully sent. 119sendAllTo :: SocketAddress sa => 120 Socket -- ^ Socket 121 -> ByteString -- ^ Data to send 122 -> sa -- ^ Recipient address 123 -> IO () 124sendAllTo _ "" _ = return () 125sendAllTo s xs sa = do 126 sent <- sendTo s xs sa 127 waitWhen0 sent s 128 when (sent >= 0) $ sendAllTo s (B.drop sent xs) sa 129 130-- | Send data to the socket. The socket must be in a connected 131-- state. The data is sent as if the parts have been concatenated. 132-- This function continues to send data until either all data has been 133-- sent or an error occurs. On error, an exception is raised, and 134-- there is no way to determine how much data, if any, was 135-- successfully sent. 136sendMany :: Socket -- ^ Connected socket 137 -> [ByteString] -- ^ Data to send 138 -> IO () 139#if !defined(mingw32_HOST_OS) 140sendMany _ [] = return () 141sendMany s cs = do 142 sent <- sendManyInner 143 waitWhen0 sent s 144 when (sent >= 0) $ sendMany s $ remainingChunks sent cs 145 where 146 sendManyInner = 147 fmap fromIntegral . withIOVec cs $ \(iovsPtr, iovsLen) -> 148 withFdSocket s $ \fd -> do 149 let len = fromIntegral $ min iovsLen (#const IOV_MAX) 150 throwSocketErrorWaitWrite s "Network.Socket.ByteString.sendMany" $ 151 c_writev fd iovsPtr len 152#else 153sendMany s = sendAll s . B.concat 154#endif 155 156-- | Send data to the socket. The recipient can be specified 157-- explicitly, so the socket need not be in a connected state. The 158-- data is sent as if the parts have been concatenated. This function 159-- continues to send data until either all data has been sent or an 160-- error occurs. On error, an exception is raised, and there is no 161-- way to determine how much data, if any, was successfully sent. 162sendManyTo :: Socket -- ^ Socket 163 -> [ByteString] -- ^ Data to send 164 -> SockAddr -- ^ Recipient address 165 -> IO () 166#if !defined(mingw32_HOST_OS) 167sendManyTo _ [] _ = return () 168sendManyTo s cs addr = do 169 sent <- fromIntegral <$> sendManyToInner 170 waitWhen0 sent s 171 when (sent >= 0) $ sendManyTo s (remainingChunks sent cs) addr 172 where 173 sendManyToInner = 174 withSockAddr addr $ \addrPtr addrSize -> 175 withIOVec cs $ \(iovsPtr, iovsLen) -> do 176 let msgHdr = MsgHdr 177 addrPtr (fromIntegral addrSize) 178 iovsPtr (fromIntegral iovsLen) 179 withFdSocket s $ \fd -> 180 with msgHdr $ \msgHdrPtr -> 181 throwSocketErrorWaitWrite s "Network.Socket.ByteString.sendManyTo" $ 182 c_sendmsg fd msgHdrPtr 0 183#else 184sendManyTo s cs = sendAllTo s (B.concat cs) 185#endif 186 187-- ---------------------------------------------------------------------------- 188-- Receiving 189 190-- | Receive data from the socket. The socket must be in a connected 191-- state. This function may return fewer bytes than specified. If 192-- the message is longer than the specified length, it may be 193-- discarded depending on the type of socket. This function may block 194-- until a message arrives. 195-- 196-- Considering hardware and network realities, the maximum number of bytes to 197-- receive should be a small power of 2, e.g., 4096. 198-- 199-- For TCP sockets, a zero length return value means the peer has 200-- closed its half side of the connection. 201recv :: Socket -- ^ Connected socket 202 -> Int -- ^ Maximum number of bytes to receive 203 -> IO ByteString -- ^ Data received 204recv s nbytes 205 | nbytes < 0 = ioError (mkInvalidRecvArgError "Network.Socket.ByteString.recv") 206 | otherwise = createAndTrim nbytes $ \ptr -> recvBuf s ptr nbytes 207 208-- | Receive data from the socket. The socket need not be in a 209-- connected state. Returns @(bytes, address)@ where @bytes@ is a 210-- 'ByteString' representing the data received and @address@ is a 211-- 'SockAddr' representing the address of the sending socket. 212-- 213-- If the first return value is zero, it means EOF. 214recvFrom :: SocketAddress sa => 215 Socket -- ^ Socket 216 -> Int -- ^ Maximum number of bytes to receive 217 -> IO (ByteString, sa) -- ^ Data received and sender address 218recvFrom sock nbytes = 219 allocaBytes nbytes $ \ptr -> do 220 (len, sockaddr) <- recvBufFrom sock ptr nbytes 221 str <- B.packCStringLen (ptr, len) 222 return (str, sockaddr) 223 224-- ---------------------------------------------------------------------------- 225-- Not exported 226 227#if !defined(mingw32_HOST_OS) 228-- | Suppose we try to transmit a list of chunks @cs@ via a gathering write 229-- operation and find that @n@ bytes were sent. Then @remainingChunks n cs@ is 230-- list of chunks remaining to be sent. 231remainingChunks :: Int -> [ByteString] -> [ByteString] 232remainingChunks _ [] = [] 233remainingChunks i (x:xs) 234 | i < len = B.drop i x : xs 235 | otherwise = let i' = i - len in i' `seq` remainingChunks i' xs 236 where 237 len = B.length x 238 239-- | @withIOVec cs f@ executes the computation @f@, passing as argument a pair 240-- consisting of a pointer to a temporarily allocated array of pointers to 241-- IOVec made from @cs@ and the number of pointers (@length cs@). 242-- /Unix only/. 243withIOVec :: [ByteString] -> ((Ptr IOVec, Int) -> IO a) -> IO a 244withIOVec cs f = 245 allocaArray csLen $ \aPtr -> do 246 zipWithM_ pokeIov (ptrs aPtr) cs 247 f (aPtr, csLen) 248 where 249 csLen = length cs 250 ptrs = iterate (`plusPtr` sizeOf (undefined :: IOVec)) 251 pokeIov ptr s = 252 unsafeUseAsCStringLen s $ \(sPtr, sLen) -> 253 poke ptr $ IOVec sPtr (fromIntegral sLen) 254#endif 255