1 files changed, 16 insertions, 10 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