From c3af9eb007c96c7fe816cc428f1e37881241b48c Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Sat, 11 Jan 2020 21:27:43 -0500 Subject: WIP: efforts regarding tcp-mediated connections. --- dht/Announcer.hs | 5 ++++- dht/Announcer/Tox.hs | 2 +- dht/ToxManager.hs | 52 ++++++++++++++++++++++++++++++++++++---------------- 3 files changed, 41 insertions(+), 18 deletions(-) (limited to 'dht') diff --git a/dht/Announcer.hs b/dht/Announcer.hs index e7c0bcd2..bdbf5ecc 100644 --- a/dht/Announcer.hs +++ b/dht/Announcer.hs @@ -176,7 +176,10 @@ listener announcer = relisten Just cmd -> return $ handleCommand cmd Nothing -> do writeTVar (scheduled announcer) (Schedule queue') - (fmap (>> relisten) (fmap fork (f announcer k now))) + io <- f announcer k now + return $ do + forkLabeled ("announcer:item:"++unpackAnnounceKey announcer k) io + relisten where modifyScheduled f = modifyTVar (scheduled announcer) (Schedule . f . unSchedule) declareInactive = writeTVar (announcerActive announcer) False diff --git a/dht/Announcer/Tox.hs b/dht/Announcer/Tox.hs index 00eb219b..38e5bbfa 100644 --- a/dht/Announcer/Tox.hs +++ b/dht/Announcer/Tox.hs @@ -193,7 +193,7 @@ scheduleSearch announcer k SearchMethod{sSearch,sWithResult,sNearestNodes,sTarge mutex <- newMVar () -- This mutex insures one search at a time. let astate = AnnounceState st ns onResult sr = do - runAction announcer "with-search-result" $ do + runAction announcer ("search-result:"++unpackAnnounceKey announcer k) $ do got <- sWithResult r sr -- If we had a way to get the source of a search result, we might want to -- treat it similarly to an announcing node and remember it in the 'aStoringNodes' diff --git a/dht/ToxManager.hs b/dht/ToxManager.hs index 7d164b9d..4d8910e2 100644 --- a/dht/ToxManager.hs +++ b/dht/ToxManager.hs @@ -67,6 +67,7 @@ import GHC.Conc (labelThread) import Connection import Connection.Tcp (TCPStatus) import GHC.Conc (unsafeIOToSTM) +import System.IO.Error data Pending = ToxStatus ToxProgress | XMPPStatus TCPStatus @@ -288,31 +289,41 @@ connectViaRelay tx theirKey theirDhtKey ann tkey now = do Nothing -> return $ return () Just contact -> do established <- activeSesh tx theirKey + runAction ann "connectViaRelay-print" $ do + dput XMan $ "connectViaRelay("++unpackAnnounceKey ann tkey++") " ++ show established return $ when (not established) go + -- $ scheduleImmediately ann tkey $ ScheduledItem go + -- return $ return () where myPublicKey = toPublic $ userSecret (txAccount tx) me = key2id myPublicKey tkey = akeyConnectTCP (txAnnouncer tx) me theirKey go = do let Tox.SendNodes ns = Tox.dhtpkNodes theirDhtKey - mcons <- forM ns $ \ni -> do + mcons <- forM (filter (\n -> TCP.tcpPort n /= 0) ns) $ \ni -> do mcon <- Multi.tcpConnectionRequest (txTCP tx) (Tox.dhtpk theirDhtKey) ni return mcon let oobs = [ Multi.TCP ==> TCP.ViaRelay Nothing (Tox.key2id $ Tox.dhtpk theirDhtKey) ni | ni <- ns ] - forM_ (catMaybes mcons ++ oobs) $ \ni -> do - cookieRequest (toxCryptoKeys $ txTox tx) (toxDHT $ txTox tx) myPublicKey ni >>= \case - Nothing -> return () - Just cookie -> do - cookieCreationStamp <- getPOSIXTime - let their_nid = key2id $ dhtpk theirDhtKey - dput XMan $ show their_nid ++ " --> cookie (TCP)" - hs <- cacheHandshake (toxHandshakeCache $ txTox tx) (userSecret (txAccount tx)) theirKey ni cookie - 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. - let theirDhtKey' = theirDhtKey' { Tox.dhtpkNodes = Tox.SendNodes (cycled ns) } - scheduleRel ann tkey (ScheduledItem $ connectViaRelay tx theirKey theirDhtKey') 5 + addrs = catMaybes mcons ++ oobs + -- wait a sec to give connection requests a chance to be processed. + -- probably we should be handling ConnectNotification/DisconnectNotification + (\kont -> atomically $ scheduleRel ann tkey (ScheduledItem $ \_ _ _ -> return kont) 1) $ do + dput XMan $ "connectViaRelay: address count is " ++ show (length addrs) + forM_ addrs $ \ni -> do + cookieRequest (toxCryptoKeys $ txTox tx) (toxDHT $ txTox tx) myPublicKey ni >>= \case + Nothing -> dput XMan $ "connectViaRelay: no cookie from " ++ show ni + Just cookie -> do + cookieCreationStamp <- getPOSIXTime + let their_nid = key2id $ dhtpk theirDhtKey + dput XMan $ show their_nid ++ " --> cookie (TCP)" + hs <- cacheHandshake (toxHandshakeCache $ txTox tx) (userSecret (txAccount tx)) theirKey ni cookie + dput XMan $ show their_nid ++ "<-- handshake " ++ show (key2id theirKey) ++ " (TCP)" + sendMessage (toxHandshakes $ txTox tx) (Multi.sessionAddr ni) hs + dput XMan $ "connectViaRelay trying again in 5 seconds ... " + atomically $ do + -- Try again in 5 seconds. + let theirDhtKey' = theirDhtKey { Tox.dhtpkNodes = Tox.SendNodes (cycled ns) } + scheduleRel ann tkey (ScheduledItem $ connectViaRelay tx theirKey theirDhtKey') 5 gotDhtPubkey :: Tox.DHTPublicKey -> ToxToXMPP -> PublicKey -> IO () gotDhtPubkey theirDhtKey tx theirKey = do @@ -368,7 +379,11 @@ gotDhtPubkey theirDhtKey tx theirKey = do assume :: Show infosource => AnnounceKey -> POSIXTime -> infosource -> NodeInfo -> STM () assume akey time addr ni = do runAction (txAnnouncer tx) "rumor" $ do - dput XMan $ show ("rumor", showak akey, time, addr, ni) + dput XMan $ unlines + [ "Rumor " ++ showak akey + , " " ++ show addr + , " according to " ++ show ni + ] observe :: AnnounceKey -> POSIXTime -> NodeInfo -> STM () observe akey time ni@(nodeAddr -> addr) = do @@ -642,6 +657,11 @@ startConnecting0 tx them contact reason = do ++ take 8 (show $ key2id $ Tox.dhtpk dkey) ] sendMessage tr route (mypub,Tox.OnionDHTPublicKey dkey) + `catchIOError` \e -> do + dput XMan $ unlines + [ "Error sharing DHTKey to " ++ show route + , " " ++ show e + ] forM_ soliciting $ \cksum@(NoSpam nospam _)-> do dput XMan $ unwords [ take 8 (show $ key2id theirkey) , show (nodeAddr $ Tox.rendezvousNode rendezvous) -- cgit v1.2.3