From 185d22daefbfb5a10789121baf6b4aaf35a7535b Mon Sep 17 00:00:00 2001 From: James Crayne Date: Tue, 19 Jun 2018 23:50:08 +0000 Subject: cleanup code for netcrypto sessions --- src/Network/Tox/Crypto/Handlers.hs | 63 ++++++++++++++++++++++++++++++++++++-- 1 file changed, 60 insertions(+), 3 deletions(-) (limited to 'src/Network/Tox/Crypto/Handlers.hs') diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs index c5c17e4e..d174b10c 100644 --- a/src/Network/Tox/Crypto/Handlers.hs +++ b/src/Network/Tox/Crypto/Handlers.hs @@ -345,6 +345,7 @@ data NetCryptoSession = NCrypto -- ^ when the thread which dequeues from ncPacketQueue -- is started, its ThreadId is stored here , ncPingMachine :: Maybe PingMachine + , ncPingThread :: Maybe ThreadId -- ^ when the ping thread is started, store it here , ncOutgoingQueue :: TVar (UponHandshake @@ -622,6 +623,7 @@ freshCryptoSession sessions , ncPacketQueue = pktq , ncDequeueThread = Nothing -- error "you want the NetCrypto-Dequeue thread id, but is it started?" , ncPingMachine = Nothing -- error "you want the NetCrypto-PingMachine, but is it started?" + , ncPingThread = Nothing -- error "you want the NetCrypto-PingSender, but is it started?" , ncOutgoingQueue = mbpktoqVar , ncLastNMsgs = lastNQ , ncListeners = listeners @@ -754,7 +756,9 @@ runUponHandshake netCryptoSession0 addr pktoq = do Right _ -> return () PingTimeOut -> dput XNetCrypto $ "(pingThread session: " ++ show (ncSessionId netCryptoSession0) ++ ") PingTimeOut TODO" -- update session with thread ids - let netCryptoSession = netCryptoSession0 {ncDequeueThread=Just threadid, ncPingMachine=Just pingMachine} + let netCryptoSession = netCryptoSession0 { ncDequeueThread=Just threadid + , ncPingMachine=Just pingMachine + , ncPingThread=Just pingThreadId} -- add this session to the lookup maps -- atomically $ addSessionToMapIfNotThere sessions addr netCryptoSession -- run announceNewSessionHooks @@ -770,6 +774,23 @@ runUponHandshake netCryptoSession0 addr pktoq = do Just f -> loop (hs, f session) Nothing -> return () +destroySession :: NetCryptoSession -> IO () +destroySession session = do + let allsessions = ncAllSessions session + sid = ncSessionId session + stopThread :: Maybe ThreadId -> IO () + stopThread x = maybe (return ()) killThread x + stopMachine :: Maybe PingMachine -> IO () + stopMachine x = maybe (return ()) pingCancel x + atomically $ do + modifyTVar (netCryptoSessionsByKey allsessions) + $ Map.map (filter ((/=sid) . ncSessionId)) + modifyTVar (netCryptoSessions allsessions) + $ Map.filterWithKey (\k v -> ncSessionId v /= sid) + stopThread (ncPingThread session) + stopMachine (ncPingMachine session) + stopThread (ncDequeueThread session) + -- | Called when we get a handshake, but there's already a session entry. -- -- 1) duplicate packet ... ignore @@ -1130,8 +1151,37 @@ sendOffline crypto session = do sendKill :: TransportCrypto -> NetCryptoSession -> IO (Either String ()) sendKill crypto session = do let cm=OneByte KillPacket - addMsgToLastN False (cm ^. messageType) session (Out cm) - sendCrypto crypto session (return ()) cm + mbOutQ <- atomically $ readTVar (ncOutgoingQueue session) + case mbOutQ of + NeedHandshake -> do + let errmsg="NetCrypto NOT SENDING Kill packet (sessionid: " ++ show (ncSessionId session) ++ ") since no handshake yet" + dput XNetCrypto errmsg + dput XNetCrypto $ "Destroying session anyway" + destroySession session + return (Left errmsg) + HaveHandshake outq -> do + dput XNetCrypto $ "NetCrypto sending Kill packet (sessionid: " ++ show (ncSessionId session) ++ ")" + getOutGoingParam <- PQ.readyOutGoing outq + mbPkt <- atomically $ PQ.peekPacket getOutGoingParam outq cm + case mbPkt of + Nothing -> do + let errmsg = "Error sending kill packet! (sessionid: " ++ show (ncSessionId session) ++ ")" + dput XNetCrypto errmsg + dput XNetCrypto $ "Destroying session anyway" + Right <$> destroySession session + return (Left errmsg) + Just (pkt,seqno) -> do + case (ncSockAddr session) of + NeedDHTKey -> do + let errmsg= "NetCrypto NOT SENDING Kill packet (sessionid: " ++ show (ncSessionId session) ++ ") since no DHTkey(sockaddr) yet" + dput XNetCrypto errmsg + dput XNetCrypto $ "Destroying session anyway" + Right <$> destroySession session + return (Left errmsg) + HaveDHTKey saddr -> do + sendSessionPacket (ncAllSessions session) saddr pkt + dput XNetCrypto $ "sent kill packet (sessionid: " ++ show (ncSessionId session) ++ ")... now destroying session..." + Right <$> destroySession session setNick :: TransportCrypto -> NetCryptoSession -> ByteString -> IO (Either String ()) setNick crypto session nick = do @@ -1207,8 +1257,15 @@ defaultCryptoDataHooks , (Msg TYPING,[defaultTypingHook]) , (Msg NICKNAME, [defaultNicknameHook]) , (Msg STATUSMESSAGE, [defaultStatusMsgHook]) + , (Msg KillPacket, [defaultKillHook]) ] +defaultKillHook :: NetCryptoSession -> CryptoMessage -> IO (Maybe (CryptoMessage -> CryptoMessage)) +defaultKillHook session cm@(OneByte {msgID=KillPacket}) = do + dput XNetCrypto $ "Recieved kill packet (sessionid: " ++ show (ncSessionId session) ++ ") destroying session" + destroySession session + return Nothing + defaultUserStatusHook :: NetCryptoSession -> CryptoMessage -> IO (Maybe (CryptoMessage -> CryptoMessage)) defaultUserStatusHook session cm@(TwoByte {msgID=USERSTATUS, msgByte=statusByte}) = do let status = toEnum8 statusByte -- cgit v1.2.3