From e07ea02e9ff5a1ad53c9554977e2feea566d5523 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Thu, 9 Jan 2020 15:32:47 -0500 Subject: Adjusted relay-related debug prints. --- dht/src/Network/Tox/Relay.hs | 56 ++++++++++++++++++++++++-------------------- 1 file changed, 31 insertions(+), 25 deletions(-) (limited to 'dht') diff --git a/dht/src/Network/Tox/Relay.hs b/dht/src/Network/Tox/Relay.hs index 22a692a9..dd150917 100644 --- a/dht/src/Network/Tox/Relay.hs +++ b/dht/src/Network/Tox/Relay.hs @@ -85,7 +85,7 @@ relaySession crypto clients cons sendOnion _ conid h = do -- mhello <- fmap (>>= \h -> decryptPayload (computeSharedSecret me (helloFrom h) (helloNonce h)) h) $ hGetSized h - dput XOnion $ "Relay client session conid=" ++ show conid + dput XRelay $ "Relay client session conid=" ++ show conid (hGetSized h >>=) $ mapM_ $ \helloE -> do let me = transportSecret crypto @@ -93,23 +93,23 @@ relaySession crypto clients cons sendOnion _ conid h = do noncef <- lookupNonceFunction crypto me them let mhello = decryptPayload (noncef $ helloNonce helloE) helloE - dput XOnion $ "Relay client (conid=" ++ show conid ++ ") decrypted hello = " ++ show mhello forM_ mhello $ \hello -> do let _ = hello :: Hello Identity - dput XOnion $ "Relay client sent hello. conid=" ++ show conid + -- dput XRelay $ "Relay client sent hello. conid=" ++ show conid (me',welcome) <- atomically $ do skey <- transportNewKey crypto dta <- HelloData (toPublic skey) <$> transportNewNonce crypto w24 <- transportNewNonce crypto return (skey, Welcome w24 $ pure dta) - dput XOnion $ unlines [ "Relay client to receive welcome. conid=" ++ show conid + {- + dput XRelay $ unlines [ "Relay to send welcome to client. conid=" ++ show conid , show welcome ] + -} B.hPut h $ encode $ encryptPayload (noncef $ welcomeNonce welcome) welcome - - dput XOnion $ "Relay client welcome sent. conid=" ++ show conid + dput XRelay $ "Relay welcomes (conid=" ++ show conid ++ ") " ++ showKey256 them noncef' <- let them' = sessionPublicKey (runIdentity $ helloData hello) in lookupNonceFunction crypto me' them' @@ -158,18 +158,18 @@ relaySession crypto clients cons sendOnion _ conid h = do `finally` do atomically $ modifyTVar' clients $ IntMap.delete conid disconnect cons (helloFrom hello) - dput XOnion $ "Relay client session closed. conid=" ++ show conid + dput XRelay $ "Relay client session closed. conid=" ++ show conid -handlePacket :: TVar (Map PublicKey (RelayPacket -> IO (), TVar RelaySession)) - -> Int - -> PublicKey +handlePacket :: TVar (Map PublicKey (RelayPacket -> IO (), TVar RelaySession)) -- ^ All sessions. + -> Int -- ^ TCP client number. + -> PublicKey -- ^ Public key of client. -> TransportCrypto - -> (SockAddr -> OnionRequest N1 -> IO ()) - -> (RelayPacket -> IO ()) - -> TVar RelaySession + -> (SockAddr -> OnionRequest N1 -> IO ()) -- ^ Forward onion packet. + -> (RelayPacket -> IO ()) -- ^ Send to this client. + -> TVar RelaySession -- ^ Session for this client. -> RelayPacket -> IO () -handlePacket cons thistcp me crypto sendOnion sendToMe session = \case +handlePacket cons thistcp thisKey crypto sendOnion sendToClient session = \case RoutingRequest them -> join $ atomically $ do mySession <- readTVar session mi <- case Map.lookup them (solicited mySession) of @@ -187,28 +187,33 @@ handlePacket cons thistcp me crypto sendOnion sendToMe session = \case mp <- Map.lookup them <$> readTVar cons forM mp $ \(sendToThem,peer) -> do theirSession <- readTVar peer - forM (Map.lookup me $ solicited theirSession) $ \reserved_id -> do - let sendToThem' f = sendToThem $ f $ key2c reserved_id - sendToMe' f = sendToMe $ f $ key2c i + forM (Map.lookup thisKey $ solicited theirSession) $ \reserved_id -> do + let sendToThem' f = sendToThem $ f $ key2c reserved_id + sendToClient' f = sendToClient $ f $ key2c i writeTVar peer theirSession - { solicited = Map.delete me (solicited theirSession) - , associated = IntMap.insert reserved_id sendToMe' (associated theirSession) + { solicited = Map.delete thisKey (solicited theirSession) + , associated = IntMap.insert reserved_id sendToClient' (associated theirSession) } writeTVar session mySession { solicited = Map.delete them (solicited mySession) , associated = IntMap.insert i sendToThem' (associated mySession) } - return $ do sendToThem' ConnectNotification - sendToMe' ConnectNotification - return $ do sendToMe $ RoutingResponse (maybe badcon key2c mi) them + return $ do + let showSession n k = "("++ show (key2c n) ++ ")" ++ showKey256 k + dput XRelay $ + "Relay session " ++ showSession reserved_id thisKey + ++ " <--> " ++ showSession i them + sendToThem' ConnectNotification + sendToClient' ConnectNotification + return $ do sendToClient $ RoutingResponse (maybe badcon key2c mi) them sequence_ notifyConnect - RelayPing x -> sendToMe $ RelayPong x -- TODO x==0 is invalid. Do we care? + RelayPing x -> sendToClient $ RelayPong x -- TODO x==0 is invalid. Do we care? OOBSend them bs -> do dput XRelay $ "OOB send to " ++ showKey256 them m <- atomically $ Map.lookup them <$> readTVar cons - forM_ m $ \(sendToThem,_) -> sendToThem $ OOBRecv me bs + forM_ m $ \(sendToThem,_) -> sendToThem $ OOBRecv thisKey bs RelayData bs con -> do mySession <- atomically $ readTVar session @@ -220,7 +225,8 @@ handlePacket cons thistcp me crypto sendOnion sendToMe session = \case i <- c2key con sendToThem' <- IntMap.lookup i $ associated mySession return $ sendToThem' $ RelayData bs - dput XRelay $ "RelayData to con " ++ show con ++ maybe "to no key" (\io -> "to an associatied key") mbSendIt + dput XRelay $ "RelayData from " ++ showKey256 thisKey ++ " to conid=" + ++ show con ++ maybe " (no key)" (\io -> " (associated key)") mbSendIt sequence_ mbSendIt OnionPacket n24 (Addressed addr req) -> do -- cgit v1.2.3