[Haskell-cafe] Fwd: Safe TCP accept loop

[Ömer Sinan Ağacan]

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 <sumitraja at gmail.com>:
> 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/Run.hs#L211
>>
>
> 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