From 59a2580c4cecb4acc53b812dc5fc8df091bf8516 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sun, 23 Mar 2025 13:45:01 +0100 Subject: Relay ICE info even without other ICE support --- src/Erebos/Discovery.hs | 77 ++++++++++++++++++++++++------------------------- 1 file changed, 37 insertions(+), 40 deletions(-) (limited to 'src/Erebos') diff --git a/src/Erebos/Discovery.hs b/src/Erebos/Discovery.hs index 548d274..f97c792 100644 --- a/src/Erebos/Discovery.hs +++ b/src/Erebos/Discovery.hs @@ -59,6 +59,8 @@ data DiscoveryConnection = DiscoveryConnection , dconnAddress :: Maybe Text #ifdef ENABLE_ICE_SUPPORT , dconnIceInfo :: Maybe IceRemoteInfo +#else + , dconnIceInfo :: Maybe (Stored Object) #endif } @@ -66,9 +68,7 @@ emptyConnection :: Ref -> Ref -> DiscoveryConnection emptyConnection dconnSource dconnTarget = DiscoveryConnection {..} where dconnAddress = Nothing -#ifdef ENABLE_ICE_SUPPORT dconnIceInfo = Nothing -#endif instance Storable DiscoveryService where store' x = storeRec $ do @@ -95,9 +95,7 @@ instance Storable DiscoveryService where storeRawRef "source" $ dconnSource conn storeRawRef "target" $ dconnTarget conn storeMbText "address" $ dconnAddress conn -#ifdef ENABLE_ICE_SUPPORT storeMbRef "ice-info" $ dconnIceInfo conn -#endif load' = loadRec $ msum [ do @@ -129,9 +127,7 @@ instance Storable DiscoveryService where <$> loadRawRef "source" <*> loadRawRef "target" <*> loadMbText "address" -#ifdef ENABLE_ICE_SUPPORT <*> loadMbRef "ice-info" -#endif data DiscoveryPeer = DiscoveryPeer { dpPriority :: Int @@ -162,13 +158,19 @@ instance Service DiscoveryService where peer <- asks svcPeer let insertHelper new old | dpPriority new > dpPriority old = new | otherwise = old - matchedAddrs <- fmap catMaybes $ forM addrs $ \addr -> case words (T.unpack addr) of - [ipaddr, port] | DatagramAddress paddr <- peerAddress peer -> do + matchedAddrs <- fmap catMaybes $ forM addrs $ \addr -> if + | addr == T.pack "ICE" -> do + return $ Just addr + + | [ ipaddr, port ] <- words (T.unpack addr) + , DatagramAddress paddr <- peerAddress peer -> do saddr <- liftIO $ head <$> getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just ipaddr) (Just port) return $ if paddr == addrAddress saddr then Just addr else Nothing - _ -> return Nothing + + | otherwise -> return Nothing + forM_ (idDataF =<< unfoldOwners pid) $ \s -> svcModifyGlobal $ M.insertWith insertHelper (refDigest $ storedRef s) DiscoveryPeer { dpPriority = fromMaybe 0 priority @@ -178,39 +180,34 @@ instance Service DiscoveryService where , dpIceSession = Nothing #endif } - let matchedAddrs' = matchedAddrs -#ifdef ENABLE_ICE_SUPPORT - ++ filter (== T.pack "ICE") addrs -#endif attrs <- asks svcAttributes - replyPacket $ DiscoveryAcknowledged matchedAddrs' + replyPacket $ DiscoveryAcknowledged matchedAddrs (discoveryStunServer attrs) (discoveryStunPort attrs) (discoveryTurnServer attrs) (discoveryTurnPort attrs) - DiscoveryAcknowledged addrs stunServer stunPort turnServer turnPort -> do + DiscoveryAcknowledged _ stunServer stunPort turnServer turnPort -> do #ifdef ENABLE_ICE_SUPPORT - when (T.pack "ICE" `elem` addrs) $ do - paddr <- asks (peerAddress . svcPeer) >>= return . \case - (DatagramAddress saddr) -> case IP.fromSockAddr saddr of - Just (IP.IPv6 ipv6, _) - | (0, 0, 0xffff, ipv4) <- IP.fromIPv6w ipv6 - -> Just $ T.pack $ show (IP.toIPv4w ipv4) - Just (addr, _) - -> Just $ T.pack $ show addr - _ -> Nothing + paddr <- asks (peerAddress . svcPeer) >>= return . \case + (DatagramAddress saddr) -> case IP.fromSockAddr saddr of + Just (IP.IPv6 ipv6, _) + | (0, 0, 0xffff, ipv4) <- IP.fromIPv6w ipv6 + -> Just $ T.pack $ show (IP.toIPv4w ipv4) + Just (addr, _) + -> Just $ T.pack $ show addr _ -> Nothing + _ -> Nothing - let toIceServer Nothing Nothing = Nothing - toIceServer Nothing (Just port) = ( , port) <$> paddr - toIceServer (Just server) Nothing = Just ( server, 0 ) - toIceServer (Just server) (Just port) = Just ( server, port ) + let toIceServer Nothing Nothing = Nothing + toIceServer Nothing (Just port) = ( , port) <$> paddr + toIceServer (Just server) Nothing = Just ( server, 0 ) + toIceServer (Just server) (Just port) = Just ( server, port ) - cfg <- liftIO $ iceCreateConfig - (toIceServer stunServer stunPort) - (toIceServer turnServer turnPort) - svcSet cfg + cfg <- liftIO $ iceCreateConfig + (toIceServer stunServer stunPort) + (toIceServer turnServer turnPort) + svcSet cfg #endif return () @@ -273,11 +270,11 @@ instance Service DiscoveryService where svcPrint $ "Discovery: invalid address in result: " ++ T.unpack addr DiscoveryConnectionRequest conn -> do -#ifdef ENABLE_ICE_SUPPORT self <- svcSelf let rconn = emptyConnection (dconnSource conn) (dconnTarget conn) if refDigest (dconnTarget conn) `elem` (map (refDigest . storedRef) $ idDataF =<< unfoldOwners self) then do +#ifdef ENABLE_ICE_SUPPORT -- request for us, create ICE sesssion server <- asks svcServer peer <- asks svcPeer @@ -294,6 +291,9 @@ instance Service DiscoveryService where Left err -> putStrLn $ "Discovery: failed to send connection response: " ++ err Nothing -> do svcPrint $ "Discovery: ICE request from peer without ICE configuration" +#else + return () +#endif else do -- request to some of our peers, relay @@ -305,17 +305,14 @@ instance Service DiscoveryService where | Just dpeer <- dpPeer dp -> do sendToPeer dpeer $ DiscoveryConnectionRequest conn | otherwise -> svcPrint $ "Discovery: failed to relay connection request" -#else - return () -#endif DiscoveryConnectionResponse conn -> do -#ifdef ENABLE_ICE_SUPPORT self <- svcSelf dpeers <- svcGetGlobal if refDigest (dconnSource conn) `elem` (map (refDigest . storedRef) $ idDataF =<< unfoldOwners self) then do -- response to our request, try to connect to the peer +#ifdef ENABLE_ICE_SUPPORT server <- asks svcServer if | Just addr <- dconnAddress conn , [ipaddr, port] <- words (T.unpack addr) -> do @@ -331,15 +328,15 @@ instance Service DiscoveryService where liftIO $ iceConnect ice rinfo $ void $ serverPeerIce server ice | otherwise -> svcPrint $ "Discovery: connection request failed" +#else + return () +#endif else do -- response to relayed request case M.lookup (refDigest $ dconnSource conn) dpeers of Just dp | Just dpeer <- dpPeer dp -> do sendToPeer dpeer $ DiscoveryConnectionResponse conn _ -> svcPrint $ "Discovery: failed to relay connection response" -#else - return () -#endif serviceNewPeer = do server <- asks svcServer -- cgit v1.2.3 From 03f37ea3a7e77eb79381ca41c6612c38bd5727d9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Mon, 24 Mar 2025 21:55:39 +0100 Subject: ICE: fix deadlock when creating session without STUN/TURN --- src/Erebos/ICE.chs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'src/Erebos') diff --git a/src/Erebos/ICE.chs b/src/Erebos/ICE.chs index 2a6c174..6f61451 100644 --- a/src/Erebos/ICE.chs +++ b/src/Erebos/ICE.chs @@ -19,7 +19,7 @@ module Erebos.ICE ( ) where import Control.Arrow -import Control.Concurrent.MVar +import Control.Concurrent import Control.Monad import Control.Monad.Except import Control.Monad.Identity @@ -143,7 +143,11 @@ iceCreateConfig stun turn = iceCreateSession :: IceConfig -> IceSessionRole -> (IceSession -> IO ()) -> IO IceSession iceCreateSession icfg@(IceConfig fcfg) role cb = do rec sptr <- newStablePtr sess - cbptr <- newStablePtr $ cb sess + cbptr <- newStablePtr $ do + -- The callback may be called directly from pj_ice_strans_create or later + -- from a different thread; make sure we use a different thread here + -- to avoid deadlock on accessing 'sess'. + forkIO $ cb sess sess <- IceSession <$> (withForeignPtr fcfg $ \cfg -> {#call ice_create #} (castPtr cfg) (fromIntegral $ fromEnum role) (castStablePtrToPtr sptr) (castStablePtrToPtr cbptr) -- cgit v1.2.3 From ed93546c519b35d5ece89c1fece94d8347e26f28 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Wed, 26 Mar 2025 20:14:51 +0100 Subject: ICE: use pj_ice_strans_sendto2 --- src/Erebos/ICE/pjproject.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Erebos') diff --git a/src/Erebos/ICE/pjproject.c b/src/Erebos/ICE/pjproject.c index 2374340..e79fb9d 100644 --- a/src/Erebos/ICE/pjproject.c +++ b/src/Erebos/ICE/pjproject.c @@ -397,7 +397,7 @@ void ice_send(pj_ice_strans * strans, const char * data, size_t len) return; } - pj_status_t status = pj_ice_strans_sendto(strans, 1, data, len, + pj_status_t status = pj_ice_strans_sendto2(strans, 1, data, len, &ice.def_addr, pj_sockaddr_get_len(&ice.def_addr)); if (status != PJ_SUCCESS && status != PJ_EPENDING) ice_perror("error sending data", status); -- cgit v1.2.3 From e3372f86d6935454b38c738784f9e2de8ac0a844 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Wed, 26 Mar 2025 20:38:03 +0100 Subject: Discovery: do not announce self without any local address --- src/Erebos/Discovery.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'src/Erebos') diff --git a/src/Erebos/Discovery.hs b/src/Erebos/Discovery.hs index f97c792..15ac9c4 100644 --- a/src/Erebos/Discovery.hs +++ b/src/Erebos/Discovery.hs @@ -352,4 +352,5 @@ instance Service DiscoveryService where #endif ] - sendToPeer peer $ DiscoverySelf addrs Nothing + when (not $ null addrs) $ do + sendToPeer peer $ DiscoverySelf addrs Nothing -- cgit v1.2.3 From 63e1b79f48e31da10e93169444c3426b631247b2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Thu, 27 Mar 2025 21:19:54 +0100 Subject: Build with fsnotify-0.3 Present in Debian bookworm. --- src/Erebos/Storage.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Erebos') diff --git a/src/Erebos/Storage.hs b/src/Erebos/Storage.hs index 61bb2fa..c1e9664 100644 --- a/src/Erebos/Storage.hs +++ b/src/Erebos/Storage.hs @@ -567,7 +567,7 @@ watchHeadRaw st tid hid sel cb = do True -> return ilist False -> do void $ watchDir manager (headTypePath spath tid) (const True) $ \case - Added { eventPath = fpath } | Just ihid <- HeadID <$> U.fromString (takeFileName fpath) -> do + ev@Added {} | Just ihid <- HeadID <$> U.fromString (takeFileName (eventPath ev)) -> do loadHeadRaw st tid ihid >>= \case Just ref -> do (_, _, iwl) <- readMVar mvar -- cgit v1.2.3