From 2387e410c7df8ef865db799a277dbac14b5a70f7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Fri, 18 Jul 2025 20:40:27 +0200 Subject: Close streams on failed tunnel requests --- src/Erebos/Discovery.hs | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) (limited to 'src') diff --git a/src/Erebos/Discovery.hs b/src/Erebos/Discovery.hs index 5788ab8..2c1d409 100644 --- a/src/Erebos/Discovery.hs +++ b/src/Erebos/Discovery.hs @@ -431,7 +431,14 @@ instance Service DiscoveryService where let addr = TunnelAddress {..} void $ serverPeerCustom server addr receiveFromTunnel server addr - [] -> svcPrint $ "Discovery: missing stream in tunnel response" + [] -> do + svcPrint $ "Discovery: missing stream in tunnel response" + liftIO $ closeStream tunnelWriter + + | Just tunnelWriter <- lookup (either refDigest id (dconnTarget conn)) (dpsOurTunnelRequests dps) + -> do + svcPrint $ "Discovery: tunnel request failed" + liftIO $ closeStream tunnelWriter #ifdef ENABLE_ICE_SUPPORT | Just dp <- M.lookup (either refDigest id $ dconnTarget conn) dpeers @@ -449,6 +456,7 @@ instance Service DiscoveryService where case M.lookup (either refDigest id $ dconnSource conn) dpeers of Just dp | Just dpeer <- dpPeer dp -> if + -- successful tunnel request | dconnTunnel conn , Just ( fromSource, toTarget ) <- lookup (either refDigest id (dconnSource conn)) (dpsRelayedTunnelRequests dps) , fromTarget : _ <- streams @@ -465,6 +473,12 @@ instance Service DiscoveryService where toSource <- readMVar toSourceVar relayStream fromTarget toSource + -- failed tunnel request + | Just ( _, toTarget ) <- lookup (either refDigest id (dconnSource conn)) (dpsRelayedTunnelRequests dps) + -> do + liftIO $ closeStream toTarget + sendToPeer dpeer $ DiscoveryConnectionResponse conn + | otherwise -> do sendToPeer dpeer $ DiscoveryConnectionResponse conn _ -> svcPrint $ "Discovery: failed to relay connection response" -- cgit v1.2.3