1 files changed, 29 insertions, 15 deletions

diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 7814046e..3860d309 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -21,6 +21,7 @@ import Control.Arrow
 import Control.Concurrent                     (MVar)
 import Control.Concurrent.STM
 import Control.Monad
+import Control.Monad.Fix
 import qualified Crypto.Cipher.ChaChaPoly1305 as Symmetric
 import qualified Crypto.Cipher.Salsa          as Salsa
 import qualified Crypto.Cipher.XSalsa         as XSalsa
@@ -94,6 +95,7 @@ import qualified Network.Tox.Onion.Handlers as Onion
 import Network.Tox.Crypto.Transport (NetCrypto)
 import Text.XXD
 import OnionRouter
+import Data.Word64Map (fitsInInt)
 
 newCrypto :: IO TransportCrypto
 newCrypto = do
@@ -158,7 +160,7 @@ newClient :: (DRG g, Show addr, Show meth) =>
                 -> (x -> MessageClass String meth DHT.TransactionId)
                 -> (Maybe addr -> IO addr)
                 -> (meth -> Maybe (MethodHandler String DHT.TransactionId addr x))
-                -> (forall d. TransactionMethods d DHT.TransactionId x -> TransactionMethods d DHT.TransactionId x)
+                -> (forall d. TransactionMethods d DHT.TransactionId addr x -> TransactionMethods d DHT.TransactionId addr x)
                 -> (Client String meth DHT.TransactionId addr x -> Transport String addr x -> Transport String addr x)
                 -> IO (Client String meth DHT.TransactionId addr x)
 newClient drg net classify selfAddr handlers modifytbl modifynet = do
@@ -180,11 +182,12 @@ newClient drg net classify selfAddr handlers modifytbl modifynet = do
                 , lookupHandler = handlers -- var
                 , tableMethods = modifytbl tbl
                 }
+        eprinter = printErrors stderr
         mkclient (tbl,var) handlers =
             let client = Client
-                    { clientNet           = addHandler (handleMessage client) $ modifynet client net
+                    { clientNet           = addHandler eprinter (handleMessage client) $ modifynet client net
                     , clientDispatcher    = dispatch tbl var handlers -- (fmap (contramapAddr (\(ToxPath ni _) -> ni)) . handlers)
-                    , clientErrorReporter = (printErrors stderr) { reportTimeout = reportTimeout ignoreErrors }
+                    , clientErrorReporter = eprinter { reportTimeout = reportTimeout ignoreErrors }
                     , clientPending       = var
                     , clientAddress       = selfAddr
                     , clientResponseId    = genNonce24 var
@@ -199,18 +202,22 @@ data Tox = Tox
     , toxRouting :: DHT.Routing
     , toxTokens :: TVar SessionTokens
     , toxAnnouncedKeys :: TVar Onion.AnnouncedKeys
+    , toxOnionRoutes :: OnionRouter
     }
 
-addVerbosity :: Show addr => Transport err addr ByteString -> Transport err addr ByteString
+isLocalHost (SockAddrInet _ host32) = (fromBE32 host32 == 0x7f000001)
+isLocalHost _                       = False
+
+addVerbosity :: Transport err SockAddr ByteString -> Transport err SockAddr ByteString
 addVerbosity tr =
     tr { awaitMessage = \kont -> awaitMessage tr $ \m -> do
             forM_ m $ mapM_ $ \(msg,addr) -> do
-                when (not (B.null msg || elem (B.head msg) [0,1,2,4])) $ do
+                when (isLocalHost addr || not (B.null msg || elem (B.head msg) [0,1,2,4,0x81,0x82,0x8c,0x8d])) $ do
                     mapM_ (\x -> hPutStrLn stderr ( (show addr) ++ " --> " ++ x))
                           $ xxd 0 msg
             kont m
        , sendMessage = \addr msg -> do
-            when (not (B.null msg || elem (B.head msg) [0,1,2,4])) $ do
+            when (isLocalHost addr || not (B.null msg || elem (B.head msg) [0,1,2,4,0x81,0x82,0x8c,0x8d])) $ do
                 mapM_ (\x -> hPutStrLn stderr ( (show addr) ++ " <-- " ++ x))
                       $ xxd 0 msg
             sendMessage tr addr msg
@@ -226,13 +233,15 @@ newTox keydb addr = do
     crypto <- newCrypto
     drg <- drgNew
     let lookupClose _ = return Nothing
-    routing <- DHT.newRouting addr crypto updateIP updateIP
-
-    (dhtcrypt,onioncrypt,cryptonet) <- toxTransport crypto (DHT.orouter routing) lookupClose udp
 
+    routing <- DHT.newRouting addr crypto updateIP updateIP
+    orouter <- newOnionRouter
+    (dhtcrypt,onioncrypt,cryptonet) <- toxTransport crypto orouter lookupClose udp
     let dhtnet0 = layerTransport (DHT.decrypt crypto) (DHT.encrypt crypto) dhtcrypt
     dhtclient <- newClient drg dhtnet0 DHT.classify (myAddr routing) (DHT.handlers routing) id
-                    $ \client net -> onInbound (DHT.updateRouting client routing) net
+                    $ \client net -> onInbound (DHT.updateRouting client routing orouter) net
+
+    orouter <- forkRouteBuilder orouter $ \nid ni -> maybe [] (\(_,ns,_)->ns) <$> DHT.getNodes dhtclient nid ni
 
     toks <- do
         nil <- nullSessionTokens
@@ -240,13 +249,14 @@ newTox keydb addr = do
     oniondrg <- drgNew
     let onionnet = layerTransport (Onion.decrypt crypto) (Onion.encrypt crypto) onioncrypt
     onionclient <- newClient oniondrg onionnet Onion.classify
-                    (const $ return
-                           $ either (const $ error "bad sockaddr")
-                                    (flip Onion.OnionDestination Nothing)
-                           $ nodeInfo zeroID addr)
+                    (const $ atomically
+                           $ flip Onion.OnionDestination Nothing
+                           . R.thisNode
+                           <$> readTVar (DHT.routing4 routing))
                     (Onion.handlers onionnet routing toks keydb)
-                    (hookQueries (DHT.orouter routing) DHT.transactionKey)
+                    (hookQueries orouter DHT.transactionKey)
                     (const id)
+
     return Tox
         { toxDHT = dhtclient
         , toxOnion = onionclient
@@ -254,8 +264,12 @@ newTox keydb addr = do
         , toxRouting = routing
         , toxTokens = toks
         , toxAnnouncedKeys = keydb
+        , toxOnionRoutes = orouter
         }
 
+onionTimeout :: Tox -> DHT.TransactionId -> Onion.OnionDestination RouteId -> STM (Onion.OnionDestination RouteId, Int)
+onionTimeout Tox { toxOnionRoutes = or } (DHT.TransactionId n8 _) od = lookupTimeout or n8 od
+
 forkTox :: Tox -> IO (IO ())
 forkTox tox = do
     _ <- forkListener "toxCrypto" (toxCrypto tox)