From 1e193f42fb51ff2e32b80a1f8ca64df421c30dce Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Thu, 17 Oct 2019 22:48:46 -0400 Subject: Fixed resource-exhausted logic. --- dht/src/Network/StreamServer.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'dht/src/Network/StreamServer.hs') diff --git a/dht/src/Network/StreamServer.hs b/dht/src/Network/StreamServer.hs index 9a5b8593..1055eaad 100644 --- a/dht/src/Network/StreamServer.hs +++ b/dht/src/Network/StreamServer.hs @@ -7,6 +7,7 @@ module Network.StreamServer ( streamServer , ServerHandle + , getAcceptLoopThreadId , ServerConfig(..) , withSession , quitListening @@ -49,6 +50,10 @@ import DebugTag data ServerHandle = ServerHandle Socket (Weak ThreadId) +-- | Useful for testing. +getAcceptLoopThreadId :: ServerHandle -> IO (Weak ThreadId) +getAcceptLoopThreadId (ServerHandle _ t) = return t + listenSocket :: ServerHandle -> RestrictedSocket listenSocket (ServerHandle sock _) = restrictSocket sock @@ -149,15 +154,14 @@ acceptLoop cfg sock n = handle (acceptException cfg n sock) $ do acceptException :: ServerConfig -> Int -> Socket -> IOError -> IO () acceptException cfg n sock ioerror = do - Socket.close sock case show (ioeGetErrorType ioerror) of - "resource exhausted" -> do -- try again + "resource exhausted" -> do -- try again (ioeGetErrorType ioerror == fullErrorType) serverWarn cfg $ ("acceptLoop: resource exhasted") threadDelay 500000 acceptLoop cfg sock (n + 1) "invalid argument" -> do -- quit on closed socket - return () + Socket.close sock message -> do -- unexpected exception serverWarn cfg $ ("acceptLoop: "<>bshow message) - return () + Socket.close sock -- cgit v1.2.3