network-msg (empty) → 0.1
raw patch · 9 files changed
+392/−0 lines, 9 filesdep +basedep +bytestringdep +networksetup-changed
Dependencies added: base, bytestring, network, unix
Files
- LICENSE +13/−0
- Network/Socket/Msg.hs +114/−0
- Network/Socket/Msg/CMsg.hsc +107/−0
- Network/Socket/Msg/IOVec.hsc +29/−0
- Network/Socket/Msg/Internal.hs +18/−0
- Network/Socket/Msg/MsgHdr.hsc +52/−0
- Setup.hs +3/−0
- cbits/cmsg.c +22/−0
- network-msg.cabal +34/−0
+ LICENSE view
@@ -0,0 +1,13 @@+ DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE+ Version 2, December 2004++Copyright (C) 2004 Sam Hocevar <sam@hocevar.net>++Everyone is permitted to copy and distribute verbatim or modified+copies of this license document, and changing it is allowed as long+as the name is changed.++ DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. You just DO WHAT THE FUCK YOU WANT TO.
+ Network/Socket/Msg.hs view
@@ -0,0 +1,114 @@+module Network.Socket.Msg (CMsg(..),sendMsg,recvMsg) where++import Network.Socket.Msg.CMsg+import Network.Socket.Msg.Internal+import Network.Socket.Msg.IOVec+import Network.Socket.Msg.MsgHdr++import Control.Applicative+import qualified Data.ByteString as B+import Data.Maybe (isNothing, fromJust)+import Network.Socket+import Network.Socket.Internal (peekSockAddr,pokeSockAddr,sizeOfSockAddr,throwSocketErrorWaitRead,throwSocketErrorWaitWrite)+import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.Storable (Storable(..),poke)+import Foreign.Ptr (Ptr,plusPtr,nullPtr)++isNullPtr :: Ptr a -> Bool+isNullPtr = (==) nullPtr++{-+The buffer in both functions is filled as follows:+-------------+| Data (sz) |+-------------+| SockAddr |+-------------+| IOVec |+-------------+| MsgHdr |+-------------+| Aux Data |+-------------+-}++-- |Sends the data contained in the bytestring to the specified address.+-- The last argument is a list of control parameters (see cmsg(3) for details).+sendMsg :: Socket -> B.ByteString -> SockAddr -> [CMsg] -> IO ()+sendMsg sock@(MkSocket sockfd _ _ _ _) bytes sa cmsgs = allocaBytes bufSz $ \bufPtr -> do+ let saPtr = plusPtr bufPtr $ B.length bytes+ let iovPtr = plusPtr saPtr $ sizeOfSockAddr sa+ let msgPtr = plusPtr iovPtr $ sizeOf (undefined :: IOVec)+ let auxPtr = plusPtr msgPtr $ sizeOf (undefined :: MsgHdr)++ let iovec = IOVec bufPtr (fromIntegral $ B.length bytes)+ let msghdr = MsgHdr { msgName = saPtr+ , msgNameLen = fromIntegral $ sizeOfSockAddr sa+ , msgIov = iovPtr+ , msgIovLen = 1+ , msgControl = auxPtr+ , msgControlLen = fromIntegral auxSz+ , msgFlags = 0 }+ pokeCMsgs auxPtr cmsgs+ pokeSockAddr saPtr sa+ poke msgPtr msghdr+ poke iovPtr iovec+ + _ <-+# if !defined(__HUGS__) + throwSocketErrorWaitWrite sock "sendMsg" $+# endif+ c_sendmsg sockfd msgPtr 0+ return ()+ where+ auxSz = sum $ map cmsgSpace cmsgs+ bufSz = sum [auxSz, sizeOfSockAddr sa, B.length bytes, sizeOf (undefined :: MsgHdr), sizeOf (undefined :: IOVec)]+ pokeCMsgs :: Ptr CMsgHdr -> [CMsg] -> IO ()+ pokeCMsgs _ [] = return ()+ pokeCMsgs ptr (c:cs) = pokeCMsg ptr c >> pokeCMsgs (plusPtr ptr $ cmsgSpace c) cs++-- |Receive data and put it into a bytestring.+recvMsg :: Socket -> Int -> IO (B.ByteString, SockAddr, [CMsg])+recvMsg sock@(MkSocket sockfd _ _ _ _) sz = allocaBytes bufSz $ \bufPtr -> do+ let addrPtr = plusPtr bufPtr addrSz+ let iovPtr = plusPtr addrPtr sz+ let mhdrPtr = plusPtr iovPtr (sizeOf (undefined :: IOVec))+ let auxPtr = plusPtr mhdrPtr (sizeOf (undefined :: MsgHdr))++ let iov = IOVec bufPtr (fromIntegral sz)+ let msghdr = MsgHdr { msgName = addrPtr + , msgNameLen = fromIntegral addrSz+ , msgIov = iovPtr+ , msgIovLen = 1+ , msgControl = auxPtr+ , msgControlLen = fromIntegral auxSz+ , msgFlags = 0 }+ poke iovPtr iov+ poke mhdrPtr msghdr++ rsz <- fmap fromIntegral (+# if !defined(__HUGS__) + throwSocketErrorWaitRead sock "recvMsg" $+# endif+ c_recvmsg sockfd mhdrPtr 0)+ (,,) <$> B.packCStringLen (bufPtr,rsz)+ <*> peekSockAddr addrPtr+ <*> extractCMsgs mhdrPtr+ where+ -- Assume that 1024 bytes is enough for auxillary data+ auxSz = 1024+ -- Reserve 16 bytes for peer address+ addrSz = 16+ bufSz = sum [sz, auxSz, addrSz, sizeOf (undefined :: MsgHdr), sizeOf (undefined :: IOVec)]++extractCMsgs :: Ptr MsgHdr -> IO [CMsg]+extractCMsgs pMsg = extractCMsgs' (c_cmsg_firsthdr pMsg) []+ where+ extractCMsgs' pCMsg resList+ | isNullPtr pCMsg = return resList+ | otherwise = do+ cmsg <- peekCMsg pCMsg+ extractCMsgs' (c_cmsg_nexthdr pMsg pCMsg)+ (if isNothing cmsg+ then resList+ else (fromJust cmsg):resList)
+ Network/Socket/Msg/CMsg.hsc view
@@ -0,0 +1,107 @@+{-# LANGUAGE ForeignFunctionInterface #-}++module Network.Socket.Msg.CMsg+ ( CSockLen+ , CMsg(..)+ , CMsgHdr(..)+ , c_cmsg_firsthdr+ , c_cmsg_nexthdr+ , c_cmsg_data+ , cmsgSpace+ , peekCMsg+ , pokeCMsg+ ) where++#include <sys/types.h>+#include <sys/socket.h>++import Network.Socket.Msg.MsgHdr (MsgHdr)++import qualified Data.ByteString as B+import Data.Maybe (isNothing,fromJust)+import Foreign.C.Types (CUInt(..),CInt(..),CSize(..))+import Foreign.Marshal.Utils (copyBytes)+import Foreign.Ptr (Ptr,castPtr,nullPtr)+import Foreign.Storable (Storable(..))++type CSockLen = CUInt -- The way it is defined somewhere in bits/types.h++data CMsg = CMsg+ { cmsgLevel :: Int+ , cmsgType :: Int+ , cmsgData :: B.ByteString+ }++instance Show CMsg where+ show cmsg = concat ["(",+ "Level: ", show $ cmsgLevel cmsg, ", ",+ "Type: ", show $ cmsgType cmsg, ", ",+ "Data: ", show $ cmsgData cmsg, ")"]++data CMsgHdr = CMsgHdr+ { cmsgLen :: CSockLen+ , cmsghdrLevel :: CInt+ , cmsghdrType :: CInt+ }++instance Storable CMsgHdr where+ sizeOf _ = (#const sizeof(struct cmsghdr))+ alignment _ = alignment (undefined :: CInt)++ peek p = do+ len <- (#peek struct cmsghdr, cmsg_len) p+ level <- (#peek struct cmsghdr, cmsg_level) p+ t <- (#peek struct cmsghdr, cmsg_type) p+ return $ CMsgHdr len level t++ poke p cmh = do+ (#poke struct cmsghdr, cmsg_len) p (cmsgLen cmh)+ (#poke struct cmsghdr, cmsg_level) p (cmsghdrLevel cmh)+ (#poke struct cmsghdr, cmsg_type) p (cmsghdrType cmh)++-- The manual says the following functions (actually macros)+-- are constant and thus we do not have to use IO monad.++foreign import ccall unsafe "cmsg_firsthdr"+ c_cmsg_firsthdr :: Ptr MsgHdr -> Ptr CMsgHdr++foreign import ccall unsafe "cmsg_nexthdr"+ c_cmsg_nexthdr :: Ptr MsgHdr -> Ptr CMsgHdr -> Ptr CMsgHdr++foreign import ccall unsafe "cmsg_data"+ c_cmsg_data :: Ptr CMsgHdr -> Ptr ()++foreign import ccall unsafe "cmsg_space"+ c_cmsg_space :: CSize -> CSize++cmsgSpace :: CMsg -> Int+cmsgSpace = spc . B.length . cmsgData+ where spc = fromIntegral . c_cmsg_space . fromIntegral++cmsgExtractData :: Ptr CMsgHdr -> IO (Maybe B.ByteString)+cmsgExtractData p = do+ let dataPtr = castPtr $ c_cmsg_data p+ dataLen <- return . cmsgLen =<< peek p+ if dataPtr == nullPtr+ then return Nothing+ else return.Just =<< B.packCStringLen (dataPtr, fromIntegral dataLen)++peekCMsg :: Ptr CMsgHdr -> IO (Maybe CMsg)+peekCMsg pCMsgHdr =+ peek pCMsgHdr >>= \cmsghdr ->+ cmsgExtractData pCMsgHdr >>= \dat ->+ return $ if isNothing dat+ then Nothing+ else Just CMsg { cmsgLevel = fromIntegral $ cmsghdrLevel cmsghdr+ , cmsgType = fromIntegral $ cmsghdrType cmsghdr+ , cmsgData = fromJust dat }++pokeCMsg :: Ptr CMsgHdr -> CMsg -> IO ()+pokeCMsg pHdr cmsg = do+ poke pHdr cmsghdr+ let dptr = castPtr $ c_cmsg_data pHdr+ B.useAsCStringLen (cmsgData cmsg) $ \(bptr,len) -> copyBytes dptr bptr len+ where+ cmsghdr = CMsgHdr { cmsgLen = fromIntegral $ B.length $ cmsgData cmsg+ , cmsghdrLevel = fromIntegral $ cmsgLevel cmsg+ , cmsghdrType = fromIntegral $ cmsgType cmsg }
+ Network/Socket/Msg/IOVec.hsc view
@@ -0,0 +1,29 @@+-- This file was copied from network-bytestring package.+-- Original source: https://github.com/tibbe/network-bytestring/blob/master/Network/Socket/ByteString/IOVec.hsc+module Network.Socket.Msg.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/Msg/Internal.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE ForeignFunctionInterface #-}++module Network.Socket.Msg.Internal+ ( c_sendmsg+ , c_recvmsg+ ) where++import Network.Socket.Msg.MsgHdr (MsgHdr)++import Foreign.C.Types (CInt(..))+import Foreign.Ptr (Ptr)+import System.Posix.Types (CSsize(..))++foreign import ccall unsafe "sendmsg"+ c_sendmsg :: CInt -> Ptr MsgHdr -> CInt -> IO CSsize++foreign import ccall unsafe "recvmsg"+ c_recvmsg :: CInt -> Ptr MsgHdr -> CInt -> IO CSsize
+ Network/Socket/Msg/MsgHdr.hsc view
@@ -0,0 +1,52 @@+{-# LANGUAGE CPP #-}++-- | Support module for the POSIX 'sendmsg,recvmsg' system calls.+-- This file was copied from network-bytestring package.+-- Original source: https://github.com/tibbe/network-bytestring/blob/master/Network/Socket/ByteString/MsgHdr.hsc++module Network.Socket.Msg.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.Msg.IOVec (IOVec)++data MsgHdr = MsgHdr+ { msgName :: Ptr SockAddr+ , msgNameLen :: CSize+ , msgIov :: Ptr IOVec+ , msgIovLen :: CSize+ , msgControl :: Ptr ()+ , msgControlLen :: CSize+ , msgFlags :: CInt+ }++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+ control <- (#peek struct msghdr, msg_control) p+ controlLen <- (#peek struct msghdr, msg_controllen) p+ flags <- (#peek struct msghdr, msg_flags) p+ return $ MsgHdr name nameLen iov iovLen control controlLen flags++ 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)+ (#poke struct msghdr, msg_control) p (msgControl mh)+ (#poke struct msghdr, msg_controllen) p (msgControlLen mh)+ (#poke struct msghdr, msg_flags) p (msgFlags mh)
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ cbits/cmsg.c view
@@ -0,0 +1,22 @@+#include <sys/types.h>+#include <sys/socket.h>++struct cmsghdr *cmsg_firsthdr(struct msghdr *msgh)+{+ return CMSG_FIRSTHDR(msgh);+}++struct cmsghdr *cmsg_nexthdr(struct msghdr *msgh, struct cmsghdr *cmsg)+{+ return CMSG_NXTHDR(msgh,cmsg);+}++void *cmsg_data(struct cmsghdr *cmsg)+{+ return (void*)CMSG_DATA(cmsg);+}++size_t cmsg_space(size_t len)+{+ return CMSG_SPACE(len);+}
+ network-msg.cabal view
@@ -0,0 +1,34 @@+name: network-msg+version: 0.1+category: Network+build-type: Simple +cabal-version: >= 1.6+maintainer: Lana Black <sickmind@i2pmail.org>+license: OtherLicense +license-file: LICENSE+synopsis: Recvmsg and sendmsg bindings.+description: Bindings to sendmsg and recvmsg POSIX functions.++library+ exposed-modules:+ Network.Socket.Msg+ other-modules:+ Network.Socket.Msg.Internal+ Network.Socket.Msg.CMsg+ Network.Socket.Msg.IOVec+ Network.Socket.Msg.MsgHdr++ c-sources: cbits/cmsg.c++ build-depends:+ base >= 4 && < 5,+ bytestring,+ network,+ unix++ extensions: CPP, ForeignFunctionInterface+ ghc-options: -Wall -fwarn-tabs++source-repository head+ type: git+ location: git://bitbucket.org/braindamaged/network-msg.git