{-# LINE 1 "src/Network/Multicast.hsc" #-}
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
import Control.Exception (bracketOnError)
import Data.Word (Word32)
type TimeToLive = Int
type LoopbackMode = Bool
enableLoopback, noLoopback :: LoopbackMode
enableLoopback :: LoopbackMode
enableLoopback = LoopbackMode
True
noLoopback :: LoopbackMode
noLoopback = LoopbackMode
False
inet_addr :: HostName -> IO HostAddress
inet_addr :: HostName -> IO HostAddress
inet_addr = (HostEntry -> HostAddress) -> IO HostEntry -> IO HostAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HostEntry -> HostAddress
hostAddress (IO HostEntry -> IO HostAddress)
-> (HostName -> IO HostEntry) -> HostName -> IO HostAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostName -> IO HostEntry
getHostByName
multicastSender :: HostName -> PortNumber -> IO (Socket, SockAddr)
multicastSender :: HostName -> PortNumber -> IO (Socket, SockAddr)
multicastSender host :: HostName
host port :: PortNumber
port = do
SockAddr
addr <- (HostAddress -> SockAddr) -> IO HostAddress -> IO SockAddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PortNumber -> HostAddress -> SockAddr
SockAddrInet PortNumber
port) (HostName -> IO HostAddress
Network.Multicast.inet_addr HostName
host)
ProtocolNumber
proto <- HostName -> IO ProtocolNumber
getProtocolNumber "udp"
Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
socket Family
AF_INET SocketType
Datagram ProtocolNumber
proto
(Socket, SockAddr) -> IO (Socket, SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Socket
sock, SockAddr
addr)
multicastReceiver :: HostName -> PortNumber -> IO Socket
multicastReceiver :: HostName -> PortNumber -> IO Socket
multicastReceiver host :: HostName
host port :: PortNumber
port = IO Socket
-> (Socket -> IO ()) -> (Socket -> IO Socket) -> IO Socket
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError IO Socket
get Socket -> IO ()
close Socket -> IO Socket
setup
where
get :: IO Socket
get :: IO Socket
get = do
ProtocolNumber
proto <- HostName -> IO ProtocolNumber
getProtocolNumber "udp"
Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
socket Family
AF_INET SocketType
Datagram ProtocolNumber
proto
{-# LINE 90 "src/Network/Multicast.hsc" #-}
Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
sock SocketOption
ReuseAddr 1
Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock
{-# LINE 93 "src/Network/Multicast.hsc" #-}
setup :: Socket -> IO Socket
setup :: Socket -> IO Socket
setup sock :: Socket
sock = do
Socket -> SockAddr -> IO ()
bind Socket
sock (SockAddr -> IO ()) -> SockAddr -> IO ()
forall a b. (a -> b) -> a -> b
$ PortNumber -> HostAddress -> SockAddr
SockAddrInet PortNumber
port HostAddress
Network.Multicast.iNADDR_ANY
Socket -> HostName -> Maybe HostName -> IO ()
addMembership Socket
sock HostName
host Maybe HostName
forall a. Maybe a
Nothing
Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock
iNADDR_ANY :: HostAddress
iNADDR_ANY :: HostAddress
iNADDR_ANY = HostAddress -> HostAddress
Network.Multicast.htonl 0
foreign import ccall unsafe "htonl" htonl :: Word32 -> Word32
class IOCompat f where ioCompat :: f -> (Socket -> IO CInt)
instance IOCompat (Socket -> IO CInt) where ioCompat :: (Socket -> IO ProtocolNumber) -> Socket -> IO ProtocolNumber
ioCompat = (Socket -> IO ProtocolNumber) -> Socket -> IO ProtocolNumber
forall a. a -> a
id
instance IOCompat (Socket -> CInt) where ioCompat :: (Socket -> ProtocolNumber) -> Socket -> IO ProtocolNumber
ioCompat = (ProtocolNumber -> IO ProtocolNumber
forall (m :: * -> *) a. Monad m => a -> m a
return (ProtocolNumber -> IO ProtocolNumber)
-> (Socket -> ProtocolNumber) -> Socket -> IO ProtocolNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
doSetSocketOption :: Storable a => CInt -> Socket -> a -> IO CInt
doSetSocketOption :: ProtocolNumber -> Socket -> a -> IO ProtocolNumber
doSetSocketOption ip_multicast_option :: ProtocolNumber
ip_multicast_option sock :: Socket
sock x :: a
x = (Ptr a -> IO ProtocolNumber) -> IO ProtocolNumber
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr a -> IO ProtocolNumber) -> IO ProtocolNumber)
-> (Ptr a -> IO ProtocolNumber) -> IO ProtocolNumber
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr a
ptr -> do
Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
x
ProtocolNumber
fd <- ((Socket -> IO ProtocolNumber) -> Socket -> IO ProtocolNumber
forall f. IOCompat f => f -> Socket -> IO ProtocolNumber
ioCompat Socket -> IO ProtocolNumber
fdSocket) Socket
sock
ProtocolNumber
-> ProtocolNumber
-> ProtocolNumber
-> Ptr ProtocolNumber
-> ProtocolNumber
-> IO ProtocolNumber
c_setsockopt ProtocolNumber
fd ProtocolNumber
_IPPROTO_IP ProtocolNumber
ip_multicast_option (Ptr a -> Ptr ProtocolNumber
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) (Int -> ProtocolNumber
forall a. Enum a => Int -> a
toEnum (Int -> ProtocolNumber) -> Int -> ProtocolNumber
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Storable a => a -> Int
sizeOf a
x)
setLoopbackMode :: Socket -> LoopbackMode -> IO ()
setLoopbackMode :: Socket -> LoopbackMode -> IO ()
setLoopbackMode sock :: Socket
sock mode :: LoopbackMode
mode = HostName -> IO ProtocolNumber -> IO ()
maybeIOError "setLoopbackMode" (IO ProtocolNumber -> IO ()) -> IO ProtocolNumber -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let loop :: CUChar
loop = if LoopbackMode
mode then 1 else 0 :: CUChar
ProtocolNumber -> Socket -> CUChar -> IO ProtocolNumber
forall a.
Storable a =>
ProtocolNumber -> Socket -> a -> IO ProtocolNumber
doSetSocketOption ProtocolNumber
_IP_MULTICAST_LOOP Socket
sock CUChar
loop
setTimeToLive :: Socket -> TimeToLive -> IO ()
setTimeToLive :: Socket -> Int -> IO ()
setTimeToLive sock :: Socket
sock ttl :: Int
ttl = HostName -> IO ProtocolNumber -> IO ()
maybeIOError "setTimeToLive" (IO ProtocolNumber -> IO ()) -> IO ProtocolNumber -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let val :: ProtocolNumber
val = Int -> ProtocolNumber
forall a. Enum a => Int -> a
toEnum Int
ttl :: CInt
ProtocolNumber -> Socket -> ProtocolNumber -> IO ProtocolNumber
forall a.
Storable a =>
ProtocolNumber -> Socket -> a -> IO ProtocolNumber
doSetSocketOption ProtocolNumber
_IP_MULTICAST_TTL Socket
sock ProtocolNumber
val
setInterface :: Socket -> HostName -> IO ()
setInterface :: Socket -> HostName -> IO ()
setInterface sock :: Socket
sock host :: HostName
host = HostName -> IO ProtocolNumber -> IO ()
maybeIOError "setInterface" (IO ProtocolNumber -> IO ()) -> IO ProtocolNumber -> IO ()
forall a b. (a -> b) -> a -> b
$ do
HostAddress
addr <- HostName -> IO HostAddress
Network.Multicast.inet_addr HostName
host
ProtocolNumber -> Socket -> HostAddress -> IO ProtocolNumber
forall a.
Storable a =>
ProtocolNumber -> Socket -> a -> IO ProtocolNumber
doSetSocketOption ProtocolNumber
_IP_MULTICAST_IF Socket
sock HostAddress
addr
addMembership :: Socket -> HostName -> Maybe HostName -> IO ()
addMembership :: Socket -> HostName -> Maybe HostName -> IO ()
addMembership s :: Socket
s host :: HostName
host = HostName -> IO ProtocolNumber -> IO ()
maybeIOError "addMembership" (IO ProtocolNumber -> IO ())
-> (Maybe HostName -> IO ProtocolNumber) -> Maybe HostName -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolNumber
-> Socket -> HostName -> Maybe HostName -> IO ProtocolNumber
doMulticastGroup ProtocolNumber
_IP_ADD_MEMBERSHIP Socket
s HostName
host
dropMembership :: Socket -> HostName -> Maybe HostName -> IO ()
dropMembership :: Socket -> HostName -> Maybe HostName -> IO ()
dropMembership s :: Socket
s host :: HostName
host = HostName -> IO ProtocolNumber -> IO ()
maybeIOError "dropMembership" (IO ProtocolNumber -> IO ())
-> (Maybe HostName -> IO ProtocolNumber) -> Maybe HostName -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolNumber
-> Socket -> HostName -> Maybe HostName -> IO ProtocolNumber
doMulticastGroup ProtocolNumber
_IP_DROP_MEMBERSHIP Socket
s HostName
host
maybeIOError :: String -> IO CInt -> IO ()
maybeIOError :: HostName -> IO ProtocolNumber -> IO ()
maybeIOError name :: HostName
name f :: IO ProtocolNumber
f = IO ProtocolNumber
f IO ProtocolNumber -> (ProtocolNumber -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \err :: ProtocolNumber
err -> case ProtocolNumber
err of
0 -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> IOError -> IO ()
forall a. IOError -> IO a
ioError (HostName -> Errno -> Maybe Handle -> Maybe HostName -> IOError
errnoToIOError HostName
name (ProtocolNumber -> Errno
Errno (ProtocolNumber -> ProtocolNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral ProtocolNumber
err)) Maybe Handle
forall a. Maybe a
Nothing Maybe HostName
forall a. Maybe a
Nothing)
doMulticastGroup :: CInt -> Socket -> HostName -> Maybe HostName -> IO CInt
doMulticastGroup :: ProtocolNumber
-> Socket -> HostName -> Maybe HostName -> IO ProtocolNumber
doMulticastGroup flag :: ProtocolNumber
flag sock :: Socket
sock host :: HostName
host local :: Maybe HostName
local = Int -> (Ptr Any -> IO ProtocolNumber) -> IO ProtocolNumber
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (8) ((Ptr Any -> IO ProtocolNumber) -> IO ProtocolNumber)
-> (Ptr Any -> IO ProtocolNumber) -> IO ProtocolNumber
forall a b. (a -> b) -> a -> b
$ \mReqPtr :: Ptr Any
mReqPtr -> do
{-# LINE 149 "src/Network/Multicast.hsc" #-}
addr <- Network.Multicast.inet_addr host
iface <- case local of
Nothing -> return (0 `asTypeOf` addr)
{-# LINE 152 "src/Network/Multicast.hsc" #-}
Just loc -> Network.Multicast.inet_addr loc
(\hsc_ptr -> pokeByteOff hsc_ptr 0) mReqPtr addr
{-# LINE 154 "src/Network/Multicast.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 4) mReqPtr iface
{-# LINE 155 "src/Network/Multicast.hsc" #-}
fd <- (ioCompat fdSocket) sock
c_setsockopt fd _IPPROTO_IP flag (castPtr mReqPtr) ((8))
{-# LINE 157 "src/Network/Multicast.hsc" #-}
{-# LINE 176 "src/Network/Multicast.hsc" #-}
foreign import ccall unsafe "setsockopt"
c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt
getLastError :: CInt -> IO CInt
getLastError :: ProtocolNumber -> IO ProtocolNumber
getLastError = ProtocolNumber -> IO ProtocolNumber
forall (m :: * -> *) a. Monad m => a -> m a
return
_IP_MULTICAST_IF, _IP_MULTICAST_TTL, _IP_MULTICAST_LOOP, _IP_ADD_MEMBERSHIP, _IP_DROP_MEMBERSHIP :: CInt
_IP_MULTICAST_IF :: ProtocolNumber
_IP_MULTICAST_IF = 32
{-# LINE 185 "src/Network/Multicast.hsc" #-}
_IP_MULTICAST_TTL = 33
{-# LINE 186 "src/Network/Multicast.hsc" #-}
_IP_MULTICAST_LOOP = 34
{-# LINE 187 "src/Network/Multicast.hsc" #-}
_IP_ADD_MEMBERSHIP = 35
{-# LINE 188 "src/Network/Multicast.hsc" #-}
_IP_DROP_MEMBERSHIP = 36
{-# LINE 189 "src/Network/Multicast.hsc" #-}
{-# LINE 191 "src/Network/Multicast.hsc" #-}
_IPPROTO_IP :: CInt
_IPPROTO_IP :: ProtocolNumber
_IPPROTO_IP = 0
{-# LINE 194 "src/Network/Multicast.hsc" #-}