Fix udp server

Former-commit-id: dc6b384be35d0da3d96502aee7a34f03f64069f9
Former-commit-id: 886ee2d95c42ce476a9233c66d266f76edd7c352 [formerly 5938a7b6b407cdc64f0972b4fe0d5cc44af815a6] [formerly 71fe7cf675464eee1ee6c467e6835ea0ae60f30a [formerly 3ed2dbb76a6fe601478b01b60a4b845703eee2d2 [formerly 3ed2dbb76a6fe601478b01b60a4b845703eee2d2 [formerly 3ed2dbb76a6fe601478b01b60a4b845703eee2d2 [formerly c58f0795fa3796cb7873988ebf64361b0860c4b5]]]]]
Former-commit-id: 7bc8c5f4bfa8854ace4360d9d645795964923fdf [formerly ae69d9d2df4790d121871a578a48ac1e3414498f]
Former-commit-id: ce2df65ede7f77d7e0a59ee65e502f88a5c85c6b
Former-commit-id: a69b9bfb8c42a9a9523535e2c225fec06228c4eb
Former-commit-id: efc5bbd6fbe9cd3f550f5767313559a1df65bb77
Former-commit-id: f32be564261055e3499491aff9bc88ca0e897adf [formerly 794c396edb9719688b3040a2f484afa3591059f9]
Former-commit-id: ab8cbe512c3737a53733083fb8f499e6bf589fb1
This commit is contained in:
Erèbe 2016-11-26 16:59:21 +01:00
parent 1bcef0920a
commit 048be2a604

View file

@ -45,7 +45,7 @@ runUDPClient endPoint@(host, port) app = do
app UdpAppData { appAddr = N.addrAddress addrInfo
, appSem = sem
, appRead = fst <$> N.recvFrom socket 4096
, appWrite = \payload -> void $ N.sendTo socket payload (N.addrAddress addrInfo)
, appWrite = \payload -> void $ N.sendAllTo socket payload (N.addrAddress addrInfo)
}
info $ "CLOSE udp connection to " <> toStr endPoint
@ -65,7 +65,7 @@ runUDPServer endPoint@(host, port) app = do
let appData = UdpAppData { appAddr = addr
, appSem = sem
, appRead = takeMVar sem
, appWrite = \payload' -> void $ N.sendTo socket payload' addr
, appWrite = \payload' -> void $ N.sendAllTo socket payload' addr
}
void $ atomicModifyIORef' clientsCtx (\clients -> (H.insert addr appData clients, ()))
return appData
@ -76,7 +76,11 @@ runUDPServer endPoint@(host, port) app = do
debug "TIMEOUT connection"
pushDataToClient :: UdpAppData -> ByteString -> IO ()
pushDataToClient clientCtx = putMVar (appSem clientCtx)
pushDataToClient clientCtx payload = putMVar (appSem clientCtx) payload
`catch` (\(_ :: SomeException) -> debug $ "DROP udp packet, client thread dead")
-- If we are unlucky the client's thread died before we had the time to push the data on a already full mutex
-- and will leave us waiting forever for the mutex to empty. So catch the exeception and drop the message.
-- Udp is not a reliable protocol so transmission failure should be handled by the application layer
runEventLoop :: IORef (H.HashMap N.SockAddr UdpAppData) -> N.Socket -> IO ()
runEventLoop clientsCtx socket = forever $ do