dhtBootstrap

1 files changed, 15 insertions, 18 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 7d3661e6..837cb210 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -195,6 +195,7 @@ data DHT = forall nid ni. ( Show     ni
     , dhtParseId       :: String -> Either String nid
     , dhtSearches      :: TVar (Map.Map (String,nid) (DHTSearch nid ni))
     , dhtFallbackNodes :: IO [ni]
+    , dhtBootstrap     :: [ni] -> [ni] -> IO ()
     }
 
 nodesFileName :: String -> String
@@ -1013,7 +1014,7 @@ main = do
         "" -> return (return (), Map.empty,return [],[])
         p  -> do
             addr <- getBindAddress p (ip6bt opts)
-            (bt,btR) <- Mainline.newClient swarms addr
+            (bt,btR,btBootstrap4, btBootstrap6) <- Mainline.newClient swarms addr
             quitBt <- forkListener "bt" (clientNet bt)
             mainlineSearches <- atomically $ newTVar Map.empty
             peerPort <- atomically $ newTVar 6881 -- BitTorrent client TCP port.
@@ -1083,6 +1084,9 @@ main = do
                                     [ {- TODO -}
                                     ]
                     , dhtSecretKey = return Nothing
+                    , dhtBootstrap = case wantip of
+                                        Want_IP4 -> btBootstrap4
+                                        Want_IP6 -> btBootstrap6
                     }
                 dhts = Map.fromList $
                         ("bt4", mainlineDHT Mainline.routing4 Want_IP4)
@@ -1107,11 +1111,11 @@ main = do
             addrTox <- getBindAddress toxport (ip6tox opts)
             hPutStrLn stderr $ "Supplied key: " ++ show (fmap (Tox.key2id . toPublic) (dhtkey opts))
             tox <- Tox.newTox keysdb addrTox (Just netCryptoSessionsState) (dhtkey opts)
-            quitTox <- Tox.forkTox tox
+            (quitTox, toxStrap4, toxStrap6) <- Tox.forkTox tox
 
             toxSearches <- atomically $ newTVar Map.empty
 
-            let toxDHT bkts = DHT
+            let toxDHT bkts wantip = DHT
                     { dhtBuckets = bkts (Tox.toxRouting tox)
                     , dhtPing    = Map.fromList
                                     [ ("ping", DHTPing
@@ -1262,11 +1266,14 @@ main = do
                                     [ {- TODO -}
                                     ]
                     , dhtSecretKey = return $ Just $ transportSecret (Tox.toxCryptoKeys tox)
+                    , dhtBootstrap = case wantip of
+                                        Want_IP4 -> toxStrap4
+                                        Want_IP6 -> toxStrap6
                     }
                 dhts = Map.fromList $
-                        ("tox4", toxDHT Tox.routing4)
+                        ("tox4", toxDHT Tox.routing4 Want_IP4)
                         : if ip6tox opts
-                            then [ ("tox6", toxDHT Tox.routing6) ]
+                            then [ ("tox6", toxDHT Tox.routing6 Want_IP6) ]
                             else []
                 ips :: IO [SockAddr]
                 ips = readExternals Tox.nodeAddr [ Tox.routing4 $ Tox.toxRouting tox
@@ -1309,7 +1316,8 @@ main = do
           $ \(netname, dht@DHT { dhtBuckets = bkts
                                , dhtQuery = qrys
                                , dhtPing = pings
-                               , dhtFallbackNodes = getBootstrapNodes }) -> do
+                               , dhtFallbackNodes = getBootstrapNodes
+                               , dhtBootstrap = bootstrap }) -> do
         btSaved <- loadNodes netname --  :: IO [Mainline.NodeInfo]
         putStrLn $ "Loaded "++show (length btSaved)++" nodes for "++netname++"."
         fallbackNodes <- getBootstrapNodes
@@ -1320,18 +1328,7 @@ main = do
                          $ Map.lookup "ping" pings
         fork $ do
             myThreadId >>= flip labelThread ("bootstrap."++netname)
-            case Map.lookup "node" qrys of
-                Just DHTQuery { qsearch = srch } -> do
-                    case eqT of
-                        Just witness -> let strapper = BucketRefresher
-                                                { refreshSearch = isNodesSearch witness srch
-                                                , refreshBuckets = bkts
-                                                , refreshPing = ping
-                                                }
-                                         in bootstrap strapper btSaved fallbackNodes
-                        _            -> error $ "Missing node-search for "++netname++"."
-                    saveNodes netname dht
-                Nothing -> return ()
+            bootstrap btSaved fallbackNodes
         return ()
 
     waitForSignal