network-msg 0.1 → 0.2

raw patch · 5 files changed

+201/−98 lines, 5 filesdep +binaryPVP ok

version bump matches the API change (PVP)

Dependencies added: binary

API changes (from Hackage documentation)

Files

• Network/Socket/Msg.hs +18/−15
• Network/Socket/Msg/CMsg.hsc +57/−81
• Network/Socket/Msg/CMsgHdr.hsc +117/−0
• cbits/cmsg.c +5/−0
• network-msg.cabal +4/−2

@@ -1,18 +1,26 @@-module Network.Socket.Msg (CMsg(..),sendMsg,recvMsg) where+module Network.Socket.Msg+    ( CMsg(..)+    , CMsgable (..)+    , filterCMsgs+    , sendMsg+    , recvMsg+    ) where  import Network.Socket.Msg.CMsg+import Network.Socket.Msg.CMsgHdr import Network.Socket.Msg.Internal import Network.Socket.Msg.IOVec import Network.Socket.Msg.MsgHdr  import Control.Applicative+import Control.Monad (void) 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)+import Foreign.Ptr (Ptr,castPtr,plusPtr,nullPtr)  isNullPtr :: Ptr a -> Bool isNullPtr = (==) nullPtr@@ -36,12 +44,11 @@ -- 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 saPtr = castPtr bufPtr         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@@ -49,23 +56,19 @@                             , msgControl = auxPtr                             , msgControlLen = fromIntegral auxSz                             , msgFlags = 0 }-        pokeCMsgs auxPtr cmsgs-        pokeSockAddr saPtr sa         poke msgPtr msghdr-        poke iovPtr iovec-        -        _ <-+        pokeCMsgs msgPtr cmsgs+        pokeSockAddr saPtr sa++        void $ # if !defined(__HUGS__)              throwSocketErrorWaitWrite sock "sendMsg" $ # endif-                c_sendmsg sockfd msgPtr 0-        return ()+                B.useAsCStringLen bytes $ \(p,len) ->+                    poke iovPtr (IOVec p $ fromIntegral len) >> c_sendmsg sockfd msgPtr 0     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+        bufSz = sum [auxSz, sizeOfSockAddr sa, sizeOf (undefined :: MsgHdr), sizeOf (undefined :: IOVec)]  -- |Receive data and put it into a bytestring. recvMsg :: Socket -> Int -> IO (B.ByteString, SockAddr, [CMsg])

