From 790ec8072f856247c0566b263ee9901bd1cde638 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Mon, 10 Dec 2018 10:19:41 -0500 Subject: Update TCP kademlia table. --- src/Network/Kademlia/Bootstrap.hs | 11 ++++++++++ src/Network/Tox.hs | 5 +++++ src/Network/Tox/TCP.hs | 44 +++++++++++++++++++++++++++------------ 3 files changed, 47 insertions(+), 13 deletions(-) (limited to 'src/Network') diff --git a/src/Network/Kademlia/Bootstrap.hs b/src/Network/Kademlia/Bootstrap.hs index 0f5d4e4d..1324ae77 100644 --- a/src/Network/Kademlia/Bootstrap.hs +++ b/src/Network/Kademlia/Bootstrap.hs @@ -424,3 +424,14 @@ touchBucket r@BucketRefresher{ refreshSearch modifyTVar' refreshQueue $ Int.insert num (now + interval) writeTVar refreshLastTouch now return action + +refreshKademlia :: SensibleNodeId nid ni => BucketRefresher nid ni -> Kademlia nid ni +refreshKademlia r@BucketRefresher { refreshSearch = sch + , refreshPing = ping + , refreshBuckets = bkts + } + = Kademlia quietInsertions (searchSpace sch) (vanillaIO bkts ping) + { tblTransition = \tr -> do + io <- touchBucket r tr + return io + } diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs index 1e82c0c4..ea9bbe56 100644 --- a/src/Network/Tox.hs +++ b/src/Network/Tox.hs @@ -59,6 +59,7 @@ import Network.Tox.NodeId import qualified Network.Tox.Onion.Handlers as Onion import qualified Network.Tox.Onion.Transport as Onion import Network.Tox.Transport +import Network.Tox.TCP (tcpClient) import OnionRouter import Network.Tox.ContactInfo import Text.XXD @@ -372,6 +373,8 @@ forkTox tox with_avahi = do quitOnion <- forkListener "toxOnion" (clientNet $ toxOnion tox) quitDHT <- forkListener "toxDHT" (clientNet $ toxDHT tox) quitNC <- forkListener "toxCrypto" (toxCrypto tox) + quitTCP <- forkListener "relay-client" (clientNet $ tcpClient $ tcpKademliaClient $ toxOnionRoutes tox) + tcpKademlia <- forkPollForRefresh (tcpBucketRefresher $ toxOnionRoutes tox) quitAvahi <- if with_avahi then do forkPollForRefresh (DHT.refresher4 $ toxRouting tox) forkPollForRefresh (DHT.refresher6 $ toxRouting tox) @@ -387,6 +390,8 @@ forkTox tox with_avahi = do quitNC quitDHT quitOnion + quitTCP + killThread tcpKademlia quitToRoute quitHs , bootstrap (DHT.refresher4 $ toxRouting tox) diff --git a/src/Network/Tox/TCP.hs b/src/Network/Tox/TCP.hs index 5c6456f6..353b5ea3 100644 --- a/src/Network/Tox/TCP.hs +++ b/src/Network/Tox/TCP.hs @@ -22,6 +22,7 @@ import Data.Word import qualified Data.Vector as Vector import Network.Socket (SockAddr(..)) import qualified Text.ParserCombinators.ReadP as RP +import System.IO.Error import Crypto.Tox import Data.ByteString (hPut,hGet,ByteString,length) @@ -95,7 +96,7 @@ nodeAddr ni = setPort (tcpPort ni) $ UDP.nodeAddr $ udpNodeInfo ni nodeIP :: NodeInfo -> IP nodeIP ni = UDP.nodeIP $ udpNodeInfo ni -tcpStream :: (Serialize y, Sized y, Serialize x, Sized x) => +tcpStream :: (Show y, Show x, Serialize y, Sized y, Serialize x, Sized x) => TransportCrypto -> StreamHandshake NodeInfo x y tcpStream crypto = StreamHandshake { streamHello = \addr h -> do @@ -112,28 +113,45 @@ tcpStream crypto = StreamHandshake } } noncef <- lookupNonceFunction crypto (transportSecret crypto) (UDP.id2key $ nodeId addr) + dput XTCP $ "TCP:" ++ show addr ++ " <-- " ++ show hello hPut h $ encode $ encryptPayload (noncef $ helloNonce hello) hello welcomeE <- withSize $ fmap decode . hGet h . constSize let Right welcome = welcomeE >>= \w -> decryptPayload (noncef $ welcomeNonce w) w + dput XTCP $ "TCP:" ++ show addr ++ " --> " ++ show welcome noncef' <- lookupNonceFunction crypto skey (sessionPublicKey $ runIdentity $ welcomeData welcome) nsend <- newMVar (sessionBaseNonce $ runIdentity $ helloData hello) nread <- newMVar (sessionBaseNonce $ runIdentity $ welcomeData welcome) let them = sessionPublicKey $ runIdentity $ welcomeData welcome return SessionProtocol - { streamGoodbye = return () -- No goodbye packet? Seems rude. - , streamDecode = do - decode <$> hGet h 2 >>= \case - Left _ -> return Nothing - Right len -> do - decode <$> hGet h (fromIntegral (len :: Word16)) >>= \case - Left _ -> return Nothing - Right x -> do - n24 <- takeMVar nread - let r = decrypt (noncef' n24) x >>= decodePlain - putMVar nread (incrementNonce24 n24) - return $ either (const Nothing) Just r + { streamGoodbye = do + dput XTCP $ "Closing " ++ show addr + return () -- No goodbye packet? Seems rude. + , streamDecode = + let go = decode <$> hGet h 2 >>= \case + Left e -> do + dput XTCP $ "TCP: Failed to get length: " ++ e + return Nothing + Right len -> do + decode <$> hGet h (fromIntegral (len :: Word16)) >>= \case + Left e -> do + dput XTCP $ "TCP: Failed to decode packet." + return Nothing + Right x -> do + n24 <- takeMVar nread + let r = decrypt (noncef' n24) x >>= decodePlain + putMVar nread (incrementNonce24 n24) + either (dput XTCP) + (\x' -> do + dput XTCP $ "TCP:" ++ show addr ++ " --> " ++ show x' + return ()) + r + return $ either (const Nothing) Just r + in go `catchIOError` \e -> do + dput XTCP $ "TCP exception: " ++ show e + return Nothing , streamEncode = \y -> do n24 <- takeMVar nsend + dput XTCP $ "TCP:" ++ show addr ++ " <-- " ++ show y let bs = encode $ encrypt (noncef' n24) $ encodePlain y hPut h $ encode (fromIntegral $ Data.ByteString.length bs :: Word16) <> bs -- cgit v1.2.3