More thread cleanup.

2 files changed, 29 insertions, 21 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:
diff --git a/dht/src/Network/Tox.hs b/dht/src/Network/Tox.hs
index 98c03b80..b396c2ea 100644
--- a/dht/src/Network/Tox.hs
+++ b/dht/src/Network/Tox.hs
@@ -414,9 +414,9 @@ forkTox tox with_avahi = do
     quitDHT     <- forkListener "toxDHT" (clientNet $ toxDHT tox)
     quitNC      <- forkListener "toxCrypto" (toxCrypto tox)
     quitTCP     <- forkListener "relay-client" (clientNet $ tcpClient $ tcpKademliaClient $ toxOnionRoutes tox)
+    refresher4 <- forkPollForRefresh (DHT.refresher4 $ toxRouting tox)
+    refresher6 <- forkPollForRefresh (DHT.refresher6 $ toxRouting tox)
     quitAvahi <- if with_avahi then do
-                    forkPollForRefresh (DHT.refresher4 $ toxRouting tox)
-                    forkPollForRefresh (DHT.refresher6 $ toxRouting tox)
                     dnssdIn <- forkIO $ queryToxService (dnssdDiscover tox)
                     dnssdOut <- forkIO $ dnssdAnnounce tox
                     labelThread dnssdIn  "tox-avahi-monitor"
@@ -424,7 +424,9 @@ forkTox tox with_avahi = do
                     return $ forM_ [dnssdIn,dnssdOut] killThread
                  else return $ return ()
     keygc <- Onion.forkAnnouncedKeysGC (toxAnnouncedKeys tox)
-    return ( do quitAvahi
+    return ( do killThread refresher4
+                killThread refresher6
+                quitAvahi
                 killThread keygc
                 quitNC
                 quitDHT