{-# LINE 1 "Network/Socket/ByteString/IO.hsc" #-}{-# LANGUAGE BangPatterns #-}{-# LANGUAGE RecordWildCards #-}{-# LANGUAGE OverloadedStrings #-}-- |-- Module : Network.Socket.ByteString.IO-- Copyright : (c) Johan Tibell 2007-2010-- License : BSD-style---- Maintainer : johan.tibell@gmail.com-- Stability : stable-- Portability : portable--moduleNetwork.Socket.ByteString.IO(-- * Send data to a socketsend,sendAll,sendTo,sendAllTo-- ** Vectored I/O-- $vectored,sendMany,sendManyTo-- * Receive data from a socket,recv,recvFrom,waitWhen0-- * Advanced send and recv,sendMsg,recvMsg,MsgFlag(..),Cmsg(..))whereimportControl.Concurrent(threadWaitWrite,rtsSupportsBoundThreads)importData.ByteString(ByteString)importqualifiedData.ByteStringasBimportData.ByteString.Internal(createAndTrim)importData.ByteString.Unsafe(unsafeUseAsCStringLen)importForeign.Marshal.Alloc(allocaBytes)importNetwork.Socket.BufferimportNetwork.Socket.ByteString.InternalimportNetwork.Socket.ImportsimportNetwork.Socket.TypesimportData.ByteString.Internal(create,ByteString(..))importForeign.ForeignPtr(withForeignPtr)importForeign.Marshal.Utils(with)importNetwork.Socket.InternalimportNetwork.Socket.Flag{-# LINE 61 "Network/Socket/ByteString/IO.hsc" #-}importNetwork.Socket.Posix.CmsgimportNetwork.Socket.Posix.IOVecimportNetwork.Socket.Posix.MsgHdr(MsgHdr(..)){-# LINE 70 "Network/Socket/ByteString/IO.hsc" #-}-- ------------------------------------------------------------------------------ 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->IOInt-- ^ Number of bytes sentsendsxs=unsafeUseAsCStringLenxs$\(str,len)->sendBufs(castPtrstr)lenwaitWhen0::Int->Socket->IO()waitWhen00s=whenrtsSupportsBoundThreads$withFdSockets$\fd->threadWaitWrite$fromIntegralfdwaitWhen0__=return()-- | 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_""=return()sendAllsbs0=loopbs0whereloopbs=do-- "send" throws an exception.sent<-sendsbswaitWhen0sentswhen(sent/=B.lengthbs)$loop$B.dropsentbs-- | 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::SocketAddresssa=>Socket-- ^ Socket->ByteString-- ^ Data to send->sa-- ^ Recipient address->IOInt-- ^ Number of bytes sentsendTosxssa=unsafeUseAsCStringLenxs$\(str,len)->sendBufTosstrlensa-- | 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::SocketAddresssa=>Socket-- ^ Socket->ByteString-- ^ Data to send->sa-- ^ Recipient address->IO()sendAllTo_""_=return()sendAllTosbs0sa=loopbs0whereloopbs=do-- "send" throws an exception.sent<-sendTosbssawaitWhen0sentswhen(sent/=B.lengthbs)$loop$B.dropsentbs-- | 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()sendMany_[]=return()sendManyscs=dosent<-sendManyInnerwaitWhen0sentswhen(sent>=0)$sendManys$remainingChunkssentcswheresendManyInner={-# LINE 154 "Network/Socket/ByteString/IO.hsc" #-}fmapfromIntegral.withIOVecfromBScs$\(iovsPtr,iovsLen)->withFdSockets$\fd->doletlen=fromIntegral$miniovsLen(1024){-# LINE 157 "Network/Socket/ByteString/IO.hsc" #-}throwSocketErrorWaitWrites"Network.Socket.ByteString.sendMany"$c_writevfdiovsPtrlen{-# LINE 168 "Network/Socket/ByteString/IO.hsc" #-}-- | 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()sendManyTo_[]_=return()sendManyToscsaddr=dosent<-fromIntegral<$>sendManyToInnerwaitWhen0sentswhen(sent>=0)$sendManyTos(remainingChunkssentcs)addrwheresendManyToInner=withSockAddraddr$\addrPtraddrSize->{-# LINE 188 "Network/Socket/ByteString/IO.hsc" #-}withIOVecfromBScs$\(iovsPtr,iovsLen)->doletmsgHdr=MsgHdr{msgName=addrPtr,msgNameLen=fromIntegraladdrSize,msgIov=iovsPtr,msgIovLen=fromIntegraliovsLen,msgCtrl=nullPtr,msgCtrlLen=0,msgFlags=0}withFdSockets$\fd->withmsgHdr$\msgHdrPtr->throwSocketErrorWaitWrites"Network.Socket.ByteString.sendManyTo"$c_sendmsgfdmsgHdrPtr0{-# LINE 220 "Network/Socket/ByteString/IO.hsc" #-}-- ------------------------------------------------------------------------------ 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->IOByteString-- ^ Data receivedrecvsnbytes|nbytes<0=ioError(mkInvalidRecvArgError"Network.Socket.ByteString.recv")|otherwise=createAndTrimnbytes$\ptr->recvBufsptrnbytes-- | 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.---- If the first return value is zero, it means EOF.recvFrom::SocketAddresssa=>Socket-- ^ Socket->Int-- ^ Maximum number of bytes to receive->IO(ByteString,sa)-- ^ Data received and sender addressrecvFromsocknbytes=allocaBytesnbytes$\ptr->do(len,sockaddr)<-recvBufFromsockptrnbytesstr<-B.packCStringLen(ptr,len)return(str,sockaddr)-- ------------------------------------------------------------------------------ Not exported-- | 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_[]=[]remainingChunksi(x:xs)|i<len=B.dropix:xs|otherwise=leti'=i-lenini'`seq`remainingChunksi'xswherelen=B.lengthx{-# LINE 274 "Network/Socket/ByteString/IO.hsc" #-}-- | @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]->((PtrIOVec,Int)->IOa)->IOawithIOVecfromBScsf=withBufSizscs$\bufsizs->withIOVecbufsizsf{-# LINE 288 "Network/Socket/ByteString/IO.hsc" #-}withBufSizs::[ByteString]->([(PtrWord8,Int)]->IOa)->IOawithBufSizsbss0f=loopbss0idwhereloop[]!build=f$build[]loop(PSfptrofflen:bss)!build=withForeignPtrfptr$\ptr->dolet!ptr'=ptr`plusPtr`offloopbss(build.((ptr',len):))-- | Send data to the socket using sendmsg(2).sendMsg::Socket-- ^ Socket->SockAddr-- ^ Destination address->[ByteString]-- ^ Data to be sent->[Cmsg]-- ^ Control messages->MsgFlag-- ^ Message flags->IOInt-- ^ The length actually sentsendMsg__[]__=return0sendMsgsaddrbsscmsgsflags=withBufSizsbss$\bufsizs->sendBufMsgsaddrbufsizscmsgsflags-- | Receive data from the socket using recvmsg(2).recvMsg::Socket-- ^ Socket->Int-- ^ The maximum length of data to be received-- 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(SockAddr,ByteString,[Cmsg],MsgFlag)-- ^ Source address, received data, control messages and message flagsrecvMsgssizclenflags=dobs@(PSfptr__)<-createsiz$\ptr->zeroMemoryptr(fromIntegralsiz)withForeignPtrfptr$\ptr->do(addr,len,cmsgs,flags')<-recvBufMsgs[(ptr,siz)]clenflagsletbs'|len<siz=PSfptr0len|otherwise=bsreturn(addr,bs',cmsgs,flags')