diff options
Diffstat (limited to 'src/Network')
-rw-r--r-- | src/Network/Tox/Crypto/Handlers.hs | 24 | ||||
-rw-r--r-- | src/Network/Tox/Crypto/Transport.hs | 9 |
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 | |||
28 | import qualified Data.Array.Unboxed as A | 28 | import qualified Data.Array.Unboxed as A |
29 | import SensibleDir | 29 | import SensibleDir |
30 | import System.FilePath | 30 | import System.FilePath |
31 | import System.IO | ||
32 | import System.IO.Temp | 31 | import System.IO.Temp |
33 | import System.Environment | 32 | import System.Environment |
34 | import System.Directory | 33 | import 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 | |||
694 | lossyness (fromEnum -> 255) = Lossless | 695 | lossyness (fromEnum -> 255) = Lossless |
695 | lossyness _ = UnknownLossyness | 696 | lossyness _ = UnknownLossyness |
696 | 697 | ||
698 | isKillPacket :: MessageType -> Bool | ||
699 | isKillPacket (Msg KillPacket) = True | ||
700 | isKillPacket _ = False | ||
701 | |||
702 | isOFFLINE :: MessageType -> Bool | ||
703 | isOFFLINE (Msg OFFLINE) = True | ||
704 | isOFFLINE _ = False | ||
705 | |||
697 | -- TODO: Flesh this out. | 706 | -- TODO: Flesh this out. |
698 | data MessageID -- First byte indicates data | 707 | data 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) |