From 36fb0de16a53b390d560ddbc74d4c72543088d92 Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 19 Jun 2018 12:02:03 -0400 Subject: network-2.6.3.4 added an MVar wait to Network.Socket.accept, so it is important to terminate the accept loop before closing the socket. --- src/Network/StreamServer.hs | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) (limited to 'src/Network') diff --git a/src/Network/StreamServer.hs b/src/Network/StreamServer.hs index 7fecc7aa..6a36ed00 100644 --- a/src/Network/StreamServer.hs +++ b/src/Network/StreamServer.hs @@ -36,10 +36,14 @@ import System.IO import Control.Monad import Control.Monad.Fix (fix) #ifdef THREAD_DEBUG -import Control.Concurrent.Lifted.Instrument (forkIO, threadDelay, ThreadId, mkWeakThreadId, labelThread, myThreadId) +import Control.Concurrent.Lifted.Instrument + ( forkIO, threadDelay, ThreadId, mkWeakThreadId, labelThread, myThreadId + , killThread ) #else import GHC.Conc (labelThread) -import Control.Concurrent (forkIO, threadDelay, ThreadId, mkWeakThreadId, myThreadId) +import Control.Concurrent + ( forkIO, threadDelay, ThreadId, mkWeakThreadId, myThreadId + , killThread ) #endif import Control.Exception (catch,handle,try,finally) import System.IO.Error (tryIOError) @@ -71,9 +75,10 @@ removeSocketFile _ = return () -- | Terminate the server accept-loop. Call this to shut down the server. quitListening :: ServerHandle -> IO () -quitListening (ServerHandle socket _) = +quitListening (ServerHandle socket acceptThread) = finally (Socket.getSocketName socket >>= removeSocketFile) - (Socket.close socket) + (do mapM_ killThread =<< deRefWeak acceptThread + Socket.close socket) -- | It's 'bshow' instead of 'show' to enable swapping in a 'ByteString' -- cgit v1.2.3