@@ -1,30 +1,23 @@-{-# LANGUAGE ForeignFunctionInterface #-}-+{-# LANGUAGE CPP,ScopedTypeVariables #-} module Network.Socket.Msg.CMsg-    ( CSockLen-    , CMsg(..)-    , CMsgHdr(..)-    , c_cmsg_firsthdr-    , c_cmsg_nexthdr-    , c_cmsg_data-    , cmsgSpace-    , peekCMsg-    , pokeCMsg+    ( CMsg(..)+    , CMsgable(..)+    , filterCMsgs+#ifdef IP_PKTINFO+    , IpPktInfo(..)+#endif     ) where -#include <sys/types.h> #include <sys/socket.h>--import Network.Socket.Msg.MsgHdr (MsgHdr)+#include <netinet/in.h> +import Control.Applicative+import Data.Binary+import Data.Binary.Get (getWord32host)+import Data.Binary.Put (putWord32host) 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+import Data.ByteString.Lazy (fromStrict,toStrict)+import Network.Socket (HostAddress)  data CMsg = CMsg     { cmsgLevel :: Int@@ -38,70 +31,53 @@                         "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+-- |Class for binary structures that can be used as control messages (cmsg(3)).+-- +-- Complete definition requires for a type to be an instance of Binary class,+-- as well as to provide getCMsgLevel and getCMsgType methods.+--+-- Note that the argument of getCMsgLevel and getCMsgType methods should not+-- be used as it might be undefined.+class Binary a => CMsgable a where+    getCMsgLevel    :: a -> Int+    getCMsgType     :: a -> Int -foreign import ccall unsafe "cmsg_nexthdr"-  c_cmsg_nexthdr :: Ptr MsgHdr -> Ptr CMsgHdr -> Ptr CMsgHdr+    toCMsg :: a -> CMsg+    toCMsg x = CMsg { cmsgLevel = getCMsgLevel x+                    , cmsgType = getCMsgType x+                    , cmsgData = toStrict $ encode x } -foreign import ccall unsafe "cmsg_data"-  c_cmsg_data :: Ptr CMsgHdr -> Ptr ()+    -- XXX: Find a way to check type and level values in here+    fromCMsg :: CMsg -> Maybe a+    fromCMsg cmsg = case decodeOrFail (fromStrict $ cmsgData cmsg) of+                        Left _ -> Nothing+                        Right (_,_,x) -> Just x -foreign import ccall unsafe "cmsg_space"-  c_cmsg_space :: CSize -> CSize+-- |Filter specific kind of control messages.+-- +-- Example: filterCMsgs (undefined :: IpPktInfo) cmsgs+filterCMsgs :: (CMsgable a) => a -> [CMsg] -> [CMsg]+filterCMsgs x = filter $ \c -> (cmsgType c == getCMsgType x) && (cmsgLevel c == getCMsgLevel x) -cmsgSpace :: CMsg -> Int-cmsgSpace = spc . B.length . cmsgData-    where spc = fromIntegral . c_cmsg_space . fromIntegral+#ifdef IP_PKTINFO+data IpPktInfo = IpPktInfo+    { ipi_ifindex   :: Word32+    , ipi_spec_dst  :: HostAddress+    , ipi_addr      :: HostAddress+    } deriving (Show) -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)+instance Binary IpPktInfo where+    put i = do+        -- XXX: Assume that sizeof(int) == 4+        putWord32host $ ipi_ifindex i+        putWord32host $ ipi_spec_dst i+        putWord32host $ ipi_addr i+    get = IpPktInfo <$> getWord32host+                    <*> getWord32host+                    <*> getWord32host -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 }+instance CMsgable IpPktInfo where+    getCMsgLevel    _ = #const IPPROTO_IP+    getCMsgType     _ = #const IP_PKTINFO -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 }+# endif

@@ -0,0 +1,117 @@+{-# LANGUAGE ForeignFunctionInterface #-}++module Network.Socket.Msg.CMsgHdr+    ( CSockLen+    , CMsg(..)+    , CMsgHdr(..)+    , c_cmsg_firsthdr+    , c_cmsg_nexthdr+    , c_cmsg_data+    , cmsgSpace+    , peekCMsg+    , pokeCMsg+    , pokeCMsgs+    ) where++#include <sys/types.h>+#include <sys/socket.h>++import Network.Socket.Msg.CMsg (CMsg(..))+import Network.Socket.Msg.MsgHdr (MsgHdr(..))++import Control.Applicative+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 CMsgHdr = CMsgHdr+    { cmsghdrLen       :: 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 (cmsghdrLen 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++foreign import ccall unsafe "cmsg_len"+  c_cmsg_len :: CSize -> CSize++cmsgSpace :: CMsg -> Int+cmsgSpace = spc . B.length . cmsgData+    where spc = fromIntegral . c_cmsg_space . fromIntegral++cmsgLen :: CMsg -> Int+cmsgLen = len . B.length . cmsgData+    where len = fromIntegral . c_cmsg_len . fromIntegral++cmsgExtractData :: Ptr CMsgHdr -> IO (Maybe B.ByteString)+cmsgExtractData p = do+    let dataPtr = castPtr $ c_cmsg_data p+    dataLen <- cmsghdrLen <$> 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 { cmsghdrLen = fromIntegral $ cmsgLen cmsg+                          , cmsghdrLevel = fromIntegral $ cmsgLevel cmsg+                          , cmsghdrType = fromIntegral $ cmsgType cmsg }++pokeCMsgs :: Ptr MsgHdr -> [CMsg] -> IO ()+pokeCMsgs pMsg cmsgs = do+        msg <- peek pMsg+        cLen <- pokeCMsgs' (c_cmsg_firsthdr pMsg) cmsgs+        poke pMsg $ msg { msgControlLen = fromIntegral cLen }+    where+        pokeCMsgs' :: Ptr CMsgHdr -> [CMsg] -> IO Int+        pokeCMsgs' _ [] = return 0+        pokeCMsgs' pCMsg (c:cs) = do+                pokeCMsg pCMsg c+                ((+)$cmsgSpace c) <$> pokeCMsgs' (c_cmsg_nexthdr pMsg pCMsg) cs

@@ -20,3 +20,8 @@ {     return CMSG_SPACE(len); }++size_t cmsg_len(size_t len)+{+    return CMSG_LEN(len);+}

@@ -1,5 +1,5 @@ name: network-msg-version: 0.1+version: 0.2 category: Network build-type: Simple  cabal-version: >= 1.6@@ -12,9 +12,10 @@ library   exposed-modules:     Network.Socket.Msg+    Network.Socket.Msg.CMsg   other-modules:     Network.Socket.Msg.Internal-    Network.Socket.Msg.CMsg+    Network.Socket.Msg.CMsgHdr     Network.Socket.Msg.IOVec     Network.Socket.Msg.MsgHdr @@ -22,6 +23,7 @@    build-depends:     base >= 4 && < 5,+    binary,     bytestring,     network,     unix