voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

continue with TCP leaks

This commit is contained in:
voidlizard 2024-11-01 15:38:48 +03:00
parent fa74de1fdb
commit 8af3a21be1
1 changed files with 9 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
hbs2-core/lib/HBS2/Net/Messaging/TCP.hs
View File

@ -19,9 +19,9 @@ import HBS2.Prelude.Plated
import HBS2.Net.Messaging.Stream
import HBS2.System.Logger.Simple
import HBS2.Misc.PrettyStuff
import Control.Concurrent.STM (flushTQueue)
import Control.Exception (try,SomeException)
import Control.Monad
import Data.Bits
import Data.ByteString.Lazy (ByteString)
@ -389,7 +389,10 @@ fireTCP MessagingTCP{..} pip what = do
when fire do
debug $ "Fire TCP" <+> pretty pa
atomically (modifyTVar _tcpFired succ)
void $ async (what >> atomically (modifyTVar _tcpFired pred))
void $ async do
r <- U.try @_ @SomeException what
atomically (modifyTVar _tcpFired pred)
either U.throwIO dontHandle r
runMessagingTCP :: forall m . MonadIO m => MessagingTCP -> m ()
runMessagingTCP env@MessagingTCP{..} = liftIO do
@ -438,6 +441,10 @@ runMessagingTCP env@MessagingTCP{..} = liftIO do
co' <- atomically $ readTVar (view tcpPeerConn env) <&> HashMap.lookup pip
when (isNothing co') do
debug $ red "No session for" <+> pretty pip
pure ()
maybe1 co' (void $ fireTCP env pip (connectPeerTCP env pip)) $ \co -> do
q' <- atomically $ readTVar (view tcpConnQ env) <&> HashMap.lookup co
maybe1 q' none $ \q -> do