From f8ef399a959eaacf14c09e5bd0794de934f397eb Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Sat, 11 Jan 2020 13:59:13 -0500 Subject: Reclassifying debug prints. --- dht/ToxManager.hs | 57 ++++++++++++++--------------------- dht/src/Data/Tox/Onion.hs | 4 +-- dht/src/DebugTag.hs | 4 --- dht/src/Network/Tox.hs | 4 +-- dht/src/Network/Tox/Onion/Handlers.hs | 8 ++--- dht/src/Network/Tox/Relay.hs | 2 +- 6 files changed, 31 insertions(+), 48 deletions(-) diff --git a/dht/ToxManager.hs b/dht/ToxManager.hs index 4c67e853..7d164b9d 100644 --- a/dht/ToxManager.hs +++ b/dht/ToxManager.hs @@ -26,6 +26,7 @@ import Data.Ord import qualified Data.Set as Set import qualified Data.Text as T ;import Data.Text (Text) +import Data.Text.Encoding (decodeUtf8) import Data.Time.Clock.POSIX import qualified Data.Tox.DHT.Multi as Multi import Data.Word @@ -304,9 +305,9 @@ connectViaRelay tx theirKey theirDhtKey ann tkey now = do Just cookie -> do cookieCreationStamp <- getPOSIXTime let their_nid = key2id $ dhtpk theirDhtKey - dput XNetCrypto $ show their_nid ++ " --> cookie (TCP)" + dput XMan $ show their_nid ++ " --> cookie (TCP)" hs <- cacheHandshake (toxHandshakeCache $ txTox tx) (userSecret (txAccount tx)) theirKey ni cookie - dput XNetCrypto $ show their_nid ++ "<-- handshake " ++ show (key2id theirKey) ++ " (TCP)" + dput XMan $ show their_nid ++ "<-- handshake " ++ show (key2id theirKey) ++ " (TCP)" sendMessage (toxHandshakes $ txTox tx) (Multi.sessionAddr ni) hs atomically $ do -- Try again in 5 seconds. @@ -315,7 +316,7 @@ connectViaRelay tx theirKey theirDhtKey ann tkey now = do gotDhtPubkey :: Tox.DHTPublicKey -> ToxToXMPP -> PublicKey -> IO () gotDhtPubkey theirDhtKey tx theirKey = do - dput XNetCrypto $ unlines $ + dput XMan $ unlines $ [ "Recieved DHTKey from " ++ show (Tox.key2id theirKey) , " DHT: " ++ show target ] ++ let Tox.SendNodes ns = Tox.dhtpkNodes theirDhtKey @@ -365,13 +366,15 @@ gotDhtPubkey theirDhtKey tx theirKey = do showak k = unpackAnnounceKey (txAnnouncer tx) k assume :: Show infosource => AnnounceKey -> POSIXTime -> infosource -> NodeInfo -> STM () - assume akey time addr ni = - tput XNodeinfoSearch $ show ("rumor", showak akey, time, addr, ni) + assume akey time addr ni = do + runAction (txAnnouncer tx) "rumor" $ do + dput XMan $ show ("rumor", showak akey, time, addr, ni) observe :: AnnounceKey -> POSIXTime -> NodeInfo -> STM () observe akey time ni@(nodeAddr -> addr) = do - tput XNodeinfoSearch $ show ("observation", showak akey, time, addr) setContactAddr time theirKey ni (txAccount tx) + runAction (txAnnouncer tx) "observe" $ do + dput XMan $ show ("observation", showak akey, time, addr) gotAddr :: NodeInfo -> ToxToXMPP -> PublicKey -> IO () gotAddr ni@(nodeAddr -> addr) tx theirKey = do @@ -435,7 +438,8 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain addr = nodeAddr ni hscache = toxHandshakeCache $ txTox tx getCookieAgain = do - tput XNodeinfoSearch $ show ("getCookieAgain", unpackAnnounceKey ann akey) + runAction (txAnnouncer tx) "getCookieAgain" $ do + dput XMan $ show ("getCookieAgain", unpackAnnounceKey ann akey) mbContact <- getC case mbContact of Nothing -> return $ return () @@ -446,7 +450,7 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain callRealShakeHands cookie = do forM_ (nodeInfo (key2id $ dhtpk theirDhtKey) (nodeAddr ni)) $ \ni' -> do hs <- cacheHandshake hscache (userSecret (txAccount tx)) theirKey (Multi.UDP ==> ni') cookie - dput XNetCrypto $ show addr ++ "<-- handshake " ++ show (key2id theirKey) + dput XMan $ show addr ++ "<-- handshake " ++ show (key2id theirKey) sendMessage (toxHandshakes $ txTox tx) (Multi.SessionUDP ==> nodeAddr ni) hs reschedule n f = scheduleRel ann akey f n @@ -454,7 +458,7 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain getCookieIO :: IO () getCookieIO = do - dput XNetCrypto $ show addr ++ " <-- request cookie" + dput XMan $ show addr ++ " <-- request cookie" let pending flag = setPendingCookie hscache myPublicKey theirKey flag atomically $ pending True cookieRequest (toxCryptoKeys $ txTox tx) (toxDHT $ txTox tx) myPublicKey (Multi.UDP ==> ni) >>= \case @@ -462,7 +466,7 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain pending False reschedule' 5 (const getCookieAgain) Just cookie -> do - dput XNetCrypto $ show addr ++ "--> cookie" + dput XMan $ show addr ++ "--> cookie" atomically $ pending False void $ callRealShakeHands cookie cookieCreationStamp <- getPOSIXTime @@ -473,7 +477,7 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain then return $ return () else if (now > cookieCreationStamp + cookieMaxAge) then return $ - dput XNetCrypto "getCookieIO/shaker - cookie expired" >> + dput XMan "getCookieIO/shaker - cookie expired" >> getCookieIO else do reschedule' 5 shaker @@ -481,30 +485,6 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain atomically $ reschedule' 5 shaker -{- -realShakeHands :: SecretKey -> PublicKey -> PublicKey -> Tox.NetCryptoSessions -> SockAddr -> Tox.Cookie Encrypted -> IO Bool -realShakeHands myseckey theirpubkey theirDhtKey allsessions saddr cookie = do - dput XUnused "realShakeHands" - let hp = - HParam - { hpOtherCookie = cookie - , hpMySecretKey = myseckey - , hpCookieRemotePubkey = theirpubkey - , hpCookieRemoteDhtkey = theirDhtKey - , hpTheirBaseNonce = Nothing - , hpTheirSessionKeyPublic = Nothing - } - newsession <- generateSecretKey - timestamp <- getPOSIXTime - (myhandshake, ioAction) <- - atomically $ - Tox.freshCryptoSession allsessions saddr newsession timestamp hp - ioAction - -- send handshake - isJust <$> forM myhandshake (Tox.sendHandshake allsessions saddr) --} - - dispatch :: ToxToXMPP -> ContactEvent -> IO () dispatch tx (SessionEstablished theirKey ) = do stopConnecting tx theirKey "established" @@ -515,6 +495,11 @@ dispatch tx (PolicyChange theirkey TryingToConnect ) = startConnecting t dispatch tx (PolicyChange theirkey policy ) = stopConnecting tx theirkey "policy" dispatch tx (OnionRouted theirKey (OnionDHTPublicKey pkey)) = gotDhtPubkey pkey tx theirKey dispatch tx (OnionRouted theirkey (OnionFriendRequest fr) ) = do + dput XMan $ unlines $ + [ "Recieved FriendRequest from " ++ show (Tox.key2id theirkey) + , " NoSpam: " ++ nospam16 (NoSpam (friendNoSpam fr) Nothing) + , " Text: " ++ T.unpack (decodeUtf8 $ friendRequestText fr) + ] let ToxToXMPP { txAnnouncer = acr , txAccount = acnt , txPresence = st } = tx @@ -686,8 +671,10 @@ stopConnecting ToxToXMPP{txAnnouncer=announcer,txAccount=acnt} them reason = do let pub = toPublic $ userSecret acnt me = key2id pub akeyC = akeyConnect announcer me them + akeyT = akeyConnectTCP announcer me them akeyD = akeyDHTKeyShare announcer me them cancel announcer akeyC + cancel announcer akeyT cancel announcer akeyD closeSessions :: NodeId{-me-} -> NodeId{-them-} -> TVar (Map.Map Uniq24 AggregateSession) -> IO () diff --git a/dht/src/Data/Tox/Onion.hs b/dht/src/Data/Tox/Onion.hs index 86fc71f4..faff3cdf 100644 --- a/dht/src/Data/Tox/Onion.hs +++ b/dht/src/Data/Tox/Onion.hs @@ -831,8 +831,8 @@ decrypt crypto msg addr = do Right (msg, addr) case msg of OnionToRouteResponse {} -> case result of - Left e -> dput XOnion $ "Error decrypting data-to-route response: " ++ e - Right m -> dput XOnion $ "Decrypted data-to-route response: " ++ show (fst m) + Left e -> dput XMan $ "Error decrypting data-to-route response: " ++ e + Right m -> dput XMan $ "Decrypted data-to-route response: " ++ show (fst m) _ -> return () return result diff --git a/dht/src/DebugTag.hs b/dht/src/DebugTag.hs index 83f9b1f8..75d07ef8 100644 --- a/dht/src/DebugTag.hs +++ b/dht/src/DebugTag.hs @@ -7,20 +7,16 @@ data DebugTag = XAnnounce | XAnnounceResponse | XBitTorrent - | XDHT | XLan | XMan | XNetCrypto - | XNetCryptoOut | XOnion | XRelay | XRoutes | XPing - | XRefresh | XJabber | XTCP | XMisc - | XNodeinfoSearch | XUnexpected -- Used only for special anomalous errors that we didn't expect to happen. | XUnused -- Never commit code that uses XUnused. deriving (Eq, Ord, Show, Read, Enum, Bounded,Typeable) diff --git a/dht/src/Network/Tox.hs b/dht/src/Network/Tox.hs index 1a3bee79..a7e5d2c2 100644 --- a/dht/src/Network/Tox.hs +++ b/dht/src/Network/Tox.hs @@ -266,11 +266,11 @@ newTox :: TVar Onion.AnnouncedKeys -- ^ Store of announced keys we are a rende newTox keydb bindspecs onsess crypto usetcp = do msock <- Bind.udpTransport' True bindspecs let failedBind = do - dput XDHT $ "tox udp bind error: " ++ show bindspecs + dput XMisc $ "tox udp bind error: " ++ show bindspecs throwIO $ userError "Tox UDP listen port?" fromMaybe failedBind $ msock <&> \(udp,sock) -> do addr <- getSocketName sock - dput XOnion $ "UDP bind address: " ++ show addr + dput XMisc $ "UDP bind address: " ++ show addr (relay,sendTCP) <- if usetcp then do fmap (Just *** Just) $ tcpRelay (fst crypto) addr $ \a x -> do diff --git a/dht/src/Network/Tox/Onion/Handlers.hs b/dht/src/Network/Tox/Onion/Handlers.hs index 8db1c534..ca7d47db 100644 --- a/dht/src/Network/Tox/Onion/Handlers.hs +++ b/dht/src/Network/Tox/Onion/Handlers.hs @@ -121,18 +121,18 @@ dataToRouteH :: -> IO () dataToRouteH keydb udp _ (OnionToRoute pub asymm) = do let k = key2id pub - dput XOnion $ "dataToRouteH "++ show k + dput XAnnounce $ "dataToRouteH "++ show k mb <- atomically $ do ks <- readTVar keydb forM (MinMaxPSQ.lookup' k (keyAssoc ks)) $ \(p,(cnt,rpath)) -> do writeTVar keydb $ ks { keyAssoc = MinMaxPSQ.insert' k (cnt + 1, rpath) p (keyAssoc ks) } return rpath - dput XOnion $ "dataToRouteH "++ show (fmap (const ()) mb) + dput XAnnounce $ "dataToRouteH "++ show (fmap (const ()) mb) forM_ mb $ \rpath -> do -- forward - dput XOnion $ "dataToRouteH sendMessage" + dput XAnnounce $ "dataToRouteH sendMessage" sendMessage udp (toOnionDestination rpath) $ OnionToRouteResponse asymm - dput XOnion $ "Forwarding data-to-route -->"++show k + dput XAnnounce $ "Forwarding data-to-route -->"++show k type NodeDistance = NodeId diff --git a/dht/src/Network/Tox/Relay.hs b/dht/src/Network/Tox/Relay.hs index 66ab4b71..b315648a 100644 --- a/dht/src/Network/Tox/Relay.hs +++ b/dht/src/Network/Tox/Relay.hs @@ -272,7 +272,7 @@ tcpRelay crypto udp_addr sendOnion = do b33445 <- getBindAddress "33445" True bany <- getBindAddress "" True h <- forkStreamServer ServerConfig - { serverWarn = dput XOnion + { serverWarn = dput XMisc , serverSession = relaySession crypto clients cons sendOnion } [b443,b80,b3389,udp_addr,b33445,bany] -- cgit v1.2.3