diff options
author | Joe Crayne <joe@jerkface.net> | 2019-12-17 13:22:28 -0500 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2020-01-01 23:26:50 -0500 |
commit | 2425c1a5df23d7051461d8f9fd32b5d5aa03e104 (patch) | |
tree | fad9dc999a824ed7fd951241768682fdeffda04a /dht | |
parent | 0c9cf41d9cf8c0b908f38a3ccf66452d56c578e8 (diff) |
Schedule TCP chat-link session attempts.
Diffstat (limited to 'dht')
-rw-r--r-- | dht/ToxManager.hs | 35 | ||||
-rw-r--r-- | dht/examples/dhtd.hs | 9 | ||||
-rw-r--r-- | dht/src/Data/Tox/DHT/Multi.hs | 17 | ||||
-rw-r--r-- | dht/src/Data/Tox/Onion.hs | 5 | ||||
-rw-r--r-- | dht/src/Network/Tox/TCP.hs | 4 |
5 files changed, 52 insertions, 18 deletions
diff --git a/dht/ToxManager.hs b/dht/ToxManager.hs index 00e7146b..c4440409 100644 --- a/dht/ToxManager.hs +++ b/dht/ToxManager.hs | |||
@@ -277,6 +277,11 @@ nodeinfoStaleTime = 600 -- consider DHT node address stale after 10 minutes | |||
277 | nodeinfoSearchInterval :: POSIXTime | 277 | nodeinfoSearchInterval :: POSIXTime |
278 | nodeinfoSearchInterval = 15 -- when no address, search DHT node every 15 seconds | 278 | nodeinfoSearchInterval = 15 -- when no address, search DHT node every 15 seconds |
279 | 279 | ||
280 | |||
281 | cycled :: [x] -> [x] | ||
282 | cycled [] = [] | ||
283 | cycled (x:xs) = xs ++ [x] | ||
284 | |||
280 | connectViaRelay :: ToxToXMPP -> PublicKey -> Tox.DHTPublicKey | 285 | connectViaRelay :: ToxToXMPP -> PublicKey -> Tox.DHTPublicKey |
281 | -> Announcer -> AnnounceKey -> POSIXTime -> STM (IO ()) | 286 | -> Announcer -> AnnounceKey -> POSIXTime -> STM (IO ()) |
282 | connectViaRelay tx theirKey theirDhtKey ann tkey now = do | 287 | connectViaRelay tx theirKey theirDhtKey ann tkey now = do |
@@ -287,15 +292,28 @@ connectViaRelay tx theirKey theirDhtKey ann tkey now = do | |||
287 | established <- activeSesh tx theirKey | 292 | established <- activeSesh tx theirKey |
288 | return $ when (not established) go | 293 | return $ when (not established) go |
289 | where | 294 | where |
295 | myPublicKey = toPublic $ userSecret (txAccount tx) | ||
296 | me = key2id myPublicKey | ||
297 | tkey = akeyConnectTCP (txAnnouncer tx) me theirKey | ||
290 | go = do | 298 | go = do |
291 | let Tox.SendNodes ns = Tox.dhtpkNodes theirDhtKey | 299 | let Tox.SendNodes ns = Tox.dhtpkNodes theirDhtKey |
292 | mcon <- foldr (\action next -> action >>= maybe next (return . Just)) | 300 | mcon <- foldr (\action next -> action >>= maybe next (return . Just)) |
293 | (return Nothing) | 301 | (return Nothing) |
294 | $ map (\ni -> fmap ((,) ni) <$> TCP.tcpConnectionRequest (txTCP tx) theirKey ni) ns | 302 | $ map (Multi.tcpConnectionRequest (txTCP tx) theirKey) ns |
295 | forM_ mcon $ \(con,ni) -> do | 303 | forM_ mcon $ \ni -> do |
296 | return () | 304 | cookieRequest (toxCryptoKeys $ txTox tx) (toxDHT $ txTox tx) myPublicKey ni >>= \case |
297 | -- TODO: try connect tcp relays | 305 | Nothing -> return () |
298 | -- TODO: cookie;handshake | 306 | Just cookie -> do |
307 | cookieCreationStamp <- getPOSIXTime | ||
308 | let their_nid = key2id $ dhtpk theirDhtKey | ||
309 | dput XNetCrypto $ show their_nid ++ " --> cookie (TCP)" | ||
310 | hs <- cacheHandshake (toxHandshakeCache $ txTox tx) (userSecret (txAccount tx)) theirKey ni cookie | ||
311 | dput XNetCrypto $ show their_nid ++ "<-- handshake " ++ show (key2id theirKey) ++ " (TCP)" | ||
312 | sendMessage (toxHandshakes $ txTox tx) (Multi.sessionAddr ni) hs | ||
313 | atomically $ do | ||
314 | -- Try again in 5 seconds. | ||
315 | let theirDhtKey' = theirDhtKey' { Tox.dhtpkNodes = Tox.SendNodes (cycled ns) } | ||
316 | scheduleRel ann tkey (ScheduledItem $ connectViaRelay tx theirKey theirDhtKey') 5 | ||
299 | 317 | ||
300 | gotDhtPubkey :: Tox.DHTPublicKey -> ToxToXMPP -> PublicKey -> IO () | 318 | gotDhtPubkey :: Tox.DHTPublicKey -> ToxToXMPP -> PublicKey -> IO () |
301 | gotDhtPubkey theirDhtKey tx theirKey = do | 319 | gotDhtPubkey theirDhtKey tx theirKey = do |
@@ -318,7 +336,7 @@ gotDhtPubkey theirDhtKey tx theirKey = do | |||
318 | tkey = akeyConnectTCP (txAnnouncer tx) me theirKey | 336 | tkey = akeyConnectTCP (txAnnouncer tx) me theirKey |
319 | atomically $ registerNodeCallback (toxRouting tox) (nic akey) | 337 | atomically $ registerNodeCallback (toxRouting tox) (nic akey) |
320 | scheduleSearch (txAnnouncer tx) akey meth theirDhtKey | 338 | scheduleSearch (txAnnouncer tx) akey meth theirDhtKey |
321 | -- TODO atomically $ scheduleImmediately (txAnnouncer tx) tkey $ ScheduledItem $ connectViaRelay tx theirKey theirDhtKey | 339 | atomically $ scheduleImmediately (txAnnouncer tx) tkey $ ScheduledItem $ connectViaRelay tx theirKey theirDhtKey |
322 | 340 | ||
323 | target :: NodeId | 341 | target :: NodeId |
324 | target = key2id $ dhtpk theirDhtKey | 342 | target = key2id $ dhtpk theirDhtKey |
@@ -394,6 +412,9 @@ activeSesh tx theirKey = do | |||
394 | Just False -> return False | 412 | Just False -> return False |
395 | _ -> (== Established) <$> aggregateStatus c | 413 | _ -> (== Established) <$> aggregateStatus c |
396 | 414 | ||
415 | cookieMaxAge :: POSIXTime | ||
416 | cookieMaxAge = 60 * 5 | ||
417 | |||
397 | getCookie | 418 | getCookie |
398 | :: ToxToXMPP | 419 | :: ToxToXMPP |
399 | -> PublicKey | 420 | -> PublicKey |
@@ -428,8 +449,6 @@ getCookie tx theirKey theirDhtKey ni isActive getC ann akey now = getCookieAgain | |||
428 | reschedule n f = scheduleRel ann akey f n | 449 | reschedule n f = scheduleRel ann akey f n |
429 | reschedule' n f = reschedule n (ScheduledItem $ \_ _ now -> f now) | 450 | reschedule' n f = reschedule n (ScheduledItem $ \_ _ now -> f now) |
430 | 451 | ||
431 | cookieMaxAge = 60 * 5 | ||
432 | |||
433 | getCookieIO :: IO () | 452 | getCookieIO :: IO () |
434 | getCookieIO = do | 453 | getCookieIO = do |
435 | dput XNetCrypto $ show addr ++ " <-- request cookie" | 454 | dput XNetCrypto $ show addr ++ " <-- request cookie" |
diff --git a/dht/examples/dhtd.hs b/dht/examples/dhtd.hs index bd12821a..c01d50cd 100644 --- a/dht/examples/dhtd.hs +++ b/dht/examples/dhtd.hs | |||
@@ -1634,7 +1634,7 @@ initJabber :: Options | |||
1634 | -> Map.Map String DHT | 1634 | -> Map.Map String DHT |
1635 | -> MUC | 1635 | -> MUC |
1636 | -> IO ( Maybe XMPPServer | 1636 | -> IO ( Maybe XMPPServer |
1637 | , Maybe (Manager TCPStatus T.Text) | 1637 | , Maybe ConnectionManager -- (Manager (Either Pending TCPStatus) (Either T.Text T.Text)) |
1638 | , Maybe (PresenceState Pending) | 1638 | , Maybe (PresenceState Pending) |
1639 | , IO () -- quit chat thread | 1639 | , IO () -- quit chat thread |
1640 | ) | 1640 | ) |
@@ -1666,7 +1666,10 @@ initJabber opts ssvar announcer mbtox toxdhts toxchat = case portxmpp opts of | |||
1666 | let chats = Map.fromList [ ("local", chat) | 1666 | let chats = Map.fromList [ ("local", chat) |
1667 | , ("ngc", toxchat) ] | 1667 | , ("ngc", toxchat) ] |
1668 | xmpp_thread <- forkXmpp sv (presenceHooks state chats (verbosity opts) (Just cport) (Just sport)) | 1668 | xmpp_thread <- forkXmpp sv (presenceHooks state chats (verbosity opts) (Just cport) (Just sport)) |
1669 | conns <- xmppConnections sv | 1669 | let conns :: ConnectionManager -- Manager (Either Pending TCPStatus) (Either T.Text T.Text) |
1670 | conns = fromMaybe (ConnectionManager tcp) $ do | ||
1671 | sel <- tman | ||
1672 | Just $ ConnectionManager $ addManagers (selectManager (Just sel) tcp "auto.tox") tcp | ||
1670 | return (Just sv, Just conns, Just state, killThread xmpp_thread >> quitChatService) | 1673 | return (Just sv, Just conns, Just state, killThread xmpp_thread >> quitChatService) |
1671 | 1674 | ||
1672 | main :: IO () | 1675 | main :: IO () |
@@ -1818,7 +1821,7 @@ main = do | |||
1818 | , toxkeys = keysdb | 1821 | , toxkeys = keysdb |
1819 | , roster = rstr | 1822 | , roster = rstr |
1820 | , announceToLan = fromMaybe (return ()) $ Tox.toxAnnounceToLan <$> mbtox | 1823 | , announceToLan = fromMaybe (return ()) $ Tox.toxAnnounceToLan <$> mbtox |
1821 | , connectionManager = ConnectionManager <$> mconns | 1824 | , connectionManager = mconns |
1822 | , onionRouter = orouter | 1825 | , onionRouter = orouter |
1823 | , externalAddresses = liftM2 (++) btips toxips | 1826 | , externalAddresses = liftM2 (++) btips toxips |
1824 | , announcer = announcer | 1827 | , announcer = announcer |
diff --git a/dht/src/Data/Tox/DHT/Multi.hs b/dht/src/Data/Tox/DHT/Multi.hs index 3f91387c..f769e384 100644 --- a/dht/src/Data/Tox/DHT/Multi.hs +++ b/dht/src/Data/Tox/DHT/Multi.hs | |||
@@ -7,13 +7,14 @@ | |||
7 | {-# LANGUAGE TypeFamilies #-} | 7 | {-# LANGUAGE TypeFamilies #-} |
8 | module Data.Tox.DHT.Multi where | 8 | module Data.Tox.DHT.Multi where |
9 | 9 | ||
10 | import Crypto.PubKey.Curve25519 (PublicKey) | ||
10 | import qualified Network.Tox.NodeId as UDP | 11 | import qualified Network.Tox.NodeId as UDP |
11 | ;import Network.Tox.NodeId (NodeId) | 12 | ;import Network.Tox.NodeId (NodeId) |
12 | import qualified Network.Tox.TCP.NodeId as TCP | 13 | import qualified Network.Tox.TCP.NodeId as TCP |
13 | import Data.Tox.Relay | 14 | import Data.Tox.Relay hiding (NodeInfo) |
14 | import Network.Address (either4or6) | 15 | import Network.Address (either4or6) |
15 | import Network.Tox.TCP as TCP (ViaRelay(..)) | 16 | import Network.Tox.TCP as TCP (ViaRelay(..), tcpConnectionRequest_) |
16 | import Network.QueryResponse (Tagged(..)) | 17 | import Network.QueryResponse as QR (Tagged(..), Client) |
17 | 18 | ||
18 | import Data.Dependent.Sum | 19 | import Data.Dependent.Sum |
19 | import Data.GADT.Compare | 20 | import Data.GADT.Compare |
@@ -124,3 +125,13 @@ relayNodeId (ViaRelay _ nid _) = nid | |||
124 | udpNode :: DSum T Identity -> Maybe UDP.NodeInfo | 125 | udpNode :: DSum T Identity -> Maybe UDP.NodeInfo |
125 | udpNode (UDP :=> Identity ni) = Just ni | 126 | udpNode (UDP :=> Identity ni) = Just ni |
126 | udpNode _ = Nothing | 127 | udpNode _ = Nothing |
128 | |||
129 | sessionAddr :: DSum T Identity -> DSum S Identity | ||
130 | sessionAddr (UDP :=> Identity ni) = SessionUDP ==> UDP.nodeAddr ni | ||
131 | sessionAddr (TCP :=> Identity vr) = SessionTCP ==> vr | ||
132 | |||
133 | tcpConnectionRequest :: QR.Client err PacketNumber tid TCP.NodeInfo (Bool, RelayPacket) | ||
134 | -> PublicKey -> TCP.NodeInfo -> IO (Maybe NodeInfo) | ||
135 | tcpConnectionRequest client pubkey ni = do | ||
136 | mcon <- tcpConnectionRequest_ client pubkey ni | ||
137 | return $ fmap (\conid -> TCP ==> ViaRelay (Just conid) (UDP.key2id pubkey) ni) mcon | ||
diff --git a/dht/src/Data/Tox/Onion.hs b/dht/src/Data/Tox/Onion.hs index e19f71b6..a9bc4e1d 100644 --- a/dht/src/Data/Tox/Onion.hs +++ b/dht/src/Data/Tox/Onion.hs | |||
@@ -125,12 +125,12 @@ data OnionDestination r | |||
125 | = OnionToOwner | 125 | = OnionToOwner |
126 | { onionNodeInfo :: NodeInfo | 126 | { onionNodeInfo :: NodeInfo |
127 | , onionReturnPath :: ReturnPath N3 -- ^ Somebody else's path to us. | 127 | , onionReturnPath :: ReturnPath N3 -- ^ Somebody else's path to us. |
128 | } | 128 | } -- ^ incoming queries and outgoing responses |
129 | | OnionDestination | 129 | | OnionDestination |
130 | { onionAliasSelector' :: AliasSelector | 130 | { onionAliasSelector' :: AliasSelector |
131 | , onionNodeInfo :: NodeInfo | 131 | , onionNodeInfo :: NodeInfo |
132 | , onionRouteSpec :: Maybe r -- ^ Our own onion-path. | 132 | , onionRouteSpec :: Maybe r -- ^ Our own onion-path. |
133 | } | 133 | } -- ^ outgoing queries and incoming responses |
134 | deriving Show | 134 | deriving Show |
135 | 135 | ||
136 | onionAliasSelector :: OnionDestination r -> AliasSelector | 136 | onionAliasSelector :: OnionDestination r -> AliasSelector |
@@ -213,6 +213,7 @@ putOnionMsg (OnionToRoute pubkey a) = putOnionAsymm 0x85 (putPublicKey | |||
213 | putOnionMsg (OnionAnnounceResponse n8 n24 x) = put (0x84 :: Word8) >> put n8 >> put n24 >> put x | 213 | putOnionMsg (OnionAnnounceResponse n8 n24 x) = put (0x84 :: Word8) >> put n8 >> put n24 >> put x |
214 | putOnionMsg (OnionToRouteResponse a) = putOnionAsymm 0x86 (return ()) a | 214 | putOnionMsg (OnionToRouteResponse a) = putOnionAsymm 0x86 (return ()) a |
215 | 215 | ||
216 | -- | /r/ parameter for 'OnionDestination' | ||
216 | newtype RouteId = RouteId Int | 217 | newtype RouteId = RouteId Int |
217 | deriving Show | 218 | deriving Show |
218 | 219 | ||
diff --git a/dht/src/Network/Tox/TCP.hs b/dht/src/Network/Tox/TCP.hs index dc4c9967..c4727a20 100644 --- a/dht/src/Network/Tox/TCP.hs +++ b/dht/src/Network/Tox/TCP.hs | |||
@@ -292,9 +292,9 @@ tcpPing client dst = do | |||
292 | , method = PingPacket | 292 | , method = PingPacket |
293 | } | 293 | } |
294 | 294 | ||
295 | tcpConnectionRequest :: Client err PacketNumber tid addr (Bool, RelayPacket) | 295 | tcpConnectionRequest_ :: Client err PacketNumber tid addr (Bool, RelayPacket) |
296 | -> PublicKey -> addr -> IO (Maybe ConId) | 296 | -> PublicKey -> addr -> IO (Maybe ConId) |
297 | tcpConnectionRequest client pubkey ni = do | 297 | tcpConnectionRequest_ client pubkey ni = do |
298 | sendQuery client meth pubkey ni | 298 | sendQuery client meth pubkey ni |
299 | where | 299 | where |
300 | meth = MethodSerializer | 300 | meth = MethodSerializer |