module Network.Multicast (
multicastSender, multicastReceiver
, addMembership, dropMembership
, setLoopbackMode, setTimeToLive, setInterface
, 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
type TimeToLive = Int
type LoopbackMode = Bool
enableLoopback, noLoopback :: LoopbackMode
enableLoopback = True
noLoopback = False
multicastSender :: HostName -> PortNumber -> IO (Socket, SockAddr)
multicastSender host port = do
proto <- getProtocolNumber "udp"
sock <- socket AF_INET Datagram proto
addr <- fmap (SockAddrInet port) (inet_addr host)
return (sock, addr)
multicastReceiver :: HostName -> PortNumber -> IO Socket
multicastReceiver host port = do
proto <- getProtocolNumber "udp"
sock <- socket AF_INET Datagram proto
bindSocket sock $ SockAddrInet port 0
addMembership sock host
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)
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
setTimeToLive :: Socket -> TimeToLive -> IO ()
setTimeToLive sock ttl = maybeIOError "setTimeToLive" $ do
let val = toEnum ttl :: CInt
doSetSocketOption _IP_MULTICAST_TTL sock val
setInterface :: Socket -> HostName -> IO ()
setInterface sock host = maybeIOError "setInterface" $ do
addr <- inet_addr host
doSetSocketOption _IP_MULTICAST_IF sock addr
addMembership :: Socket -> HostName -> IO ()
addMembership s = maybeIOError "addMembership" . doMulticastGroup _IP_ADD_MEMBERSHIP s
dropMembership :: Socket -> HostName -> IO ()
dropMembership s = maybeIOError "dropMembership" . doMulticastGroup _IP_DROP_MEMBERSHIP s
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 -> IO CInt
doMulticastGroup flag (MkSocket s _ _ _ _) host = allocaBytes (8) $ \mReqPtr -> do
addr <- inet_addr host
(\hsc_ptr -> pokeByteOff hsc_ptr 0) mReqPtr addr
(\hsc_ptr -> pokeByteOff hsc_ptr 4) mReqPtr (0 `asTypeOf` addr)
c_setsockopt s _IPPROTO_IP flag (castPtr mReqPtr) ((8))
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 = 32
_IP_MULTICAST_TTL = 33
_IP_MULTICAST_LOOP = 34
_IP_ADD_MEMBERSHIP = 35
_IP_DROP_MEMBERSHIP = 36
_IPPROTO_IP :: CInt
_IPPROTO_IP = 0