network-multicast-0.1.1/0000755000000000000000000000000012720307572013400 5ustar0000000000000000network-multicast-0.1.1/LICENSE0000644000000000000000000000032312720307572014403 0ustar0000000000000000To the extent possible under law, 唐鳳 has waived all copyright and related or neighboring rights to network-multicast. This work is published from Taiwan. network-multicast-0.1.1/network-multicast.cabal0000644000000000000000000000167712720307572020073 0ustar0000000000000000name: network-multicast version: 0.1.1 copyright: 2008-2016 Audrey Tang license: PublicDomain license-file: LICENSE author: Audrey Tang maintainer: Audrey Tang synopsis: Simple multicast library description: The "Network.Multicast" module is for sending UDP datagrams over multicast (class D) addresses. stability: experimental build-type: Simple category: Network cabal-version: >= 1.6 extra-source-files: examples/sender.hs examples/receiver.hs library extensions: ForeignFunctionInterface, CPP exposed-modules: Network.Multicast build-depends: base >= 4 && < 5, network hs-source-dirs: src if os(win32) extra-libraries: ws2_32 source-repository head type: git location: http://github.com/audreyt/network-multicast network-multicast-0.1.1/Setup.lhs0000644000000000000000000000016012720307572015205 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain network-multicast-0.1.1/examples/0000755000000000000000000000000012720307572015216 5ustar0000000000000000network-multicast-0.1.1/examples/receiver.hs0000644000000000000000000000046012720307572017356 0ustar0000000000000000import Network.Socket (withSocketsDo, 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 loop loop network-multicast-0.1.1/examples/sender.hs0000644000000000000000000000066012720307572017034 0ustar0000000000000000import Network.Socket (withSocketsDo, sendTo) import Network.Multicast import System.Time (getClockTime) 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 putStrLn $ "Send [" ++ show addr ++ "]: " ++ msg threadDelay 100000 loop loop network-multicast-0.1.1/src/0000755000000000000000000000000012720307572014167 5ustar0000000000000000network-multicast-0.1.1/src/Network/0000755000000000000000000000000012720307572015620 5ustar0000000000000000network-multicast-0.1.1/src/Network/Multicast.hsc0000644000000000000000000001412612720307572020270 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Network.Multicast -- Copyright : (c) Audrey Tang 2008 -- License : MIT License -- -- Maintainer : audreyt@audreyt.org -- Stability : experimental -- Portability : portable -- -- The "Network.Multicast" module is for sending UDP datagrams over multicast -- (class D) addresses. -- ----------------------------------------------------------------------------- #include module Network.Multicast ( -- * Simple sending and receiving multicastSender, multicastReceiver -- * Additional Socket operations , addMembership, dropMembership , setLoopbackMode, setTimeToLive, setInterface -- * Socket options , TimeToLive, LoopbackMode, enableLoopback, noLoopback ) where import Network.BSD import Network.Socket import Foreign.C.Types import Foreign.C.Error import Foreign.Storable import Foreign.Marshal import Foreign.Ptr import Control.Exception (bracketOnError) type TimeToLive = Int type LoopbackMode = Bool enableLoopback, noLoopback :: LoopbackMode enableLoopback = True noLoopback = False -- | Calling 'multicastSender' creates a client side UDP socket for sending -- multicast datagrams to the specified host and port. -- -- Minimal example: -- -- > import Network.Socket -- > import Network.Multicast -- > main = withSocketsDo $ do -- > (sock, addr) <- multicastSender "224.0.0.99" 9999 -- > let loop = do -- > sendTo sock "Hello, world" addr -- > loop in loop -- multicastSender :: HostName -> PortNumber -> IO (Socket, SockAddr) multicastSender host port = do addr <- fmap (SockAddrInet port) (inet_addr host) proto <- getProtocolNumber "udp" sock <- socket AF_INET Datagram proto return (sock, addr) -- | Calling 'multicastReceiver' creates and binds a UDP socket for listening -- multicast datagrams on the specified host and port. -- -- Minimal example: -- -- > import Network.Socket -- > import Network.Multicast -- > main = withSocketsDo $ do -- > sock <- multicastReceiver "224.0.0.99" 9999 -- > let loop = do -- > (msg, _, addr) <- recvFrom sock 1024 -- > print (msg, addr) in loop -- multicastReceiver :: HostName -> PortNumber -> IO Socket multicastReceiver host port = bracketOnError get sClose setup where get :: IO Socket get = do proto <- getProtocolNumber "udp" sock <- socket AF_INET Datagram proto #if defined(SO_REUSEPORT) && ! defined (__linux__) setSocketOption sock ReusePort 1 return sock #else setSocketOption sock ReuseAddr 1 return sock #endif setup :: Socket -> IO Socket setup sock = do bindSocket sock $ SockAddrInet port iNADDR_ANY addMembership sock host Nothing return sock doSetSocketOption :: Storable a => CInt -> Socket -> a -> IO CInt doSetSocketOption ip_multicast_option (MkSocket s _ _ _ _) x = alloca $ \ptr -> do poke ptr x c_setsockopt s _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. setLoopbackMode :: Socket -> LoopbackMode -> IO () setLoopbackMode sock mode = maybeIOError "setLoopbackMode" $ do let loop = if mode then 1 else 0 :: CUChar doSetSocketOption _IP_MULTICAST_LOOP sock loop -- | Set the Time-to-Live of the multicast. setTimeToLive :: Socket -> TimeToLive -> IO () setTimeToLive sock ttl = maybeIOError "setTimeToLive" $ do let val = toEnum ttl :: CInt doSetSocketOption _IP_MULTICAST_TTL sock val -- | Set the outgoing interface address of the multicast. setInterface :: Socket -> HostName -> IO () setInterface sock host = maybeIOError "setInterface" $ do addr <- inet_addr host doSetSocketOption _IP_MULTICAST_IF sock addr -- | Make the socket listen on multicast datagrams sent by the specified 'HostName'. addMembership :: Socket -> HostName -> Maybe HostName -> IO () addMembership s host = maybeIOError "addMembership" . doMulticastGroup _IP_ADD_MEMBERSHIP s host -- | Stop the socket from listening on multicast datagrams sent by the specified 'HostName'. dropMembership :: Socket -> HostName -> Maybe HostName -> IO () dropMembership s host = maybeIOError "dropMembership" . doMulticastGroup _IP_DROP_MEMBERSHIP s host maybeIOError :: String -> IO CInt -> IO () maybeIOError name f = f >>= \err -> case err of 0 -> return () _ -> 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 iface <- case local of Nothing -> return (#{const INADDR_ANY} `asTypeOf` addr) Just loc -> 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}) #ifdef mingw32_HOST_OS foreign import stdcall unsafe "setsockopt" c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt foreign import stdcall unsafe "WSAGetLastError" wsaGetLastError :: IO CInt getLastError :: CInt -> IO CInt getLastError = const wsaGetLastError _IP_MULTICAST_IF, _IP_MULTICAST_TTL, _IP_MULTICAST_LOOP, _IP_ADD_MEMBERSHIP, _IP_DROP_MEMBERSHIP :: CInt _IP_MULTICAST_IF = 9 _IP_MULTICAST_TTL = 10 _IP_MULTICAST_LOOP = 11 _IP_ADD_MEMBERSHIP = 12 _IP_DROP_MEMBERSHIP = 13 #else foreign import ccall unsafe "setsockopt" c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt getLastError :: CInt -> IO CInt getLastError = return _IP_MULTICAST_IF, _IP_MULTICAST_TTL, _IP_MULTICAST_LOOP, _IP_ADD_MEMBERSHIP, _IP_DROP_MEMBERSHIP :: CInt _IP_MULTICAST_IF = #const IP_MULTICAST_IF _IP_MULTICAST_TTL = #const IP_MULTICAST_TTL _IP_MULTICAST_LOOP = #const IP_MULTICAST_LOOP _IP_ADD_MEMBERSHIP = #const IP_ADD_MEMBERSHIP _IP_DROP_MEMBERSHIP = #const IP_DROP_MEMBERSHIP #endif _IPPROTO_IP :: CInt _IPPROTO_IP = #const IPPROTO_IP