Debugging recvFrom termination.

1 files changed, 13 insertions, 2 deletions

diff --git a/dht/examples/dhtd.hs b/dht/examples/dhtd.hs
index 6bbb3388..287301d4 100644
--- a/dht/examples/dhtd.hs
+++ b/dht/examples/dhtd.hs
@@ -1773,8 +1773,10 @@ main = do
     (waitForSignal, checkQuit) <- do
         signalQuit <- atomically $ newTVar False
         let quitCommand = atomically $ writeTVar signalQuit True
-        installHandler sigTERM (CatchOnce (atomically $ writeTVar signalQuit True)) Nothing
-        installHandler sigINT (CatchOnce (atomically $ writeTVar signalQuit True)) Nothing
+        installHandler sigTERM (CatchOnce (do dput XMisc "sigTERM!"
+                                              atomically $ writeTVar signalQuit True)) Nothing
+        installHandler sigINT (CatchOnce (do dput XMisc "sigINT!"
+                                             atomically $ writeTVar signalQuit True)) Nothing
         let defaultToxData = do
                 rster <- Tox.newContactInfo
                 crypto <- newCrypto
@@ -1848,6 +1850,13 @@ main = do
     quitBt
     quitTox
 
+    -- dput XMisc "Raising sigINT"
+    -- raiseSignal sigINT
+    -- dput XMisc "Raising sigTERM"
+    -- raiseSignal sigTERM -- This shouldn't cause a termination because the signal handler is still installed.
+    --                     -- However, it will interrupt any dangling calls to recvFrom so that those threads
+    --                     -- can clean up.
+
     swarmsdb <- atomically $ readTVar (Mainline.contactInfo swarms)
     forM_ (Map.toList dhts) $ \(netname,dht) -> do
         saveNodes netname dht
@@ -1855,5 +1864,7 @@ main = do
     L.writeFile "bt-peers.dat" $ S.encodeLazy swarmsdb
     dput XMisc $ "Saved bt-peers.dat"
 
+    -- threadDelay 1000000
+
     s <- threadReport False
     putStrLn s