summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Data/PacketQueue.hs6
-rw-r--r--src/Network/Tox/Crypto/Handlers.hs4
-rw-r--r--src/Network/Tox/Crypto/Transport.hs13
3 files changed, 16 insertions, 7 deletions
diff --git a/src/Data/PacketQueue.hs b/src/Data/PacketQueue.hs
index 93f9ba14..6f997ac0 100644
--- a/src/Data/PacketQueue.hs
+++ b/src/Data/PacketQueue.hs
@@ -89,13 +89,11 @@ getMissing :: Show a => PacketQueue a -> STM [Word32]
89getMissing PacketQueue { pktq, seqno, qsize, buffend } = do 89getMissing PacketQueue { pktq, seqno, qsize, buffend } = do
90 seqno0 <- readTVar seqno 90 seqno0 <- readTVar seqno
91 buffend0 <- readTVar buffend 91 buffend0 <- readTVar buffend
92 -- tput XNetCrypto $ "getMissing: seqno = " ++ show seqno0
93 -- tput XNetCrypto $ "getMissing: buffend0 = " ++ show buffend0
94 -- note relying on fact that [ b .. a ] is null when a < b 92 -- note relying on fact that [ b .. a ] is null when a < b
95 let indices = take (fromIntegral qsize) $ map (`mod` qsize) [ seqno0 .. buffend0 - 1] 93 let indices = take (fromIntegral qsize) $ map (`mod` qsize) [ seqno0 .. buffend0 - 1]
96 -- tput XNetCrypto $ "indices: " ++ show indices 94 -- tput XNetCrypto $ "(netCRYPTO getMissing indices: " ++ show indices
97 maybes <- mapM (\i -> do {x <- readArray pktq i; return (i,x)}) indices 95 maybes <- mapM (\i -> do {x <- readArray pktq i; return (i,x)}) indices
98 -- tput XNetCrypto $ "getMissing: maybers = " ++ show maybes 96 tput XNetCrypto $ "(netCRYPTO) getMissing: (" ++ show seqno0 ++ " " ++ show buffend0 ++") => " ++ show maybes
99 let nums = map fst . filter (isNothing . snd) $ maybes 97 let nums = map fst . filter (isNothing . snd) $ maybes
100 return nums 98 return nums
101 99
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 82aa8f12..2e00d61b 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -1133,7 +1133,9 @@ sessionPacketH sessions addrRaw (CryptoPacket nonce16 encrypted) = do
1133 else do dput XNetCrypto $ "enqueue ncPacketQueue Lossless " ++ show cm 1133 else do dput XNetCrypto $ "enqueue ncPacketQueue Lossless " ++ show cm
1134 when (msgID cm == PING) $ 1134 when (msgID cm == PING) $
1135 dput XNetCrypto $ "NetCrypto Recieved PING (session " ++ show ncSessionId ++")" 1135 dput XNetCrypto $ "NetCrypto Recieved PING (session " ++ show ncSessionId ++")"
1136 when (msgID cm == PacketRequest) . atomically $ do 1136 when (msgID cm == PacketRequest) $ do
1137 dput XNetCrypto $ "PACKETREquest: " ++ showCryptoMsg bufferEnd cm
1138 atomically $ do
1137 num <- CB.getNextSequenceNum ncStoredRequests 1139 num <- CB.getNextSequenceNum ncStoredRequests
1138 CB.enqueue ncStoredRequests num cd 1140 CB.enqueue ncStoredRequests num cd
1139 atomically $ PQ.enqueue ncPacketQueue bufferEnd cd 1141 atomically $ PQ.enqueue ncPacketQueue bufferEnd cd
diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs
index 68e3d8e1..54d96c34 100644
--- a/src/Network/Tox/Crypto/Transport.hs
+++ b/src/Network/Tox/Crypto/Transport.hs
@@ -6,7 +6,8 @@
6{-# LANGUAGE TupleSections #-} 6{-# LANGUAGE TupleSections #-}
7{-# LANGUAGE StandaloneDeriving #-} 7{-# LANGUAGE StandaloneDeriving #-}
8module Network.Tox.Crypto.Transport 8module Network.Tox.Crypto.Transport
9 ( parseCrypto 9 ( showCryptoMsg
10 , parseCrypto
10 , encodeCrypto 11 , encodeCrypto
11 , unpadCryptoMsg 12 , unpadCryptoMsg
12 , createRequestPacket 13 , createRequestPacket
@@ -77,7 +78,13 @@ import Data.Text as T
77import Data.Text.Encoding as T 78import Data.Text.Encoding as T
78import Data.Serialize as S 79import Data.Serialize as S
79import Control.Arrow 80import Control.Arrow
81import DPut
82import Data.PacketQueue (toPNums)
83import Data.List
80 84
85showCryptoMsg :: Word32 -> CryptoMessage -> [Char]
86showCryptoMsg seqno (UpToN PacketRequest bytes) = "UpToN PacketRequest --> " ++ show (toPNums seqno $ B.unpack bytes)
87showCryptoMsg _ msg = show msg
81 88
82parseCrypto :: (ByteString, SockAddr) -> Either (CryptoPacket Encrypted, SockAddr) (ByteString, SockAddr) 89parseCrypto :: (ByteString, SockAddr) -> Either (CryptoPacket Encrypted, SockAddr) (ByteString, SockAddr)
83parseCrypto ((B.uncons -> Just (0x1b,pkt)),saddr) = either (\_ -> Right (pkt,saddr)) 90parseCrypto ((B.uncons -> Just (0x1b,pkt)),saddr) = either (\_ -> Right (pkt,saddr))
@@ -96,12 +103,14 @@ encodeHandshakes :: Handshake Encrypted -> SockAddr -> (ByteString, SockAddr)
96encodeHandshakes x saddr = (B.cons 0x1a (runPut $ put x),saddr) 103encodeHandshakes x saddr = (B.cons 0x1a (runPut $ put x),saddr)
97 104
98createRequestPacket :: Word32 -> [Word32] -> CryptoMessage 105createRequestPacket :: Word32 -> [Word32] -> CryptoMessage
99createRequestPacket seqno xs = UpToN PacketRequest (B.pack ns) 106createRequestPacket seqno xs = let r = UpToN PacketRequest (B.pack ns)
107 in dtrace XNetCrypto ("createRequestPacket " ++ show seqno ++ " " ++ show xs ++ " -----> " ++ show r) r
100 where 108 where
101 ys = Prelude.map (subtract (seqno - 1)) xs 109 ys = Prelude.map (subtract (seqno - 1)) xs
102 reduceToSums [] = [] 110 reduceToSums [] = []
103 reduceToSums (x:xs) = x:(reduceToSums $ Prelude.map (subtract x) xs) 111 reduceToSums (x:xs) = x:(reduceToSums $ Prelude.map (subtract x) xs)
104 makeZeroes :: Word32 -> [Word32] 112 makeZeroes :: Word32 -> [Word32]
113 -- makeZeroes 0 = []
105 makeZeroes x 114 makeZeroes x
106 = let (d,m)= x `divMod` 255 115 = let (d,m)= x `divMod` 255
107 zeros= Prelude.replicate (fromIntegral d) 0 116 zeros= Prelude.replicate (fromIntegral d) 0