2 files changed, 20 insertions, 14 deletions

diff --git a/dht/examples/dhtd.hs b/dht/examples/dhtd.hs
index adfe0d69..9c03a4f9 100644
--- a/dht/examples/dhtd.hs
+++ b/dht/examples/dhtd.hs
@@ -706,7 +706,7 @@ clientSession s@Session{..} sock cnum h = do
             tcp_spill <- readTVar (TCP.probeSpill $ tcpProber onionRouter)
             tcp_cache <- readTVar (TCP.probeCache $ tcpProber onionRouter)
             tcp_queue <- readTVar (TCP.probeQueue $ tcpProber onionRouter)
-            tcpmode <- readTVar (tcpMode onionRouter)
+            tcpmode <- requestTCPModeSTM onionRouter Nothing
             tcps <- readTVar (TCP.lru $ tcpProberState onionRouter)
             let showRecord :: Int -> Int -> [String]
                 showRecord n wanted_ver
@@ -734,13 +734,13 @@ clientSession s@Session{..} sock cnum h = do
 
         ("onion", s) | "udp" <- strp $ map toLower s
                      -> cmd0 $ do
-            atomically $ writeTVar (tcpMode onionRouter) False
-            hPutClient h "Onion routes: UDP."
+            tcpm <- requestTCPMode onionRouter (Just False)
+            hPutClient h $ "Onion routes: " ++ if tcpm then "TCP." else "UDP."
 
         ("onion", s) | "tcp" <- strp $ map toLower s
                      -> cmd0 $ do
-            atomically $ writeTVar (tcpMode onionRouter) True
-            hPutClient h "Onion routes: TCP."
+            tcpm <- requestTCPMode onionRouter (Just True)
+            hPutClient h $ "Onion routes: " ++ if tcpm then "TCP." else "UDP."
 
         ("g", s) | Just DHT{..} <- Map.lookup netname dhts
                     -> cmd0 $ do
@@ -1119,6 +1119,7 @@ data Options = Options
     , verbosity :: Int
     , verboseTags :: [DebugTag]
     , advertiseOnAvahi :: Bool
+    , enableTCPDHT :: Bool
     }
  deriving (Eq,Show)
 
@@ -1134,6 +1135,7 @@ sensibleDefaults = Options
     , verbosity   = 2
     , verboseTags = [XUnexpected, XUnused]
     , advertiseOnAvahi = True
+    , enableTCPDHT = True
     }
 
 data ShowHelp = ShowHelp
@@ -1145,6 +1147,7 @@ usage ShowHelp
                 ,["--dht-key ",dhtkey]],["Use ",dhtkey," as the dht key"])
              , ([["-4"]]               ,["Use IPv4 only"])
              , ([["--noavahi"]]        ,["Disable avahi advertising on LAN"])
+             , ([["--notcp"]]          ,["Disable TCP-relay server and client-based DHT"])
              , ([["-v ",tags]]         ,["Enable or disable specified DebugTags.\n        DebugTags = ", listDebugTags])
              ] ;
          dhtkey ="<dhtkey>" ;
@@ -1165,6 +1168,7 @@ parseArgs :: [String] -> Options -> Either ShowHelp Options
 parseArgs []              opts = Right opts
 parseArgs ("--help":args) opts = Left ShowHelp
 parseArgs ("--noavahi":args) opts = parseArgs args opts { advertiseOnAvahi = False }
+parseArgs ("--notcp":args) opts = parseArgs args opts { enableTCPDHT = False }
 parseArgs ("--dhtkey":k:args) opts = parseArgs args opts
     { dhtkey = decodeSecret $ B.pack k }
 parseArgs ("--dht-key":k:args) opts = parseArgs args opts
@@ -1384,9 +1388,9 @@ initTox opts ssvar keysdb mbxmpp invc = case porttox opts of
                                 Nothing   -> \_ _ _ -> return ()
                                 Just xmpp -> onNewToxSession xmpp ssvar invc)
                               crypto
-                              (\_ _ -> return ()) -- TODO: TCP relay send
+                              (enableTCPDHT opts)
             -- addrTox <- getBindAddress toxport (ip6tox opts)
-            (quitTox, toxStrap4, toxStrap6) <- Tox.forkTox tox (advertiseOnAvahi opts)
+            (quitTox, toxStrap4, toxStrap6) <- Tox.forkTox tox (advertiseOnAvahi opts) (enableTCPDHT opts)
 
             toxSearches <- atomically $ newTVar Map.empty
 
@@ -1592,9 +1596,11 @@ initTox opts ssvar keysdb mbxmpp invc = case porttox opts of
                 dhts = Map.fromList $
                         ("tox4", toxDHT Tox.routing4 Want_IP4)
                         : (if ip6tox opts
-                            then [ ("tox6", toxDHT Tox.routing6 Want_IP6) ]
+                            then ( ("tox6", toxDHT Tox.routing6 Want_IP6) :)
+                            else id)
+                          (if enableTCPDHT opts
+                            then [ ("toxtcp", tcpDHT) ]
                             else [])
-                        ++ [("toxtcp", tcpDHT)]
                 ips :: IO [SockAddr]
                 ips = readExternals Tox.nodeAddr [ Tox.routing4 $ Tox.toxRouting tox
                                                  , Tox.routing6 $ Tox.toxRouting tox ]
@@ -1777,7 +1783,7 @@ main = do
         let defaultToxData = do
                 rster <- Tox.newContactInfo
                 crypto <- newCrypto
-                (orouter,_) <- newOnionRouter crypto (dput XMisc)
+                (orouter,_) <- newOnionRouter crypto (dput XMisc) (enableTCPDHT opts)
                 return (rster, orouter)
         (rstr,orouter) <- fromMaybe defaultToxData $ do
             tox <- mbtox
diff --git a/dht/examples/testTox.hs b/dht/examples/testTox.hs
index 57601422..6db977be 100644
--- a/dht/examples/testTox.hs
+++ b/dht/examples/testTox.hs
@@ -48,7 +48,7 @@ makeToxNode udp sec onSessionF = do
                         onSessionF
                         crypto
                         udp
-                        (\_ _ -> return ())
+                        Nothing
 
 
 setToxID :: Tox () -> Maybe SecretKey -> IO ()
@@ -113,8 +113,8 @@ main = do
 
     -- b_sessions <- sessionChan b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk
 
-    (a_quit,_,_) <- forkTox a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf False
-    (b_quit,_,_) <- forkTox b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk False
+    (a_quit,_,_) <- forkTox a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf False False
+    (b_quit,_,_) <- forkTox b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk False False
 
     threadReport False >>= putStrLn
 
@@ -149,7 +149,7 @@ main = do
 
     -- sendMessage (toxHandshakes a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf) (nodeAddr b) hs
 
-    (b_quit,_,_) <- forkTox b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk False
+    (b_quit,_,_) <- forkTox b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk False False
 
     forkIO $ do
         tid <- myThreadId