Your pseudo code doesn't look right although I couldn't completely understand
it. You need something like this:
{-# LANGUAGE ScopedTypeVariables #-}
import Network.Socket
import Control.Concurrent
import Control.Exception
acceptLoop :: Socket -> IO ()
acceptLoop sock =
mask_ loop
where
loop = do
-- only safe point in the loop for exceptions
allowInterrupt
(connected_sock, _) <- accept sock
-- use forkIOWithUnmask: we want the thread to be
interruptable no matter
-- what the inherited masking state is
_thr_id <- forkIOWithUnmask (handle_conn connected_sock)
loop
handle_conn connected_sock unmask =
-- register cleanup action, run the handler in interruptable state to be
-- able to kill the thread.
catch (unmask (handler connected_sock)) (\(_exc ::
SomeException) -> close connected_sock)
handler connected_sock =
-- fill here
return ()
Ömer
2017-10-25 8:52 GMT+03:00 Sumit Raja
Hi Ömer
You need to mask async exceptions between `accept()` and cleanup action registration, because an exception in between these operations will cause the socket to leak.
You can take a look at warp's accept loop:
https://github.com/yesodweb/wai/blob/master/warp/Network/Wai/Handler/Warp/Ru...
Trying to map steps for the code you've pointed me to in bad pseudo code:
finally (mask >> acceptLoop serverSocket) (close serverSocket)
acceptLoop = unmask sock <- accept serverSock mask forkIO $ do mask finally (unmask >> process sock) (close sock) acceptLoop
Is this correct?
Thanks Sumit