From 47637306b8c19b0b7363f9a2642c7190470a2c93 Mon Sep 17 00:00:00 2001 From: "jim@bo" Date: Sun, 24 Jun 2018 18:50:44 -0400 Subject: call setTerminated from destroySession --- examples/dhtd.hs | 4 +++- src/Network/Tox.hs | 22 +++++++++++++++++++--- src/Network/Tox/Crypto/Handlers.hs | 12 +++++++++++- 3 files changed, 33 insertions(+), 5 deletions(-) diff --git a/examples/dhtd.hs b/examples/dhtd.hs index bf7d7162..f4a2544c 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs @@ -1734,7 +1734,9 @@ main = do keysdb <- Tox.newKeysDatabase _crypto <- Tox.newCrypto - _netCryptoSessionsState <- Tox.newSessionsState _crypto Tox.defaultUnRecHook Tox.defaultCryptoDataHooks + let emptyDestroyHook :: Tox.NetCryptoSession -> IO () + emptyDestroyHook session = dput XNetCrypto $ "SESSION DESTROY HOOK NOT ADDED ! publkey= " ++ show (Tox.key2id (Tox.ncTheirPublicKey session)) + _netCryptoSessionsState <- Tox.newSessionsState _crypto emptyDestroyHook Tox.defaultUnRecHook Tox.defaultCryptoDataHooks (mbtox,quitTox,toxdhts,toxips,(taddrs::[SockAddr])) <- case porttox opts of "" -> return (Nothing,return (), Map.empty, return [],[]) toxport -> do diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs index cebbebfb..26488657 100644 --- a/src/Network/Tox.hs +++ b/src/Network/Tox.hs @@ -354,6 +354,18 @@ getOnionAlias crypto dhtself remoteNode = atomically $ do _ -> ni { nodeId = key2id (onionAliasPublic crypto) } return $ Onion.OnionDestination Onion.SearchingAlias alias Nothing +mkDefaultDestroyHook :: ContactInfo extra -> NetCryptoSession -> IO () +mkDefaultDestroyHook roster = \session -> do + now <- getPOSIXTime + r <- atomically $ do + accounts <- readTVar (accounts roster) -- :: STM (HashMap NodeId (Account extra) + let mbAccount = HashMap.lookup (key2id $ ncMyPublicKey session) accounts -- :: STM (Maybe (Account extra) + case mbAccount of + Just account -> Right <$> setTerminated now (ncTheirPublicKey session) account + Nothing -> return . Left $ "(defaultDestroyHook) their is no account! pubkey=" ++ show (key2id (ncTheirPublicKey session)) + case r of + Left msg -> dput XMan msg + _ -> return () newTox :: TVar Onion.AnnouncedKeys -- ^ Store of announced keys we are a rendezvous for. -> SockAddr -- ^ Bind-address to listen on. @@ -362,14 +374,18 @@ newTox :: TVar Onion.AnnouncedKeys -- ^ Store of announced keys we are a rende -> IO (Tox extra) newTox keydb addr mbSessionsState suppliedDHTKey = do (udp,sock) <- {- addVerbosity <$> -} udpTransport' addr + roster <- newContactInfo (crypto0,sessionsState0) <- case mbSessionsState of Nothing -> do crypto <- newCrypto - sessionsState <- newSessionsState crypto defaultUnRecHook defaultCryptoDataHooks + sessionsState <- newSessionsState crypto (mkDefaultDestroyHook roster) defaultUnRecHook defaultCryptoDataHooks return (crypto,sessionsState) - Just s -> return (transportCrypto s, s) + Just s -> do + let oldhook = defaultDestroyHook s + oldhook' = filter ((==0) . fst) oldhook + newhook = (0,mkDefaultDestroyHook roster):oldhook' + return (transportCrypto s, s { defaultDestroyHook = newhook}) - roster <- newContactInfo let -- patch in supplied DHT key crypto1 = fromMaybe crypto0 $do k <- suppliedDHTKey diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs index 2e00d61b..85e6192a 100644 --- a/src/Network/Tox/Crypto/Handlers.hs +++ b/src/Network/Tox/Crypto/Handlers.hs @@ -326,6 +326,7 @@ data NetCryptoSession = NCrypto TVar , ncUnrecognizedHook :: TVar (MessageType -> NetCryptoHook) , ncIdleEventHooks :: TVar [(Int,NetCryptoSession -> IO ())] + , ncDestoryHooks :: TVar [(Int,NetCryptoSession -> IO ())] , ncIncomingTypeArray :: TVar MsgTypeArray -- ^ This array maps 255 Id bytes to MessageType -- It should contain all messages this session understands. @@ -412,6 +413,7 @@ data NetCryptoSessions = NCSessions , defaultHooks :: Map.Map MessageType [NetCryptoHook] , defaultUnrecognizedHook :: MessageType -> NetCryptoHook , defaultIdleEventHooks :: [(Int,NetCryptoSession -> IO ())] + , defaultDestroyHook :: [(Int,NetCryptoSession -> IO ())] , sessionView :: SessionView , msgTypeArray :: MsgTypeArray , inboundQueueCapacity :: Word32 @@ -445,10 +447,11 @@ forgetCrypto crypto (NCSessions {netCryptoSessions,netCryptoSessionsByKey}) sess ys -> Just ys) sPubKey) newSessionsState :: TransportCrypto + -> (NetCryptoSession -> IO ()) -- ^ default destroy hook -> (MessageType -> NetCryptoHook) -- ^ default hook -> Map.Map MessageType [NetCryptoHook] -- ^ all hooks, can be empty to start -> IO NetCryptoSessions -newSessionsState crypto unrechook hooks = do +newSessionsState crypto destroyHook unrechook hooks = do x <- atomically $ newTVar Map.empty x2 <- atomically $ newTVar Map.empty nick <- atomically $ newTVar B.empty @@ -479,6 +482,7 @@ newSessionsState crypto unrechook hooks = do , defaultHooks = hooks , defaultUnrecognizedHook = unrechook , defaultIdleEventHooks = [(0,handleRequestsOutOfOrder)] + , defaultDestroyHook = [(0,destroyHook)] , sessionView = SessionView { svNick = nick , svStatus = status @@ -609,6 +613,7 @@ freshCryptoSession sessions ncHooks0 <- newTVar (defaultHooks sessions) ncUnrecognizedHook0 <- newTVar (defaultUnrecognizedHook sessions) ncIdleEventHooks0 <- newTVar (defaultIdleEventHooks sessions) + ncDestoryHooks0 <- newTVar (defaultDestroyHook sessions) ncIncomingTypeArray0 <- newTVar (msgTypeArray sessions) let idMap = foldl (\mp (x,y) -> W64.insert x y mp) W64.empty (zip [0..255] [0..255]) (ncOutgoingIdMap0,lossyEscapeIdMap,losslessEscapeIdMap,ncOutHooks0) <- do @@ -684,6 +689,7 @@ freshCryptoSession sessions , ncOutHooks = ncOutHooks0 , ncUnrecognizedHook = ncUnrecognizedHook0 , ncIdleEventHooks = ncIdleEventHooks0 + , ncDestoryHooks = ncDestoryHooks0 , ncAllSessions = sessions , ncIncomingTypeArray = ncIncomingTypeArray0 , ncOutgoingIdMap = ncOutgoingIdMap0 @@ -892,6 +898,10 @@ runUponHandshake netCryptoSession0 addr pktoq = do destroySession :: NetCryptoSession -> IO () destroySession session = do + -- first run all destory hooks + hooks <- atomically (readTVar (ncDestoryHooks session)) + forM_ hooks $ \(key,hook) -> hook session + -- now clean up threads let allsessions = ncAllSessions session sid = ncSessionId session stopThread :: TVar (Maybe ThreadId) -> IO () -- cgit v1.2.3