diff --git a/Network/Socket.hs b/Network/Socket.hs index 1c42b1ac..e5febce3 100644 --- a/Network/Socket.hs +++ b/Network/Socket.hs @@ -170,7 +170,12 @@ module Network.Socket ( DontFragment, RecvIPv6HopLimit, RecvIPv6TClass, - RecvIPv6PktInfo + RecvIPv6PktInfo, + MulticastIF, + MulticastTTL, + MulticastLoop, + AddMembership, + DropMembership ), isSupportedSocketOption, whenSupported, @@ -400,6 +405,9 @@ module Network.Socket ( -- * Deprecated withSocketsDo, + + -- * Multicast Group + MulticastGroup (..), ) where import Network.Socket.Buffer hiding ( diff --git a/Network/Socket/Options.hsc b/Network/Socket/Options.hsc index 1805fc10..73e10b84 100644 --- a/Network/Socket/Options.hsc +++ b/Network/Socket/Options.hsc @@ -18,6 +18,7 @@ module Network.Socket.Options ( ,UseLoopBack,UserTimeout,IPv6Only ,RecvIPv4TTL,RecvIPv4TOS,RecvIPv4PktInfo,DontFragment ,RecvIPv6HopLimit,RecvIPv6TClass,RecvIPv6PktInfo + ,MulticastIF,MulticastTTL,MulticastLoop,AddMembership,DropMembership ,CustomSockOpt) , isSupportedSocketOption , whenSupported @@ -397,6 +398,48 @@ pattern RecvIPv6PktInfo = SockOpt (-1) (-1) #endif #endif // HAVE_DECL_IPPROTO_IPV6 +-- | Multicast interface. +#ifdef IP_MULTICAST_IF +pattern MulticastIF :: SocketOption +pattern MulticastIF = SockOpt (#const IPPROTO_IP) (#const IP_MULTICAST_IF) +#else +pattern MulticastIF :: SocketOption +pattern MulticastIF = SockOpt (-1) (-1) +#endif +-- | Multicast TTL. +#ifdef IP_MULTICAST_TTL +pattern MulticastTTL :: SocketOption +pattern MulticastTTL = SockOpt (#const IPPROTO_IP) (#const IP_MULTICAST_TTL) +#else +pattern MulticastTTL :: SocketOption +pattern MulticastTTL = SockOpt (-1) (-1) +#endif +-- | Multicast loopback. +#ifdef IP_MULTICAST_LOOP +pattern MulticastLoop :: SocketOption +pattern MulticastLoop = SockOpt (#const IPPROTO_IP) (#const IP_MULTICAST_LOOP) +#else +pattern MulticastLoop :: SocketOption +pattern MulticastLoop = SockOpt (-1) (-1) +#endif +-- | Add membership. +#ifdef IP_ADD_MEMBERSHIP +pattern AddMembership :: SocketOption +pattern AddMembership = SockOpt (#const IPPROTO_IP) (#const IP_ADD_MEMBERSHIP) +#else +pattern AddMembership :: SocketOption +pattern AddMembership = SockOpt (-1) (-1) +#endif +-- | Drop membership. +#ifdef IP_DROP_MEMBERSHIP +pattern DropMembership :: SocketOption +pattern DropMembership = SockOpt (#const IPPROTO_IP) (#const IP_DROP_MEMBERSHIP) +#else +pattern DropMembership :: SocketOption +pattern DropMembership = SockOpt (-1) (-1) +#endif + + pattern CustomSockOpt :: (CInt, CInt) -> SocketOption pattern CustomSockOpt xy <- ((\(SockOpt x y) -> (x, y)) -> xy) where diff --git a/Network/Socket/Types.hsc b/Network/Socket/Types.hsc index 3f7aaa7f..281db50c 100644 --- a/Network/Socket/Types.hsc +++ b/Network/Socket/Types.hsc @@ -85,6 +85,9 @@ module Network.Socket.Types ( , htonl , ntohl , In6Addr(..) + + -- * Multicast Group + , MulticastGroup(..) ) where import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef', mkWeakIORef, modifyIORef') @@ -1528,3 +1531,27 @@ foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO () -- | Zero a structure. zeroMemory :: Ptr a -> CSize -> IO () zeroMemory dest nbytes = memset dest 0 (fromIntegral nbytes) + + +------------------------------------------------------------------------ +-- Multicast Group + +data MulticastGroup = MulticastGroup + { groupAddress :: HostAddress + , localAddress :: Maybe HostAddress + } deriving (Show, Eq) + +instance Storable MulticastGroup where + sizeOf ~_ = #size struct ip_mreq + alignment ~_ = #alignment struct ip_mreq + peek p = do + g <- (#peek struct ip_mreq, imr_multiaddr) p + l <- (#peek struct ip_mreq, imr_interface) p + pure . MulticastGroup g $ case l of + 0 -> Nothing + loc -> Just loc + poke p (MulticastGroup g l) = do + (#poke struct ip_mreq, imr_multiaddr) p g + (#poke struct ip_mreq, imr_interface) p (case l of + Nothing -> 0 + Just loc -> loc)