network-multicast (empty) → 0.0.1

raw patch · 4 files changed

+172/−0 lines, 4 filesdep +basedep +networksetup-changed

Dependencies added: base, network

Files

LICENSE +18/−0
Setup.lhs +5/−0
network-multicast.cabal +17/−0
src/Network/Multicast.hsc +132/−0

+ LICENSE view

@@ -0,0 +1,18 @@+Copyright 2008 by Audrey Tang++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to+deal in the Software without restriction, including without limitation the+rights to use, copy, modify, merge, publish, distribute, sublicense, and/or+sell copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:+  +The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.+   +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL+THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER +IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ Setup.lhs view

@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell+> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMain

+ network-multicast.cabal view

@@ -0,0 +1,17 @@+name:               network-multicast+version:            0.0.1+copyright:          2008 Audrey Tang+license:            BSD3+license-file:       LICENSE+author:             Audrey Tang <audreyt@audreyt.org>+maintainer:         Audrey Tang <audreyt@audreyt.org>+synopsis:           Simple multicast library+description:        The "Network.Multicast" module is for sending+                    UDP datagrams over multicast (class D) addresses.+stability:          experimental+build-type:         Simple+extensions:         ForeignFunctionInterface+exposed-modules:    Network.Multicast+build-depends:      base, network+category:           Network+hs-source-dirs:     src

+ src/Network/Multicast.hsc view

@@ -0,0 +1,132 @@+-----------------------------------------------------------------------------+-- |+-- 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 <sys/types.h>+#include <netinet/in.h>++module Network.Multicast (+    -- * Simple sending and receiving+      multicastSender, multicastReceiver+    -- * Additional Socket operations+    , addMembership, dropMembership, setLoopbackMode+    -- * Loopback flags+    , 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 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 noLoopback+-- >     let loop = do+-- >         sendTo sock "Hello, world" addr+-- >         loop in loop+--+multicastSender :: HostName -> PortNumber -> LoopbackMode -> IO (Socket, SockAddr)+multicastSender host port loop = do+    proto <- getProtocolNumber "udp"+    let hints = defaultHints+            { addrFlags      = [AI_ADDRCONFIG]+            , addrProtocol   = proto+            , addrSocketType = Datagram+            }+    (addr:_) <- getAddrInfo (Just hints) (Just host) (Just $ show port)+    sock     <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+    if loop then return () else setLoopbackMode sock loop+    return (sock, addrAddress 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 = do+    proto <- getProtocolNumber "udp"+    let hints = defaultHints+            { addrFlags      = [AI_PASSIVE]+            , addrProtocol   = proto+            , addrSocketType = Datagram+            }+    (addr:_) <- getAddrInfo (Just hints) (Just host) (Just $ show port)+    sock     <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+    addMembership sock host+    setSocketOption sock ReusePort 1+    bindSocket sock (addrAddress addr)+    return sock++-- | 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)++-- | 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++-- | Stop the socket from listening on multicast datagrams sent by the specified 'HostName'.+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 #{size struct ip_mreq} $ \mReqPtr -> do+    addr <- inet_addr host+    #{poke struct ip_mreq, imr_multiaddr} mReqPtr addr+    #{poke struct ip_mreq, imr_interface} mReqPtr (#{const INADDR_ANY} `asTypeOf` addr)+    c_setsockopt s _IPPROTO_IP flag (castPtr mReqPtr) (#{size struct ip_mreq})++foreign import ccall unsafe "setsockopt"+    c_setsockopt :: CInt -> CInt -> CInt -> Ptr CInt -> CInt -> IO CInt++_IPPROTO_IP :: CInt+_IPPROTO_IP = #const IPPROTO_IP++_IP_ADD_MEMBERSHIP, _IP_DROP_MEMBERSHIP, _IP_MULTICAST_LOOP :: CInt+_IP_ADD_MEMBERSHIP  = #const IP_ADD_MEMBERSHIP+_IP_DROP_MEMBERSHIP = #const IP_DROP_MEMBERSHIP+_IP_MULTICAST_LOOP  = #const IP_MULTICAST_LOOP