fix udp server dying due to BlockedIndefinitelyOnMVar
Former-commit-id: 3b196ad1dd251da10a16ba92c6b406dd82bc14a2 Former-commit-id: 22ff60708b7918aecd12d6e6d38356c63bb5a567 [formerly c4e7cd099079d7728cf28c2d08e068a5995850c9] [formerly f6cf0c8536ef624a6252bfabd870740614a9677a [formerly 261f59a6a33f78d86b7d555905cf9a55ec2eedeb [formerly e6f63f7fc005ad2dab36b304114d2568c2d63cd4] [formerly e6f63f7fc005ad2dab36b304114d2568c2d63cd4 [formerly e6f63f7fc005ad2dab36b304114d2568c2d63cd4 [formerly 4202be87d212a1939cb57502630a4d0eb7ec0c26]]]]] Former-commit-id: aaa73da1686f57961be57ad6aa8476b3895ecac5 [formerly 704971dfb9ef961f0b43376f221d21d22dd2fffa] Former-commit-id: b21cd9564e59374361b81e7557c324eae4eb6661 Former-commit-id: f3a7e81c15358d470608639714ec87a65d5bbbf6 Former-commit-id: 52494e1883d95d60395e5d062846a3dcc2e39e7b Former-commit-id: 845cb1c441d4301fa56dd9ebd71c6a7be158a7bc [formerly 734bf85e5391d55a2243b5857870824b264c36e0] Former-commit-id: 4b82bfe4dabde5f2101f71f055e0949800d7807b
This commit is contained in:
parent
26035a834a
commit
c46f93775f
1 changed files with 14 additions and 6 deletions
|
@ -4,7 +4,7 @@
|
|||
module Protocols where
|
||||
|
||||
import ClassyPrelude
|
||||
import Control.Concurrent (forkIO)
|
||||
import Control.Concurrent (forkIO, forkFinally, threadDelay)
|
||||
import qualified Data.HashMap.Strict as H
|
||||
import System.IO hiding (hSetBuffering, hGetBuffering)
|
||||
|
||||
|
@ -71,7 +71,7 @@ runUDPServer :: (HostName, PortNumber) -> Int -> (UdpAppData -> IO ()) -> IO ()
|
|||
runUDPServer endPoint@(host, port) cnxTimeout app = do
|
||||
info $ "WAIT for datagrames on " <> toStr endPoint
|
||||
clientsCtx <- newIORef mempty
|
||||
void $ bracket (N.bindPortUDP (fromIntegral port) (fromString host)) N.close (runEventLoop clientsCtx)
|
||||
void $ bracket (N.bindPortUDP (fromIntegral port) (fromString host)) N.close (forever . run clientsCtx)
|
||||
info $ "CLOSE udp server" <> toStr endPoint
|
||||
|
||||
where
|
||||
|
@ -98,6 +98,14 @@ runUDPServer endPoint@(host, port) cnxTimeout app = do
|
|||
-- 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
|
||||
|
||||
-- We run the server inside another thread in order to avoid Haskell runtime sending to the main thread
|
||||
-- the exception BlockedIndefinitelyOnMVar
|
||||
-- We dont use also MVar to wait for the end of the thread to avoid also receiving this exception
|
||||
run :: IORef (H.HashMap N.SockAddr UdpAppData) -> N.Socket -> IO ()
|
||||
run clientsCtx socket = do
|
||||
_ <- forkFinally (runEventLoop clientsCtx socket) (\_ -> debug "UdpServer died")
|
||||
threadDelay (maxBound :: Int)
|
||||
|
||||
runEventLoop :: IORef (H.HashMap N.SockAddr UdpAppData) -> N.Socket -> IO ()
|
||||
runEventLoop clientsCtx socket = forever $ do
|
||||
(payload, addr) <- N.recvFrom socket 4096
|
||||
|
@ -105,10 +113,10 @@ runUDPServer endPoint@(host, port) cnxTimeout app = do
|
|||
|
||||
case clientCtx of
|
||||
Just clientCtx' -> pushDataToClient clientCtx' payload
|
||||
_ -> void . forkIO $ bracket
|
||||
(addNewClient clientsCtx socket addr payload)
|
||||
(removeClient clientsCtx)
|
||||
(void . timeout cnxTimeout . app)
|
||||
_ -> do
|
||||
clientCtx <- addNewClient clientsCtx socket addr payload
|
||||
_ <- forkFinally (void . timeout cnxTimeout $ app clientCtx) (\_ -> removeClient clientsCtx clientCtx)
|
||||
return ()
|
||||
|
||||
|
||||
runSocks5Server :: Socks5.ServerSettings -> TunnelSettings -> (TunnelSettings -> N.AppData -> IO()) -> IO ()
|
||||
|
|
Loading…
Reference in a new issue