network-multicast 0.0.2 → 0.0.3

raw patch · 4 files changed

+65/−27 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• examples/receiver.hs +1/−1
• examples/sender.hs +4/−2
• network-multicast.cabal +1/−1
• src/Network/Multicast.hsc +59/−23

@@ -1,5 +1,5 @@ import Network.Socket (withSocketsDo, recvFrom)-import Network.Multicast (multicastReceiver)+import Network.Multicast  main :: IO () main = withSocketsDo $ do

@@ -1,12 +1,14 @@ import Network.Socket (withSocketsDo, sendTo)-import Network.Multicast (multicastSender, noLoopback)+import Network.Multicast  import System.Time (getClockTime) import Control.Concurrent (threadDelay)  main :: IO () main = withSocketsDo $ do-    (sock, addr) <- multicastSender "224.0.0.99" 9999 noLoopback+    (sock, addr) <- multicastSender "224.0.0.99" 9999+    setTimeToLive sock 10+    setInterface sock "192.168.2.1"     let loop = do         msg <- fmap show getClockTime         sendTo sock msg addr

@@ -1,5 +1,5 @@ name:               network-multicast-version:            0.0.2+version:            0.0.3 copyright:          2008 Audrey Tang license:            BSD3 license-file:       LICENSE

@@ -18,9 +18,10 @@     -- * Simple sending and receiving       multicastSender, multicastReceiver     -- * Additional Socket operations-    , addMembership, dropMembership, setLoopbackMode-    -- * Loopback flags-    , LoopbackMode, enableLoopback, noLoopback+    , addMembership, dropMembership+    , setLoopbackMode, setTimeToLive, setInterface+    -- * Socket options+    , TimeToLive, LoopbackMode, enableLoopback, noLoopback ) where import Network.BSD import Network.Socket@@ -30,6 +31,7 @@ import Foreign.Marshal import Foreign.Ptr +type TimeToLive = Int type LoopbackMode = Bool  enableLoopback, noLoopback :: LoopbackMode@@ -44,18 +46,16 @@ -- > import Network.Socket -- > import Network.Multicast -- > main = withSocketsDo $ do--- >     (sock, addr) <- multicastSender "224.0.0.99" 9999 noLoopback+-- >     (sock, addr) <- multicastSender "224.0.0.99" 9999 -- >     let loop = do -- >         sendTo sock "Hello, world" addr -- >         loop in loop ---multicastSender :: HostName -> PortNumber -> LoopbackMode -> IO (Socket, SockAddr)-multicastSender host port loop = do+multicastSender :: HostName -> PortNumber -> IO (Socket, SockAddr)+multicastSender host port = do     proto <- getProtocolNumber "udp"     sock  <- socket AF_INET Datagram proto-    if loop then return () else setLoopbackMode sock loop-    host  <- inet_addr host-    let addr = SockAddrInet port host+    addr  <- fmap (SockAddrInet port) (inet_addr host)     return (sock, addr)  -- | Calling 'multicastReceiver' creates and binds a UDP socket for listening@@ -75,24 +75,38 @@ multicastReceiver host port = do     proto <- getProtocolNumber "udp"     sock  <- socket AF_INET Datagram proto-    addMembership sock host #ifdef SO_REUSEPORT     setSocketOption sock ReusePort 1 #endif-    host  <- inet_addr host-    let addr = SockAddrInet port host-    bindSocket sock addr+    bindSocket sock $ SockAddrInet port #{const INADDR_ANY}+    addMembership sock host     return sock +doSetSocketOption :: Storable a => Socket -> a -> IO CInt+doSetSocketOption (MkSocket s _ _ _ _) x = alloca $ \ptr -> do+    poke ptr x+    c_setsockopt s _IPPROTO_IP _IP_MULTICAST_LOOP (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 (MkSocket s _ _ _ _) mode = maybeIOError "setLoopbackMode" $-    alloca $ \loopPtr -> do-        let loop = if mode then 1 else 0 :: CUChar-        poke loopPtr loop-        c_setsockopt s _IPPROTO_IP _IP_MULTICAST_LOOP (castPtr loopPtr) (toEnum $ sizeOf loop)+setLoopbackMode sock mode = maybeIOError "setLoopbackMode" $ do+    let loop = if mode then 1 else 0 :: CUChar+    doSetSocketOption sock loop+    where +-- | Set the Time-to-Live of the multicast.+setTimeToLive :: Socket -> TimeToLive -> IO ()+setTimeToLive sock ttl = maybeIOError "setTimeToLive" $ do+    let val = toEnum ttl :: CInt+    doSetSocketOption 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 sock addr+ -- | Make the socket listen on multicast datagrams sent by the specified 'HostName'. addMembership :: Socket -> HostName -> IO () addMembership s = maybeIOError "addMembership" . doMulticastGroup _IP_ADD_MEMBERSHIP s@@ -115,15 +129,37 @@  #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"-#endif     c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt -_IPPROTO_IP :: CInt-_IPPROTO_IP = #const IPPROTO_IP+getLastError :: CInt -> IO CInt+getLastError = return -_IP_ADD_MEMBERSHIP, _IP_DROP_MEMBERSHIP, _IP_MULTICAST_LOOP :: CInt+_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-_IP_MULTICAST_LOOP  = #const IP_MULTICAST_LOOP++#endif++_IPPROTO_IP :: CInt+_IPPROTO_IP = #const IPPROTO_IP