diff options
Diffstat (limited to 'dht')
-rw-r--r-- | dht/src/Data/Tox/DHT/Multi.hs | 2 | ||||
-rw-r--r-- | dht/src/Network/Tox.hs | 2 | ||||
-rw-r--r-- | dht/src/Network/Tox/Session.hs | 17 |
3 files changed, 12 insertions, 9 deletions
diff --git a/dht/src/Data/Tox/DHT/Multi.hs b/dht/src/Data/Tox/DHT/Multi.hs index 878b47e6..4067ab46 100644 --- a/dht/src/Data/Tox/DHT/Multi.hs +++ b/dht/src/Data/Tox/DHT/Multi.hs | |||
@@ -149,4 +149,4 @@ showSessionAddr :: SessionAddress -> String | |||
149 | showSessionAddr (SessionUDP :=> Identity udp) = | 149 | showSessionAddr (SessionUDP :=> Identity udp) = |
150 | show (SockAddr.canonize udp) | 150 | show (SockAddr.canonize udp) |
151 | showSessionAddr (SessionTCP :=> Identity (ViaRelay mcon _ tcp)) = | 151 | showSessionAddr (SessionTCP :=> Identity (ViaRelay mcon _ tcp)) = |
152 | "TCP:" ++ maybe "" (\(ConId con) -> "(" ++ show con ++ ")") mcon ++ show tcp | 152 | "TCP:" ++ maybe "(oob)" (\(ConId con) -> "(" ++ show con ++ ")") mcon ++ show tcp |
diff --git a/dht/src/Network/Tox.hs b/dht/src/Network/Tox.hs index 084a9978..0a6cccaa 100644 --- a/dht/src/Network/Tox.hs +++ b/dht/src/Network/Tox.hs | |||
@@ -357,6 +357,8 @@ newToxOverTransport keydb addr onNewSession (crypto,roster) udp tcp = do | |||
357 | Multi.SessionTCP :=> Identity (ViaRelay Nothing nid relay) | 357 | Multi.SessionTCP :=> Identity (ViaRelay Nothing nid relay) |
358 | -> do let relayclient = relayClient $ tcpRelayPinger orouter | 358 | -> do let relayclient = relayClient $ tcpRelayPinger orouter |
359 | msaddr <- Multi.tcpConnectionRequest relayclient (id2key nid) relay | 359 | msaddr <- Multi.tcpConnectionRequest relayclient (id2key nid) relay |
360 | when (isNothing msaddr) $ | ||
361 | dput XMan $ "Unable to establish relay connection!" | ||
360 | return $ maybe saddr Multi.sessionAddr msaddr | 362 | return $ maybe saddr Multi.sessionAddr msaddr |
361 | _ -> return saddr | 363 | _ -> return saddr |
362 | sendMessage handshakes saddr' hs | 364 | sendMessage handshakes saddr' hs |
diff --git a/dht/src/Network/Tox/Session.hs b/dht/src/Network/Tox/Session.hs index cbb516a7..457ed1a0 100644 --- a/dht/src/Network/Tox/Session.hs +++ b/dht/src/Network/Tox/Session.hs | |||
@@ -136,14 +136,15 @@ plainHandshakeH sp saddr0 skey handshake = do | |||
136 | (sessionKey hd) | 136 | (sessionKey hd) |
137 | <$> atomically (newTVar $ baseNonce hd) | 137 | <$> atomically (newTVar $ baseNonce hd) |
138 | <*> atomically (newTVar $ baseNonce hd_sent) | 138 | <*> atomically (newTVar $ baseNonce hd_sent) |
139 | m <- newSession (spSessions sp) (\() p -> return p) (decryptPacket sk) saddr | 139 | let addr_lbl = Multi.showSessionAddr saddr |
140 | m <- newSession (spSessions sp) (\() p -> return p) (\_ -> decryptPacket sk addr_lbl) saddr | ||
140 | dput XNetCrypto $ prelude ++ "plainHandshakeH: session " ++ maybe "Nothing" (const "Just") m | 141 | dput XNetCrypto $ prelude ++ "plainHandshakeH: session " ++ maybe "Nothing" (const "Just") m |
141 | forM_ m $ \(sid, t) -> do | 142 | forM_ m $ \(sid, t) -> do |
142 | (t2,resend,getMissing) | 143 | (t2,resend,getMissing) |
143 | <- lossless (take 8 (showKey256 them) ++ "." ++ Multi.showSessionAddr saddr) | 144 | <- lossless (take 8 (showKey256 them) ++ "." ++ Multi.showSessionAddr saddr) |
144 | (\cp a -> return $ fmap (,a) $ checkLossless $ runIdentity $ pktData cp) | 145 | (\cp a -> return $ fmap (,a) $ checkLossless $ runIdentity $ pktData cp) |
145 | (\seqno p@(Pkt m :=> _) _ -> do | 146 | (\seqno p@(Pkt m :=> _) _ -> do |
146 | y <- encryptPacket sk $ bookKeeping seqno p | 147 | y <- encryptPacket sk addr_lbl $ bookKeeping seqno p |
147 | return OutgoingInfo | 148 | return OutgoingInfo |
148 | { oIsLossy = lossyness m == Lossy | 149 | { oIsLossy = lossyness m == Lossy |
149 | , oEncoded = y | 150 | , oEncoded = y |
@@ -182,8 +183,8 @@ data SessionKeys = SessionKeys | |||
182 | } | 183 | } |
183 | 184 | ||
184 | -- | Decrypt an inbound session packet and update the nonce for the next one. | 185 | -- | Decrypt an inbound session packet and update the nonce for the next one. |
185 | decryptPacket :: SessionKeys -> addr -> CryptoPacket Encrypted -> IO (Maybe (CryptoPacket Identity, ())) | 186 | decryptPacket :: SessionKeys -> String -> CryptoPacket Encrypted -> IO (Maybe (CryptoPacket Identity, ())) |
186 | decryptPacket sk saddr (CryptoPacket n16 ciphered) = do | 187 | decryptPacket sk lbl (CryptoPacket n16 ciphered) = do |
187 | (n24,δ) <- atomically $ do | 188 | (n24,δ) <- atomically $ do |
188 | n <- readTVar (skNonceIncoming sk) | 189 | n <- readTVar (skNonceIncoming sk) |
189 | let δ = n16 - nonce24ToWord16 n | 190 | let δ = n16 - nonce24ToWord16 n |
@@ -198,13 +199,13 @@ decryptPacket sk saddr (CryptoPacket n16 ciphered) = do | |||
198 | do let them = key2id $ skThem sk | 199 | do let them = key2id $ skThem sk |
199 | CryptoData ack seqno _ = x | 200 | CryptoData ack seqno _ = x |
200 | cm = decodeRawCryptoMsg x | 201 | cm = decodeRawCryptoMsg x |
201 | dput XNetCrypto $ unwords [take 8 (show them),"-->",show (msgID cm),show (n24,ack,seqno)] | 202 | dput XNetCrypto $ unwords [lbl,"-->",show (msgID cm),show (n24,ack,seqno)] |
202 | 203 | ||
203 | return $ Just ( CryptoPacket n16 (pure x), () ) | 204 | return $ Just ( CryptoPacket n16 (pure x), () ) |
204 | 205 | ||
205 | -- | Encrypt an outbound session packet and update the nonce for the next one. | 206 | -- | Encrypt an outbound session packet and update the nonce for the next one. |
206 | encryptPacket :: SessionKeys -> CryptoData -> IO (CryptoPacket Encrypted) | 207 | encryptPacket :: SessionKeys -> String -> CryptoData -> IO (CryptoPacket Encrypted) |
207 | encryptPacket sk plain = do | 208 | encryptPacket sk lbl plain = do |
208 | n24 <- atomically $ do | 209 | n24 <- atomically $ do |
209 | n24 <- readTVar (skNonceOutgoing sk) | 210 | n24 <- readTVar (skNonceOutgoing sk) |
210 | modifyTVar' (skNonceOutgoing sk) incrementNonce24 | 211 | modifyTVar' (skNonceOutgoing sk) incrementNonce24 |
@@ -214,7 +215,7 @@ encryptPacket sk plain = do | |||
214 | 215 | ||
215 | do let them = key2id $ skThem sk | 216 | do let them = key2id $ skThem sk |
216 | CryptoData ack seqno cm = plain | 217 | CryptoData ack seqno cm = plain |
217 | dput XNetCrypto $ unwords [take 8 (show them),"<--",show (msgID cm),show (n24,ack,seqno)] | 218 | dput XNetCrypto $ unwords [lbl,"<--",show (msgID cm),show (n24,ack,seqno)] |
218 | 219 | ||
219 | return $ CryptoPacket (nonce24ToWord16 n24) ciphered | 220 | return $ CryptoPacket (nonce24ToWord16 n24) ciphered |
220 | 221 | ||