network-multicast 0.0.12 → 0.3.2
raw patch · 5 files changed
Files
- ChangeLog +9/−0
- examples/receiver.hs +5/−3
- examples/sender.hs +6/−4
- network-multicast.cabal +6/−6
- src/Network/Multicast.hsc +27/−10
+ ChangeLog view
@@ -0,0 +1,9 @@+# 0.3.2+- Restore compatibility with network-2.0++# 0.3.1+- Fix [build errors](https://github.com/commercialhaskell/stackage/issues/4589)++# 0.3.0+- Fix compatibility with network-3.0+
examples/receiver.hs view
@@ -1,11 +1,13 @@-import Network.Socket (withSocketsDo, recvFrom)+import Network.Socket (withSocketsDo)+import qualified Data.ByteString.Char8 as C+import Network.Socket.ByteString (recvFrom) import Network.Multicast main :: IO () main = withSocketsDo $ do sock <- multicastReceiver "224.0.0.99" 9999 let loop = do- (msg, _, addr) <- recvFrom sock 1024- putStrLn $ "Recv [" ++ show addr ++ "]: " ++ msg+ (msg, addr) <- recvFrom sock 1024+ putStrLn $ "Recv [" ++ show addr ++ "]: " ++ C.unpack msg loop loop
examples/sender.hs view
@@ -1,15 +1,17 @@-import Network.Socket (withSocketsDo, sendTo)+import Network.Socket (withSocketsDo)+import Network.Socket.ByteString (sendTo)+import qualified Data.ByteString.Char8 as C import Network.Multicast -import System.Time (getClockTime)+import Data.Time.Clock (getCurrentTime) import Control.Concurrent (threadDelay) main :: IO () main = withSocketsDo $ do (sock, addr) <- multicastSender "224.0.0.99" 9999 let loop = do- msg <- fmap show getClockTime- sendTo sock msg addr+ msg <- fmap show getCurrentTime+ sendTo sock (C.pack msg) addr putStrLn $ "Send [" ++ show addr ++ "]: " ++ msg threadDelay 100000 loop
network-multicast.cabal view
@@ -1,10 +1,10 @@ name: network-multicast-version: 0.0.12-copyright: 2008-2014 Audrey Tang+version: 0.3.2+copyright: 2008-2019 Audrey Tang license: PublicDomain license-file: LICENSE author: Audrey Tang <audreyt@audreyt.org>-maintainer: Audrey Tang <audreyt@audreyt.org>+maintainer: Marco Zocca synopsis: Simple multicast library description: The "Network.Multicast" module is for sending UDP datagrams over multicast (class D) addresses.@@ -12,12 +12,12 @@ build-type: Simple category: Network cabal-version: >= 1.6-extra-source-files: examples/sender.hs examples/receiver.hs+extra-source-files: examples/sender.hs examples/receiver.hs ChangeLog library- extensions: ForeignFunctionInterface, CPP+ extensions: ForeignFunctionInterface, CPP, FlexibleInstances exposed-modules: Network.Multicast- build-depends: base >= 4 && < 5, network+ build-depends: base >= 4 && < 5, network, network-bsd hs-source-dirs: src if os(win32) extra-libraries: ws2_32
src/Network/Multicast.hsc view
@@ -31,6 +31,7 @@ import Foreign.Marshal import Foreign.Ptr import Control.Exception (bracketOnError)+import Data.Word (Word32) type TimeToLive = Int type LoopbackMode = Bool@@ -39,6 +40,9 @@ enableLoopback = True noLoopback = False +inet_addr :: HostName -> IO HostAddress+inet_addr = fmap hostAddress . getHostByName+ -- | Calling 'multicastSender' creates a client side UDP socket for sending -- multicast datagrams to the specified host and port. --@@ -54,7 +58,7 @@ -- multicastSender :: HostName -> PortNumber -> IO (Socket, SockAddr) multicastSender host port = do- addr <- fmap (SockAddrInet port) (inet_addr host)+ addr <- fmap (SockAddrInet port) (Network.Multicast.inet_addr host) proto <- getProtocolNumber "udp" sock <- socket AF_INET Datagram proto return (sock, addr)@@ -73,7 +77,7 @@ -- > print (msg, addr) in loop -- multicastReceiver :: HostName -> PortNumber -> IO Socket-multicastReceiver host port = bracketOnError get sClose setup+multicastReceiver host port = bracketOnError get close setup where get :: IO Socket get = do@@ -88,14 +92,25 @@ #endif setup :: Socket -> IO Socket setup sock = do- bindSocket sock $ SockAddrInet port iNADDR_ANY+ bind sock $ SockAddrInet port Network.Multicast.iNADDR_ANY addMembership sock host Nothing return sock +iNADDR_ANY :: HostAddress+iNADDR_ANY = Network.Multicast.htonl 0++-- | Converts the from host byte order to network byte order.+foreign import ccall unsafe "htonl" htonl :: Word32 -> Word32++class IOCompat f where ioCompat :: f -> (Socket -> IO CInt)+instance IOCompat (Socket -> IO CInt) where ioCompat = id+instance IOCompat (Socket -> CInt) where ioCompat = (return .)+ doSetSocketOption :: Storable a => CInt -> Socket -> a -> IO CInt-doSetSocketOption ip_multicast_option (MkSocket s _ _ _ _) x = alloca $ \ptr -> do+doSetSocketOption ip_multicast_option sock x = alloca $ \ptr -> do poke ptr x- c_setsockopt s _IPPROTO_IP ip_multicast_option (castPtr ptr) (toEnum $ sizeOf x)+ fd <- (ioCompat fdSocket) sock+ c_setsockopt fd _IPPROTO_IP ip_multicast_option (castPtr ptr) (toEnum $ sizeOf x) -- | Enable or disable the loopback mode on a socket created by 'multicastSender'. -- Loopback is enabled by default; disabling it may improve performance a little bit.@@ -113,7 +128,7 @@ -- | Set the outgoing interface address of the multicast. setInterface :: Socket -> HostName -> IO () setInterface sock host = maybeIOError "setInterface" $ do- addr <- inet_addr host+ addr <- Network.Multicast.inet_addr host doSetSocketOption _IP_MULTICAST_IF sock addr -- | Make the socket listen on multicast datagrams sent by the specified 'HostName'.@@ -130,14 +145,15 @@ _ -> ioError (errnoToIOError name (Errno (fromIntegral err)) Nothing Nothing) doMulticastGroup :: CInt -> Socket -> HostName -> Maybe HostName -> IO CInt-doMulticastGroup flag (MkSocket s _ _ _ _) host local = allocaBytes #{size struct ip_mreq} $ \mReqPtr -> do- addr <- inet_addr host+doMulticastGroup flag sock host local = allocaBytes #{size struct ip_mreq} $ \mReqPtr -> do+ addr <- Network.Multicast.inet_addr host iface <- case local of Nothing -> return (#{const INADDR_ANY} `asTypeOf` addr)- Just loc -> inet_addr loc+ Just loc -> Network.Multicast.inet_addr loc #{poke struct ip_mreq, imr_multiaddr} mReqPtr addr #{poke struct ip_mreq, imr_interface} mReqPtr iface- c_setsockopt s _IPPROTO_IP flag (castPtr mReqPtr) (#{size struct ip_mreq})+ fd <- (ioCompat fdSocket) sock+ c_setsockopt fd _IPPROTO_IP flag (castPtr mReqPtr) (#{size struct ip_mreq}) #ifdef mingw32_HOST_OS foreign import stdcall unsafe "setsockopt"@@ -175,3 +191,4 @@ _IPPROTO_IP :: CInt _IPPROTO_IP = #const IPPROTO_IP+