From 687e06b39529bef04ecd49fc5e5b1b502a41b28d Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Fri, 18 Oct 2019 06:48:47 -0400
Subject: More thread cleanup.

---
 dht/examples/dhtd.hs                      |  4 +--
 dht/src/Network/BitTorrent/MainlineDHT.hs | 42 ++++++++++++++++++-------------
 dht/src/Network/Tox.hs                    |  8 +++---
 3 files changed, 31 insertions(+), 23 deletions(-)

(limited to 'dht')

diff --git a/dht/examples/dhtd.hs b/dht/examples/dhtd.hs
index c7fd4f06..da73159d 100644
--- a/dht/examples/dhtd.hs
+++ b/dht/examples/dhtd.hs
@@ -1667,7 +1667,7 @@ main = do
         "" -> return (return (), Map.empty,return [],[])
         p  -> do
             addr <- getBindAddress p (ip6bt opts)
-            (bt,btR,btBootstrap4, btBootstrap6) <- Mainline.newClient swarms addr
+            (bt,btR,btBootstrap4, btBootstrap6,quitBtClient) <- Mainline.newClient swarms addr
             quitBt <- forkListener "bt" (clientNet bt)
             mainlineSearches <- atomically $ newTVar Map.empty
             peerPort <- atomically $ newTVar 6881 -- BitTorrent client TCP port.
@@ -1748,7 +1748,7 @@ main = do
                                         [ Mainline.routing4 btR
                                         , Mainline.routing6 btR
                                         ]
-            return (quitBt,dhts,ips, [addr])
+            return (quitBt >> quitBtClient,dhts,ips, [addr])
 
     keysdb <- Tox.newKeysDatabase
 
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
-- 
cgit v1.2.3