summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoe Crayne <joe@jerkface.net>2020-01-17 18:07:41 -0500
committerJoe Crayne <joe@jerkface.net>2020-01-25 19:18:12 -0500
commit938ef8b447e975a39121104b4206cd149a2f911e (patch)
treeb4c5680e48f4cc082ee46f7a206de8638a499c46
parent81489b13ee734bf5c618e1b826971725df8ed808 (diff)
Improved debug prints.
-rw-r--r--dht/src/Data/Tox/DHT/Multi.hs2
-rw-r--r--dht/src/Network/Tox.hs2
-rw-r--r--dht/src/Network/Tox/Session.hs17
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
149showSessionAddr (SessionUDP :=> Identity udp) = 149showSessionAddr (SessionUDP :=> Identity udp) =
150 show (SockAddr.canonize udp) 150 show (SockAddr.canonize udp)
151showSessionAddr (SessionTCP :=> Identity (ViaRelay mcon _ tcp)) = 151showSessionAddr (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.
185decryptPacket :: SessionKeys -> addr -> CryptoPacket Encrypted -> IO (Maybe (CryptoPacket Identity, ())) 186decryptPacket :: SessionKeys -> String -> CryptoPacket Encrypted -> IO (Maybe (CryptoPacket Identity, ()))
186decryptPacket sk saddr (CryptoPacket n16 ciphered) = do 187decryptPacket 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.
206encryptPacket :: SessionKeys -> CryptoData -> IO (CryptoPacket Encrypted) 207encryptPacket :: SessionKeys -> String -> CryptoData -> IO (CryptoPacket Encrypted)
207encryptPacket sk plain = do 208encryptPacket 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