hex/wstunnel
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

fix udp server dying due to BlockedIndefinitelyOnMVar

Browse source 
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:
Romain GERARD 2022-12-11 21:08:18 +01:00
parent 26035a834a
commit c46f93775f
1 changed files with 14 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
src/Protocols.hs
View file

@ -4,7 +4,7 @@
module Protocols where module Protocols where
import ClassyPrelude import ClassyPrelude
import Control.Concurrent (forkIO) import Control.Concurrent (forkIO, forkFinally, threadDelay)
import qualified Data.HashMap.Strict as H import qualified Data.HashMap.Strict as H
import System.IO hiding (hSetBuffering, hGetBuffering) import System.IO hiding (hSetBuffering, hGetBuffering)
@ -71,7 +71,7 @@ runUDPServer :: (HostName, PortNumber) -> Int -> (UdpAppData -> IO ()) -> IO ()
runUDPServer endPoint@(host, port) cnxTimeout app = do runUDPServer endPoint@(host, port) cnxTimeout app = do
info $ "WAIT for datagrames on " <> toStr endPoint info $ "WAIT for datagrames on " <> toStr endPoint
clientsCtx <- newIORef mempty 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 info $ "CLOSE udp server" <> toStr endPoint
where 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. -- 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 -- 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 :: IORef (H.HashMap N.SockAddr UdpAppData) -> N.Socket -> IO ()
runEventLoop clientsCtx socket = forever $ do runEventLoop clientsCtx socket = forever $ do
(payload, addr) <- N.recvFrom socket 4096 (payload, addr) <- N.recvFrom socket 4096
@ -105,10 +113,10 @@ runUDPServer endPoint@(host, port) cnxTimeout app = do
case clientCtx of case clientCtx of
Just clientCtx' -> pushDataToClient clientCtx' payload Just clientCtx' -> pushDataToClient clientCtx' payload
_ -> void . forkIO $ bracket _ -> do
(addNewClient clientsCtx socket addr payload) clientCtx <- addNewClient clientsCtx socket addr payload
(removeClient clientsCtx) _ <- forkFinally (void . timeout cnxTimeout $ app clientCtx) (\_ -> removeClient clientsCtx clientCtx)
(void . timeout cnxTimeout . app) return ()
runSocks5Server :: Socks5.ServerSettings -> TunnelSettings -> (TunnelSettings -> N.AppData -> IO()) -> IO () runSocks5Server :: Socks5.ServerSettings -> TunnelSettings -> (TunnelSettings -> N.AppData -> IO()) -> IO ()