diff options
-rw-r--r-- | dht-client.cabal | 2 | ||||
-rw-r--r-- | src/Network/Tox/Crypto/Handlers.hs | 20 | ||||
-rw-r--r-- | src/Network/Tox/Crypto/Transport.hs | 2 |
3 files changed, 21 insertions, 3 deletions
diff --git a/dht-client.cabal b/dht-client.cabal index 3169cabd..a6860acf 100644 --- a/dht-client.cabal +++ b/dht-client.cabal | |||
@@ -142,7 +142,7 @@ library | |||
142 | PingMachine | 142 | PingMachine |
143 | Connection | 143 | Connection |
144 | ToxToXMPP | 144 | ToxToXMPP |
145 | ToxManager | 145 | ToxManager |
146 | 146 | ||
147 | build-depends: base | 147 | build-depends: base |
148 | , containers | 148 | , containers |
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs index 3336052b..5192e180 100644 --- a/src/Network/Tox/Crypto/Handlers.hs +++ b/src/Network/Tox/Crypto/Handlers.hs | |||
@@ -768,9 +768,21 @@ runUponHandshake netCryptoSession0 addr pktoq = do | |||
768 | sendSessionPacket sessions addr pkt | 768 | sendSessionPacket sessions addr pkt |
769 | loop | 769 | loop |
770 | dput XNetCrypto $ "runUponHandshake: " ++ show threadidOutgoing ++ " = NetCryptoDequeueOutgoing." ++ show (key2id remotePublicKey) | 770 | dput XNetCrypto $ "runUponHandshake: " ++ show threadidOutgoing ++ " = NetCryptoDequeueOutgoing." ++ show (key2id remotePublicKey) |
771 | -- launch ping thread | 771 | -- launch ping Machine thread |
772 | fuzz <- randomRIO (0,2000) | 772 | fuzz <- randomRIO (0,2000) |
773 | pingMachine <- forkPingMachine ("NetCrypto." ++ show (key2id remotePublicKey)) (15000 + fuzz) 2000 | 773 | pingMachine <- forkPingMachine ("NetCrypto." ++ show (key2id remotePublicKey)) (15000 + fuzz) 2000 |
774 | pingThreadId <- forkIO $ do | ||
775 | tid <- myThreadId | ||
776 | event <- atomically $ pingWait pingMachine | ||
777 | labelThread tid ("NetCryptoPingSender." ++ show (key2id remotePublicKey) ++ "." ++ show (ncSessionId netCryptoSession0)) | ||
778 | case event of | ||
779 | PingIdle -> do | ||
780 | dput XNetCrypto $ "pingThread (session: " ++ show (ncSessionId netCryptoSession0) ++ ") PingIdle" | ||
781 | lr <- sendPing crypto netCryptoSession0 | ||
782 | case lr of | ||
783 | Left s -> dput XNetCrypto $ "(pingThread session: " ++ show (ncSessionId netCryptoSession0) ++ ") " ++ s | ||
784 | Right _ -> return () | ||
785 | PingTimeOut -> dput XNetCrypto $ "(pingThread session: " ++ show (ncSessionId netCryptoSession0) ++ ") PingTimeOut TODO" | ||
774 | -- update session with thread ids | 786 | -- update session with thread ids |
775 | let netCryptoSession = netCryptoSession0 {ncDequeueThread=Just threadid, ncPingMachine=Just pingMachine} | 787 | let netCryptoSession = netCryptoSession0 {ncDequeueThread=Just threadid, ncPingMachine=Just pingMachine} |
776 | -- add this session to the lookup maps | 788 | -- add this session to the lookup maps |
@@ -1173,6 +1185,12 @@ sendCrypto crypto session updateLocal cm = do | |||
1173 | PQ.OGFull -> return (Left "Outgoing packet buffer is full") | 1185 | PQ.OGFull -> return (Left "Outgoing packet buffer is full") |
1174 | PQ.OGEncodeFail -> return (Left "Failed to encode outgoing packet") | 1186 | PQ.OGEncodeFail -> return (Left "Failed to encode outgoing packet") |
1175 | 1187 | ||
1188 | sendPing :: TransportCrypto -> NetCryptoSession -> IO (Either String ()) | ||
1189 | sendPing crypto session = do | ||
1190 | let cm=OneByte PING | ||
1191 | addMsgToLastN False (cm ^. messageType) session (Out cm) | ||
1192 | sendCrypto crypto session (return ()) (OneByte PING) | ||
1193 | |||
1176 | sendOnline :: TransportCrypto -> NetCryptoSession -> IO (Either String ()) | 1194 | sendOnline :: TransportCrypto -> NetCryptoSession -> IO (Either String ()) |
1177 | sendOnline crypto session = do | 1195 | sendOnline crypto session = do |
1178 | let cm=OneByte ONLINE | 1196 | let cm=OneByte ONLINE |
diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs index 73143e35..ce3bafee 100644 --- a/src/Network/Tox/Crypto/Transport.hs +++ b/src/Network/Tox/Crypto/Transport.hs | |||
@@ -734,7 +734,7 @@ data MessageID -- First byte indicates data | |||
734 | | UnspecifiedPacket013 | 734 | | UnspecifiedPacket013 |
735 | | UnspecifiedPacket014 | 735 | | UnspecifiedPacket014 |
736 | | UnspecifiedPacket015 | 736 | | UnspecifiedPacket015 |
737 | | MessengerLossless016 -- ^ 16+ reserved for Messenger usage (lossless packets) | 737 | | PING -- ^ 16+ reserved for Messenger usage (lossless packets) |
738 | | MessengerLossless017 | 738 | | MessengerLossless017 |
739 | | MessengerLossless018 | 739 | | MessengerLossless018 |
740 | | MessengerLossless019 | 740 | | MessengerLossless019 |