summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/Tox/Crypto/Handlers.hs24
-rw-r--r--src/Network/Tox/Crypto/Transport.hs9
2 files changed, 21 insertions, 12 deletions
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 4f53888b..50dd8c67 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -28,7 +28,6 @@ import qualified Data.Set as Set
28import qualified Data.Array.Unboxed as A 28import qualified Data.Array.Unboxed as A
29import SensibleDir 29import SensibleDir
30import System.FilePath 30import System.FilePath
31import System.IO
32import System.IO.Temp 31import System.IO.Temp
33import System.Environment 32import System.Environment
34import System.Directory 33import System.Directory
@@ -108,6 +107,7 @@ data NetCryptoSession = NCrypto
108 , ncView :: TVar SessionView 107 , ncView :: TVar SessionView
109 , ncPacketQueue :: PacketQueue CryptoData 108 , ncPacketQueue :: PacketQueue CryptoData
110 , ncBufferStart :: TVar Word32 109 , ncBufferStart :: TVar Word32
110 , ncDequeueThread :: Maybe ThreadId
111 , ncPingMachine :: Maybe PingMachine 111 , ncPingMachine :: Maybe PingMachine
112 , ncOutgoingQueue :: PQ.PacketOutQueue (State,Nonce24,TVar MsgOutMap) 112 , ncOutgoingQueue :: PQ.PacketOutQueue (State,Nonce24,TVar MsgOutMap)
113 CryptoMessage 113 CryptoMessage
@@ -364,24 +364,23 @@ freshCryptoSession sessions
364 , ncView = ncView0 364 , ncView = ncView0
365 , ncPacketQueue = pktq 365 , ncPacketQueue = pktq
366 , ncBufferStart = bufstart 366 , ncBufferStart = bufstart
367 , ncDequeueThread = Nothing -- error "you want the NetCrypto-Dequeue thread id, but is it started?"
367 , ncPingMachine = Nothing -- error "you want the NetCrypto-PingMachine, but is it started?" 368 , ncPingMachine = Nothing -- error "you want the NetCrypto-PingMachine, but is it started?"
368 , ncOutgoingQueue = pktoq 369 , ncOutgoingQueue = pktoq
369 } 370 }
370 371 -- launch dequeue thread
371 hooks <- atomically $ readTVar (announceNewSessionHooks sessions) 372 threadid <- forkIO $ do
372 373 tid <- myThreadId
373 -- Dequeue thread: 374 labelThread tid ("NetCryptoDequeue." ++ show (key2id remotePublicKey))
374 -- 375 fix $ \loop -> do
375 -- Hopefully, somebody will launch a thread to repeatedly call 376 cd <- atomically $ PQ.dequeue pktq
376 -- 'receiveCrypto' in order to dequeue messages from ncPacketQueue. 377 _ <- runCryptoHook (netCryptoSession0 {ncDequeueThread=Just tid}) cd
377 when (null hooks) $ do 378 loop
378 hPutStrLn stderr "Warning: Missing new-session handler. Lost session!"
379
380 -- launch ping thread 379 -- launch ping thread
381 fuzz <- randomRIO (0,2000) 380 fuzz <- randomRIO (0,2000)
382 pingMachine <- forkPingMachine ("NetCrypto." ++ show (key2id remotePublicKey)) (15000 + fuzz) 2000 381 pingMachine <- forkPingMachine ("NetCrypto." ++ show (key2id remotePublicKey)) (15000 + fuzz) 2000
383 -- update session with thread ids 382 -- update session with thread ids
384 let netCryptoSession = netCryptoSession0 {ncPingMachine=Just pingMachine} 383 let netCryptoSession = netCryptoSession0 {ncDequeueThread=Just threadid, ncPingMachine=Just pingMachine}
385 -- add this session to the lookup maps 384 -- add this session to the lookup maps
386 atomically $ do 385 atomically $ do
387 modifyTVar allsessions (Map.insert addr netCryptoSession) 386 modifyTVar allsessions (Map.insert addr netCryptoSession)
@@ -390,6 +389,7 @@ freshCryptoSession sessions
390 Nothing -> modifyTVar allsessionsByKey (Map.insert remotePublicKey [netCryptoSession]) 389 Nothing -> modifyTVar allsessionsByKey (Map.insert remotePublicKey [netCryptoSession])
391 Just xs -> modifyTVar allsessionsByKey (Map.insert remotePublicKey (netCryptoSession:xs)) 390 Just xs -> modifyTVar allsessionsByKey (Map.insert remotePublicKey (netCryptoSession:xs))
392 -- run announceNewSessionHooks 391 -- run announceNewSessionHooks
392 hooks <- atomically $ readTVar (announceNewSessionHooks sessions)
393 flip fix (hooks,netCryptoSession) $ \loop (hooks,session) -> 393 flip fix (hooks,netCryptoSession) $ \loop (hooks,session) ->
394 case hooks of 394 case hooks of
395 [] -> return () 395 [] -> return ()
diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs
index 3133ee9b..70405a3e 100644
--- a/src/Network/Tox/Crypto/Transport.hs
+++ b/src/Network/Tox/Crypto/Transport.hs
@@ -21,6 +21,7 @@ module Network.Tox.Crypto.Transport
21 , TypingStatus(..) 21 , TypingStatus(..)
22 , GroupChatId(..) 22 , GroupChatId(..)
23 , MessageType(..) 23 , MessageType(..)
24 , isKillPacket, isOFFLINE
24 , KnownLossyness(..) 25 , KnownLossyness(..)
25 , AsWord16(..) 26 , AsWord16(..)
26 , AsWord64(..) 27 , AsWord64(..)
@@ -694,6 +695,14 @@ lossyness (fromEnum -> x) | x >= 192, x < 255 = Lossy
694lossyness (fromEnum -> 255) = Lossless 695lossyness (fromEnum -> 255) = Lossless
695lossyness _ = UnknownLossyness 696lossyness _ = UnknownLossyness
696 697
698isKillPacket :: MessageType -> Bool
699isKillPacket (Msg KillPacket) = True
700isKillPacket _ = False
701
702isOFFLINE :: MessageType -> Bool
703isOFFLINE (Msg OFFLINE) = True
704isOFFLINE _ = False
705
697-- TODO: Flesh this out. 706-- TODO: Flesh this out.
698data MessageID -- First byte indicates data 707data MessageID -- First byte indicates data
699 = Padding -- ^ 0 padding (skipped until we hit a non zero (data id) byte) 708 = Padding -- ^ 0 padding (skipped until we hit a non zero (data id) byte)