summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKazuYamamoto <>2020-01-14 05:47:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-01-14 05:47:00 (GMT)
commit679c315c3259e76244a997ef3186bde592e3884d (patch)
treeb9330469e9ed2144f162b25fe13b8f1b8f024e71
parent0a3e5ade02e3ef81c62bf8e5f8cc66af77db9501 (diff)
version 0.2.20.2.2
-rw-r--r--Network/Run/UDP.hs38
-rw-r--r--network-run.cabal3
2 files changed, 39 insertions, 2 deletions
diff --git a/Network/Run/UDP.hs b/Network/Run/UDP.hs
index b64aaed..6cd4498 100644
--- a/Network/Run/UDP.hs
+++ b/Network/Run/UDP.hs
@@ -2,10 +2,15 @@
module Network.Run.UDP (
runUDPClient
, runUDPServer
+ , runUDPServerFork
) where
+import Control.Concurrent (forkIO, forkFinally)
import qualified Control.Exception as E
+import Control.Monad (forever, void)
+import Data.ByteString (ByteString)
import Network.Socket
+import Network.Socket.ByteString
import Network.Run.Core
@@ -19,8 +24,39 @@ runUDPClient host port client = withSocketsDo $ do
let sockAddr = addrAddress addr
E.bracket (openSocket addr) close $ \sock -> client sock sockAddr
--- | Running a UDP server with an open socket.
+-- | Running a UDP server with an open socket in a single Haskell thread.
runUDPServer :: Maybe HostName -> ServiceName -> (Socket -> IO a) -> IO a
runUDPServer mhost port server = withSocketsDo $ do
addr <- resolve Datagram mhost port True
E.bracket (openServerSocket addr) close server
+
+-- | Running a UDP server with a connected socket in each Haskell thread.
+-- The first request is given to the server.
+-- Suppose that the server is serving on __addrS:portS__ and
+-- a client connects to the service from __addrC:portC__.
+-- A connected socket is created by binding to __*:portS__ and
+-- connecting to __addrC:portC__,
+-- resulting in __(UDP,addrS:portS,addrC:portC)__ where
+-- __addrS__ is given magically.
+-- This approach is fragile due to NAT rebidings.
+runUDPServerFork :: [HostName] -> ServiceName -> (Socket -> ByteString -> IO ()) -> IO ()
+runUDPServerFork [] _ _ = return ()
+runUDPServerFork (h:hs) port server = do
+ mapM_ (forkIO . run) hs
+ run h
+ where
+ run host = runUDPServer (Just host) port $ \lsock -> forever $ do
+ (bs0,peeraddr) <- recvFrom lsock 2048
+ let family = case peeraddr of
+ SockAddrInet{} -> AF_INET
+ SockAddrInet6{} -> AF_INET6
+ _ -> error "family"
+ hints = defaultHints {
+ addrSocketType = Datagram
+ , addrFamily = family
+ , addrFlags = [AI_PASSIVE]
+ }
+ addr <- head <$> getAddrInfo (Just hints) Nothing (Just port)
+ s <- openServerSocket addr
+ connect s peeraddr
+ void $ forkFinally (server s bs0) (\_ -> close s)
diff --git a/network-run.cabal b/network-run.cabal
index 692be48..67d060c 100644
--- a/network-run.cabal
+++ b/network-run.cabal
@@ -1,5 +1,5 @@
name: network-run
-version: 0.2.1
+version: 0.2.2
synopsis: Simple network runner library
description: Simple functions to run network clients and servers.
-- bug-reports:
@@ -19,6 +19,7 @@ library
-- other-extensions:
build-depends: base >= 4 && < 5
, network >= 3.1.0
+ , bytestring
-- hs-source-dirs:
default-language: Haskell2010