diff options
author | joe <joe@jerkface.net> | 2018-06-19 12:02:03 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2018-06-19 12:02:03 -0400 |
commit | 36fb0de16a53b390d560ddbc74d4c72543088d92 (patch) | |
tree | 7888d870e72f7f9f7a9b5444c5870fffca55e0e4 /src/Network/StreamServer.hs | |
parent | b07524dc054e2ca2157f8e0920cdcb8b8b25e8e8 (diff) |
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.
Diffstat (limited to 'src/Network/StreamServer.hs')
-rw-r--r-- | src/Network/StreamServer.hs | 13 |
1 files changed, 9 insertions, 4 deletions
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 | |||
36 | import Control.Monad | 36 | import Control.Monad |
37 | import Control.Monad.Fix (fix) | 37 | import Control.Monad.Fix (fix) |
38 | #ifdef THREAD_DEBUG | 38 | #ifdef THREAD_DEBUG |
39 | import Control.Concurrent.Lifted.Instrument (forkIO, threadDelay, ThreadId, mkWeakThreadId, labelThread, myThreadId) | 39 | import Control.Concurrent.Lifted.Instrument |
40 | ( forkIO, threadDelay, ThreadId, mkWeakThreadId, labelThread, myThreadId | ||
41 | , killThread ) | ||
40 | #else | 42 | #else |
41 | import GHC.Conc (labelThread) | 43 | import GHC.Conc (labelThread) |
42 | import Control.Concurrent (forkIO, threadDelay, ThreadId, mkWeakThreadId, myThreadId) | 44 | import Control.Concurrent |
45 | ( forkIO, threadDelay, ThreadId, mkWeakThreadId, myThreadId | ||
46 | , killThread ) | ||
43 | #endif | 47 | #endif |
44 | import Control.Exception (catch,handle,try,finally) | 48 | import Control.Exception (catch,handle,try,finally) |
45 | import System.IO.Error (tryIOError) | 49 | import System.IO.Error (tryIOError) |
@@ -71,9 +75,10 @@ removeSocketFile _ = return () | |||
71 | 75 | ||
72 | -- | Terminate the server accept-loop. Call this to shut down the server. | 76 | -- | Terminate the server accept-loop. Call this to shut down the server. |
73 | quitListening :: ServerHandle -> IO () | 77 | quitListening :: ServerHandle -> IO () |
74 | quitListening (ServerHandle socket _) = | 78 | quitListening (ServerHandle socket acceptThread) = |
75 | finally (Socket.getSocketName socket >>= removeSocketFile) | 79 | finally (Socket.getSocketName socket >>= removeSocketFile) |
76 | (Socket.close socket) | 80 | (do mapM_ killThread =<< deRefWeak acceptThread |
81 | Socket.close socket) | ||
77 | 82 | ||
78 | 83 | ||
79 | -- | It's 'bshow' instead of 'show' to enable swapping in a 'ByteString' | 84 | -- | It's 'bshow' instead of 'show' to enable swapping in a 'ByteString' |