diff options
author | Joe Crayne <joe@jerkface.net> | 2020-01-11 13:59:13 -0500 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2020-01-11 13:59:13 -0500 |
commit | f8ef399a959eaacf14c09e5bd0794de934f397eb (patch) | |
tree | 4bc690cfeb1a66eca04a6f69b41c4b9cffcffa4a /dht | |
parent | 0e3c922142177b093d90cba81d0b6712172e1f57 (diff) |
Reclassifying debug prints.
Diffstat (limited to 'dht')
-rw-r--r-- | dht/ToxManager.hs | 57 | ||||
-rw-r--r-- | dht/src/Data/Tox/Onion.hs | 4 | ||||
-rw-r--r-- | dht/src/DebugTag.hs | 4 | ||||
-rw-r--r-- | dht/src/Network/Tox.hs | 4 | ||||
-rw-r--r-- | dht/src/Network/Tox/Onion/Handlers.hs | 8 | ||||
-rw-r--r-- | 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 | |||
26 | import qualified Data.Set as Set | 26 | import qualified Data.Set as Set |
27 | import qualified Data.Text as T | 27 | import qualified Data.Text as T |
28 | ;import Data.Text (Text) | 28 | ;import Data.Text (Text) |
29 | import Data.Text.Encoding (decodeUtf8) | ||
29 | import Data.Time.Clock.POSIX | 30 | import Data.Time.Clock.POSIX |
30 | import qualified Data.Tox.DHT.Multi as Multi | 31 | import qualified Data.Tox.DHT.Multi as Multi |
31 | import Data.Word | 32 | import Data.Word |
@@ -304,9 +305,9 @@ connectViaRelay tx theirKey theirDhtKey ann tkey now = do | |||
304 | Just cookie -> do | 305 | Just cookie -> do |
305 | cookieCreationStamp <- getPOSIXTime | 306 | cookieCreationStamp <- getPOSIXTime |
306 | let their_nid = key2id $ dhtpk theirDhtKey | 307 | let their_nid = key2id $ dhtpk theirDhtKey |
307 | dput XNetCrypto $ show their_nid ++ " --> cookie (TCP)" | 308 | dput XMan $ show their_nid ++ " --> cookie (TCP)" |
308 | hs <- cacheHandshake (toxHandshakeCache $ txTox tx) (userSecret (txAccount tx)) theirKey ni cookie | 309 | hs <- cacheHandshake (toxHandshakeCache $ txTox tx) (userSecret (txAccount tx)) theirKey ni cookie |
309 | dput XNetCrypto $ show their_nid ++ "<-- handshake " ++ show (key2id theirKey) ++ " (TCP)" | 310 | dput XMan $ show their_nid ++ "<-- handshake " ++ show (key2id theirKey) ++ " (TCP)" |
310 | sendMessage (toxHandshakes $ txTox tx) (Multi.sessionAddr ni) hs | 311 | sendMessage (toxHandshakes $ txTox tx) (Multi.sessionAddr ni) hs |
311 | atomically $ do | 312 | atomically $ do |
312 | -- Try again in 5 seconds. | 313 | -- Try again in 5 seconds. |
@@ -315,7 +316,7 @@ connectViaRelay tx theirKey theirDhtKey ann tkey now = do | |||
315 | 316 | ||
316 | gotDhtPubkey :: Tox.DHTPublicKey -> ToxToXMPP -> PublicKey -> IO () | 317 | gotDhtPubkey :: Tox.DHTPublicKey -> ToxToXMPP -> PublicKey -> IO () |
317 | gotDhtPubkey theirDhtKey tx theirKey = do | 318 | gotDhtPubkey theirDhtKey tx theirKey = do |
318 | dput XNetCrypto $ unlines $ | 319 | dput XMan $ unlines $ |
319 | [ "Recieved DHTKey from " ++ show (Tox.key2id theirKey) | 320 | [ "Recieved DHTKey from " ++ show (Tox.key2id theirKey) |
320 | , " DHT: " ++ show target | 321 | , " DHT: " ++ show target |
321 | ] ++ let Tox.SendNodes ns = Tox.dhtpkNodes theirDhtKey | 322 | ] ++ let Tox.SendNodes ns = Tox.dhtpkNodes theirDhtKey |
@@ -365,13 +366,15 @@ gotDhtPubkey theirDhtKey tx theirKey = do | |||
365 | showak k = unpackAnnounceKey (txAnnouncer tx) k | 366 | showak k = unpackAnnounceKey (txAnnouncer tx) k |
366 | 367 | ||
367 | assume :: Show infosource => AnnounceKey -> POSIXTime -> infosource -> NodeInfo -> STM () | 368 | assume :: Show infosource => AnnounceKey -> POSIXTime -> infosource -> NodeInfo -> STM () |
368 | assume akey time addr ni = | 369 | assume akey time addr ni = do |
369 | tput XNodeinfoSearch $ show ("rumor", showak akey, time, addr, ni) | 370 | runAction (txAnnouncer tx) "rumor" $ do |
371 | dput XMan $ show ("rumor", showak akey, time, addr, ni) | ||
370 | 372 | ||
371 | observe :: AnnounceKey -> POSIXTime -> NodeInfo -> STM () | 373 | observe :: AnnounceKey -> POSIXTime -> NodeInfo -> STM () |
372 | observe akey time ni@(nodeAddr -> addr) = do | 374 | observe akey time ni@(nodeAddr -> addr) = do |
373 | tput XNodeinfoSearch $ show ("observation", showak akey, time, addr) | ||
374 | setContactAddr time theirKey ni (txAccount tx) | 375 | setContactAddr time theirKey ni (txAccount tx) |
376 | runAction (txAnnouncer tx) "observe" $ do | ||
377 | dput XMan $ show ("observation", showak akey, time, addr) | ||
375 | 378 | ||
376 | gotAddr :: NodeInfo -> ToxToXMPP -> PublicKey -> IO () | 379 | gotAddr :: NodeInfo -> ToxToXMPP -> PublicKey -> IO () |
377 | gotAddr ni@(nodeAddr -> addr) tx theirKey = do | 380 | gotAddr ni@(nodeAddr -> addr) tx theirKey = do |
@@ -435,7 +438,8 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain | |||
435 | addr = nodeAddr ni | 438 | addr = nodeAddr ni |
436 | hscache = toxHandshakeCache $ txTox tx | 439 | hscache = toxHandshakeCache $ txTox tx |
437 | getCookieAgain = do | 440 | getCookieAgain = do |
438 | tput XNodeinfoSearch $ show ("getCookieAgain", unpackAnnounceKey ann akey) | 441 | runAction (txAnnouncer tx) "getCookieAgain" $ do |
442 | dput XMan $ show ("getCookieAgain", unpackAnnounceKey ann akey) | ||
439 | mbContact <- getC | 443 | mbContact <- getC |
440 | case mbContact of | 444 | case mbContact of |
441 | Nothing -> return $ return () | 445 | Nothing -> return $ return () |
@@ -446,7 +450,7 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain | |||
446 | callRealShakeHands cookie = do | 450 | callRealShakeHands cookie = do |
447 | forM_ (nodeInfo (key2id $ dhtpk theirDhtKey) (nodeAddr ni)) $ \ni' -> do | 451 | forM_ (nodeInfo (key2id $ dhtpk theirDhtKey) (nodeAddr ni)) $ \ni' -> do |
448 | hs <- cacheHandshake hscache (userSecret (txAccount tx)) theirKey (Multi.UDP ==> ni') cookie | 452 | hs <- cacheHandshake hscache (userSecret (txAccount tx)) theirKey (Multi.UDP ==> ni') cookie |
449 | dput XNetCrypto $ show addr ++ "<-- handshake " ++ show (key2id theirKey) | 453 | dput XMan $ show addr ++ "<-- handshake " ++ show (key2id theirKey) |
450 | sendMessage (toxHandshakes $ txTox tx) (Multi.SessionUDP ==> nodeAddr ni) hs | 454 | sendMessage (toxHandshakes $ txTox tx) (Multi.SessionUDP ==> nodeAddr ni) hs |
451 | 455 | ||
452 | reschedule n f = scheduleRel ann akey f n | 456 | reschedule n f = scheduleRel ann akey f n |
@@ -454,7 +458,7 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain | |||
454 | 458 | ||
455 | getCookieIO :: IO () | 459 | getCookieIO :: IO () |
456 | getCookieIO = do | 460 | getCookieIO = do |
457 | dput XNetCrypto $ show addr ++ " <-- request cookie" | 461 | dput XMan $ show addr ++ " <-- request cookie" |
458 | let pending flag = setPendingCookie hscache myPublicKey theirKey flag | 462 | let pending flag = setPendingCookie hscache myPublicKey theirKey flag |
459 | atomically $ pending True | 463 | atomically $ pending True |
460 | cookieRequest (toxCryptoKeys $ txTox tx) (toxDHT $ txTox tx) myPublicKey (Multi.UDP ==> ni) >>= \case | 464 | 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 | |||
462 | pending False | 466 | pending False |
463 | reschedule' 5 (const getCookieAgain) | 467 | reschedule' 5 (const getCookieAgain) |
464 | Just cookie -> do | 468 | Just cookie -> do |
465 | dput XNetCrypto $ show addr ++ "--> cookie" | 469 | dput XMan $ show addr ++ "--> cookie" |
466 | atomically $ pending False | 470 | atomically $ pending False |
467 | void $ callRealShakeHands cookie | 471 | void $ callRealShakeHands cookie |
468 | cookieCreationStamp <- getPOSIXTime | 472 | cookieCreationStamp <- getPOSIXTime |
@@ -473,7 +477,7 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain | |||
473 | then return $ return () | 477 | then return $ return () |
474 | else if (now > cookieCreationStamp + cookieMaxAge) | 478 | else if (now > cookieCreationStamp + cookieMaxAge) |
475 | then return $ | 479 | then return $ |
476 | dput XNetCrypto "getCookieIO/shaker - cookie expired" >> | 480 | dput XMan "getCookieIO/shaker - cookie expired" >> |
477 | getCookieIO | 481 | getCookieIO |
478 | else do | 482 | else do |
479 | reschedule' 5 shaker | 483 | reschedule' 5 shaker |
@@ -481,30 +485,6 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain | |||
481 | atomically $ reschedule' 5 shaker | 485 | atomically $ reschedule' 5 shaker |
482 | 486 | ||
483 | 487 | ||
484 | {- | ||
485 | realShakeHands :: SecretKey -> PublicKey -> PublicKey -> Tox.NetCryptoSessions -> SockAddr -> Tox.Cookie Encrypted -> IO Bool | ||
486 | realShakeHands myseckey theirpubkey theirDhtKey allsessions saddr cookie = do | ||
487 | dput XUnused "realShakeHands" | ||
488 | let hp = | ||
489 | HParam | ||
490 | { hpOtherCookie = cookie | ||
491 | , hpMySecretKey = myseckey | ||
492 | , hpCookieRemotePubkey = theirpubkey | ||
493 | , hpCookieRemoteDhtkey = theirDhtKey | ||
494 | , hpTheirBaseNonce = Nothing | ||
495 | , hpTheirSessionKeyPublic = Nothing | ||
496 | } | ||
497 | newsession <- generateSecretKey | ||
498 | timestamp <- getPOSIXTime | ||
499 | (myhandshake, ioAction) <- | ||
500 | atomically $ | ||
501 | Tox.freshCryptoSession allsessions saddr newsession timestamp hp | ||
502 | ioAction | ||
503 | -- send handshake | ||
504 | isJust <$> forM myhandshake (Tox.sendHandshake allsessions saddr) | ||
505 | -} | ||
506 | |||
507 | |||
508 | 488 | ||
509 | dispatch :: ToxToXMPP -> ContactEvent -> IO () | 489 | dispatch :: ToxToXMPP -> ContactEvent -> IO () |
510 | dispatch tx (SessionEstablished theirKey ) = do stopConnecting tx theirKey "established" | 490 | dispatch tx (SessionEstablished theirKey ) = do stopConnecting tx theirKey "established" |
@@ -515,6 +495,11 @@ dispatch tx (PolicyChange theirkey TryingToConnect ) = startConnecting t | |||
515 | dispatch tx (PolicyChange theirkey policy ) = stopConnecting tx theirkey "policy" | 495 | dispatch tx (PolicyChange theirkey policy ) = stopConnecting tx theirkey "policy" |
516 | dispatch tx (OnionRouted theirKey (OnionDHTPublicKey pkey)) = gotDhtPubkey pkey tx theirKey | 496 | dispatch tx (OnionRouted theirKey (OnionDHTPublicKey pkey)) = gotDhtPubkey pkey tx theirKey |
517 | dispatch tx (OnionRouted theirkey (OnionFriendRequest fr) ) = do | 497 | dispatch tx (OnionRouted theirkey (OnionFriendRequest fr) ) = do |
498 | dput XMan $ unlines $ | ||
499 | [ "Recieved FriendRequest from " ++ show (Tox.key2id theirkey) | ||
500 | , " NoSpam: " ++ nospam16 (NoSpam (friendNoSpam fr) Nothing) | ||
501 | , " Text: " ++ T.unpack (decodeUtf8 $ friendRequestText fr) | ||
502 | ] | ||
518 | let ToxToXMPP { txAnnouncer = acr | 503 | let ToxToXMPP { txAnnouncer = acr |
519 | , txAccount = acnt | 504 | , txAccount = acnt |
520 | , txPresence = st } = tx | 505 | , txPresence = st } = tx |
@@ -686,8 +671,10 @@ stopConnecting ToxToXMPP{txAnnouncer=announcer,txAccount=acnt} them reason = do | |||
686 | let pub = toPublic $ userSecret acnt | 671 | let pub = toPublic $ userSecret acnt |
687 | me = key2id pub | 672 | me = key2id pub |
688 | akeyC = akeyConnect announcer me them | 673 | akeyC = akeyConnect announcer me them |
674 | akeyT = akeyConnectTCP announcer me them | ||
689 | akeyD = akeyDHTKeyShare announcer me them | 675 | akeyD = akeyDHTKeyShare announcer me them |
690 | cancel announcer akeyC | 676 | cancel announcer akeyC |
677 | cancel announcer akeyT | ||
691 | cancel announcer akeyD | 678 | cancel announcer akeyD |
692 | 679 | ||
693 | closeSessions :: NodeId{-me-} -> NodeId{-them-} -> TVar (Map.Map Uniq24 AggregateSession) -> IO () | 680 | 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 | |||
831 | Right (msg, addr) | 831 | Right (msg, addr) |
832 | case msg of | 832 | case msg of |
833 | OnionToRouteResponse {} -> case result of | 833 | OnionToRouteResponse {} -> case result of |
834 | Left e -> dput XOnion $ "Error decrypting data-to-route response: " ++ e | 834 | Left e -> dput XMan $ "Error decrypting data-to-route response: " ++ e |
835 | Right m -> dput XOnion $ "Decrypted data-to-route response: " ++ show (fst m) | 835 | Right m -> dput XMan $ "Decrypted data-to-route response: " ++ show (fst m) |
836 | _ -> return () | 836 | _ -> return () |
837 | return result | 837 | return result |
838 | 838 | ||
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 | |||
7 | = XAnnounce | 7 | = XAnnounce |
8 | | XAnnounceResponse | 8 | | XAnnounceResponse |
9 | | XBitTorrent | 9 | | XBitTorrent |
10 | | XDHT | ||
11 | | XLan | 10 | | XLan |
12 | | XMan | 11 | | XMan |
13 | | XNetCrypto | 12 | | XNetCrypto |
14 | | XNetCryptoOut | ||
15 | | XOnion | 13 | | XOnion |
16 | | XRelay | 14 | | XRelay |
17 | | XRoutes | 15 | | XRoutes |
18 | | XPing | 16 | | XPing |
19 | | XRefresh | ||
20 | | XJabber | 17 | | XJabber |
21 | | XTCP | 18 | | XTCP |
22 | | XMisc | 19 | | XMisc |
23 | | XNodeinfoSearch | ||
24 | | XUnexpected -- Used only for special anomalous errors that we didn't expect to happen. | 20 | | XUnexpected -- Used only for special anomalous errors that we didn't expect to happen. |
25 | | XUnused -- Never commit code that uses XUnused. | 21 | | XUnused -- Never commit code that uses XUnused. |
26 | deriving (Eq, Ord, Show, Read, Enum, Bounded,Typeable) | 22 | 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 | |||
266 | newTox keydb bindspecs onsess crypto usetcp = do | 266 | newTox keydb bindspecs onsess crypto usetcp = do |
267 | msock <- Bind.udpTransport' True bindspecs | 267 | msock <- Bind.udpTransport' True bindspecs |
268 | let failedBind = do | 268 | let failedBind = do |
269 | dput XDHT $ "tox udp bind error: " ++ show bindspecs | 269 | dput XMisc $ "tox udp bind error: " ++ show bindspecs |
270 | throwIO $ userError "Tox UDP listen port?" | 270 | throwIO $ userError "Tox UDP listen port?" |
271 | fromMaybe failedBind $ msock <&> \(udp,sock) -> do | 271 | fromMaybe failedBind $ msock <&> \(udp,sock) -> do |
272 | addr <- getSocketName sock | 272 | addr <- getSocketName sock |
273 | dput XOnion $ "UDP bind address: " ++ show addr | 273 | dput XMisc $ "UDP bind address: " ++ show addr |
274 | (relay,sendTCP) <- | 274 | (relay,sendTCP) <- |
275 | if usetcp then do | 275 | if usetcp then do |
276 | fmap (Just *** Just) $ tcpRelay (fst crypto) addr $ \a x -> do | 276 | 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 :: | |||
121 | -> IO () | 121 | -> IO () |
122 | dataToRouteH keydb udp _ (OnionToRoute pub asymm) = do | 122 | dataToRouteH keydb udp _ (OnionToRoute pub asymm) = do |
123 | let k = key2id pub | 123 | let k = key2id pub |
124 | dput XOnion $ "dataToRouteH "++ show k | 124 | dput XAnnounce $ "dataToRouteH "++ show k |
125 | mb <- atomically $ do | 125 | mb <- atomically $ do |
126 | ks <- readTVar keydb | 126 | ks <- readTVar keydb |
127 | forM (MinMaxPSQ.lookup' k (keyAssoc ks)) $ \(p,(cnt,rpath)) -> do | 127 | forM (MinMaxPSQ.lookup' k (keyAssoc ks)) $ \(p,(cnt,rpath)) -> do |
128 | writeTVar keydb $ ks { keyAssoc = MinMaxPSQ.insert' k (cnt + 1, rpath) p (keyAssoc ks) } | 128 | writeTVar keydb $ ks { keyAssoc = MinMaxPSQ.insert' k (cnt + 1, rpath) p (keyAssoc ks) } |
129 | return rpath | 129 | return rpath |
130 | dput XOnion $ "dataToRouteH "++ show (fmap (const ()) mb) | 130 | dput XAnnounce $ "dataToRouteH "++ show (fmap (const ()) mb) |
131 | forM_ mb $ \rpath -> do | 131 | forM_ mb $ \rpath -> do |
132 | -- forward | 132 | -- forward |
133 | dput XOnion $ "dataToRouteH sendMessage" | 133 | dput XAnnounce $ "dataToRouteH sendMessage" |
134 | sendMessage udp (toOnionDestination rpath) $ OnionToRouteResponse asymm | 134 | sendMessage udp (toOnionDestination rpath) $ OnionToRouteResponse asymm |
135 | dput XOnion $ "Forwarding data-to-route -->"++show k | 135 | dput XAnnounce $ "Forwarding data-to-route -->"++show k |
136 | 136 | ||
137 | type NodeDistance = NodeId | 137 | type NodeDistance = NodeId |
138 | 138 | ||
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 | |||
272 | b33445 <- getBindAddress "33445" True | 272 | b33445 <- getBindAddress "33445" True |
273 | bany <- getBindAddress "" True | 273 | bany <- getBindAddress "" True |
274 | h <- forkStreamServer ServerConfig | 274 | h <- forkStreamServer ServerConfig |
275 | { serverWarn = dput XOnion | 275 | { serverWarn = dput XMisc |
276 | , serverSession = relaySession crypto clients cons sendOnion | 276 | , serverSession = relaySession crypto clients cons sendOnion |
277 | } | 277 | } |
278 | [b443,b80,b3389,udp_addr,b33445,bany] | 278 | [b443,b80,b3389,udp_addr,b33445,bany] |