@@ -67,7 +67,7 @@ import Control.Exception
6767 , uninterruptibleMask_
6868 )
6969import qualified Control.Exception as Exception (Handler(..), catches, finally)
70−import Control.Concurrent (forkIO, forkIOWithUnmask, myThreadId)
70+import Control.Concurrent (forkIO, forkIOWithUnmask, killThread, myThreadId)
7171import Control.Distributed.Process.Internal.StrictMVar
7272 ( newMVar
7373 , withMVar
@@ -320,13 +320,17 @@ startServiceProcesses node = do
320320 sendChan ch ()
321321 ]
322322
323−-- | Force-close a local node
324−--
325−-- TODO: for now we just close the associated endpoint
323+-- | Force-close a local node, killing all processes on that node.
326324closeLocalNode :: LocalNode -> IO ()
327325closeLocalNode node = do
326+ withValidLocalState (localState node) $ \vst ->
327+ forM_ (vst ^. localProcesses) $ \lproc ->
328+ -- Semantics of 'throwTo' guarantee that target thread will get delivered
329+ -- an exception. Therefore, target thread will be killed eventually and
330+ -- that's as good as we can do. No need to wait for thread to actually
331+ -- finish dying.
332+ killThread (processThread lproc)
328333 modifyMVar_ (localState node) $ const $ return LocalNodeClosed
329− -- TODO: close all our processes, surely!?
330334 NT.closeEndPoint (localEndPoint node)
331335
332336-- | Run a process on a local node and wait for it to finish