More thread cleanup.

1 files changed, 24 insertions, 18 deletions

diff --git a/dht/src/Network/BitTorrent/MainlineDHT.hs b/dht/src/Network/BitTorrent/MainlineDHT.hs
index 89851e88..af618ba4 100644
--- a/dht/src/Network/BitTorrent/MainlineDHT.hs
+++ b/dht/src/Network/BitTorrent/MainlineDHT.hs
@@ -545,6 +545,7 @@ newClient :: SwarmsDatabase -> SockAddr
           , Routing
           , [NodeInfo] -> [NodeInfo] -> IO ()
           , [NodeInfo] -> [NodeInfo] -> IO ()
+          , IO ()
           )
 newClient swarms addr = do
     udp <- udpTransport addr
@@ -577,7 +578,7 @@ newClient swarms addr = do
                                               (mkNodeInfo nid a)
                                               (R.defaultBucketCount)
                         writeTVar tblvar tbl
-                        writeTChan addrvar (a,map fst $ concat $ R.toList bkts)
+                        writeTChan addrvar $ Just (a,map fst $ concat $ R.toList bkts)
                     Nothing -> return ()
         committee4 <- newTriadCommittee $ updateIPVote tbl4 addr4
         committee6 <- newTriadCommittee $ updateIPVote tbl6 addr6
@@ -633,26 +634,26 @@ newClient swarms addr = do
             , clientResponseId    = return
             }
 
-    -- TODO: Provide some means of shutting down these five auxillary threads:
-
     fork $ fix $ \again -> do
         myThreadId >>= flip labelThread "addr4"
-        (addr, ns) <- atomically $ readTChan addr4
-        dput XBitTorrent $ "External IPv4: "++show (addr, length ns)
-        forM_ ns $ \n -> do
-            dput XBitTorrent $ "Change IP, ping: "++show n
-            ping outgoingClient n
-        -- TODO: trigger bootstrap ipv4
-        again
+        x <- atomically (readTChan addr4)
+        forM_ x $ \(addr, ns) -> do
+            dput XBitTorrent $ "External IPv4: "++show (addr, length ns)
+            forM_ ns $ \n -> do
+                dput XBitTorrent $ "Change IP, ping: "++show n
+                ping outgoingClient n
+            -- TODO: trigger bootstrap ipv4
+            again
     fork $ fix $ \again -> do
         myThreadId >>= flip labelThread "addr6"
-        (addr,ns) <- atomically $ readTChan addr6
-        dput XBitTorrent $ "External IPv6: "++show (addr, length ns)
-        forM_ ns $ \n -> do
-            dput XBitTorrent $ "Change IP, ping: "++show n
-            ping outgoingClient n
-        -- TODO: trigger bootstrap ipv6
-        again
+        x <- atomically (readTChan addr6)
+        forM_ x $ \(addr,ns) -> do
+            dput XBitTorrent $ "External IPv6: "++show (addr, length ns)
+            forM_ ns $ \n -> do
+                dput XBitTorrent $ "Change IP, ping: "++show n
+                ping outgoingClient n
+            -- TODO: trigger bootstrap ipv6
+            again
 
 
     refresh_thread4 <- forkPollForRefresh $ refresher4 routing
@@ -660,7 +661,12 @@ newClient swarms addr = do
 
     forkAnnouncedInfohashesGC (contactInfo swarms)
 
-    return (client, routing, bootstrap (refresher4 routing), bootstrap (refresher6 routing))
+    return (client, routing, bootstrap (refresher4 routing), bootstrap (refresher6 routing)
+           , do killThread refresh_thread4 -- TODO: Better termination mechanism.
+                killThread refresh_thread6 -- TODO: Better termination mechanism.
+                atomically $ writeTChan addr4 Nothing -- Terminate "addr4" thread.
+                atomically $ writeTChan addr6 Nothing -- Terminate "addr6" thread.
+                )
 
 -- Note that you should call .put() every hour for content that you want to
 -- keep alive, since nodes may discard data nodes older than 2 hours. (source: