summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--README.md7
-rw-r--r--main/Main.hs68
-rw-r--r--main/Test.hs8
-rw-r--r--src/Erebos/Chatroom.hs63
-rw-r--r--src/Erebos/Conversation.hs5
-rw-r--r--src/Erebos/Discovery.hs147
-rw-r--r--src/Erebos/ICE.chs41
-rw-r--r--src/Erebos/ICE/pjproject.c111
-rw-r--r--src/Erebos/ICE/pjproject.h7
-rw-r--r--src/Erebos/Service.hs8
-rw-r--r--test/chatroom.test171
11 files changed, 525 insertions, 111 deletions
diff --git a/README.md b/README.md
index b71eb9d..07cee2a 100644
--- a/README.md
+++ b/README.md
@@ -137,6 +137,13 @@ are signed, so message author can not be forged.
: Leave the chatroom. User will no longer be listed as a member and erebos tool
will no longer collect message of this chatroom.
+`/delete`
+: Delete the chatroom; this action is only synchronized with devices belonging
+to the current user and does not affect the chatroom state for others. Due to
+the storage design, the chatroom data will not be purged from the local state
+history, but the chatroom will no longer be listed as available and no futher
+updates for this chatroom will be collected or shared with other peers.
+
### Add contacts
To ensure the identity of the contact and prevent man-in-the-middle attack,
diff --git a/main/Main.hs b/main/Main.hs
index 6c9d165..d91330c 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -126,6 +126,20 @@ options =
, Option [] ["chatroom-auto-subscribe"]
(ReqArg (\count -> \opts -> opts { optChatroomAutoSubscribe = Just (read count) }) "<count>")
"automatically subscribe for up to <count> chatrooms"
+#ifdef ENABLE_ICE_SUPPORT
+ , Option [] [ "discovery-stun-port" ]
+ (ReqArg (\value -> serviceAttr $ \attrs -> attrs { discoveryStunPort = Just (read value) }) "<port>")
+ "offer specified <port> to discovery peers for STUN protocol"
+ , Option [] [ "discovery-stun-server" ]
+ (ReqArg (\value -> serviceAttr $ \attrs -> attrs { discoveryStunServer = Just (read value) }) "<server>")
+ "offer <server> (domain name or IP address) to discovery peers for STUN protocol"
+ , Option [] [ "discovery-turn-port" ]
+ (ReqArg (\value -> serviceAttr $ \attrs -> attrs { discoveryTurnPort = Just (read value) }) "<port>")
+ "offer specified <port> to discovery peers for TURN protocol"
+ , Option [] [ "discovery-turn-server" ]
+ (ReqArg (\value -> serviceAttr $ \attrs -> attrs { discoveryTurnServer = Just (read value) }) "<server>")
+ "offer <server> (domain name or IP address) to discovery peers for TURN protocol"
+#endif
, Option [] ["dm-bot-echo"]
(ReqArg (\prefix -> \opts -> opts { optDmBotEcho = Just (T.pack prefix) }) "<prefix>")
"automatically reply to direct messages with the same text prefixed with <prefix>"
@@ -136,7 +150,16 @@ options =
(NoArg $ \opts -> opts { optShowVersion = True })
"show version and exit"
]
- where so f opts = opts { optServer = f $ optServer opts }
+ where
+ so f opts = opts { optServer = f $ optServer opts }
+
+ updateService :: Service s => (ServiceAttributes s -> ServiceAttributes s) -> SomeService -> SomeService
+ updateService f some@(SomeService proxy attrs)
+ | Just f' <- cast f = SomeService proxy (f' attrs)
+ | otherwise = some
+
+ serviceAttr :: Service s => (ServiceAttributes s -> ServiceAttributes s) -> Options -> Options
+ serviceAttr f opts = opts { optServices = map (\sopt -> sopt { soptService = updateService f (soptService sopt) }) (optServices opts) }
servicesOptions :: [OptDescr (Options -> Options)]
servicesOptions = concatMap helper $ "all" : map soptName availableServices
@@ -490,6 +513,7 @@ commands =
, ("peer-add-public", cmdPeerAddPublic)
, ("peer-drop", cmdPeerDrop)
, ("send", cmdSend)
+ , ("delete", cmdDelete)
, ("update-identity", cmdUpdateIdentity)
, ("attach", cmdAttach)
, ("attach-accept", cmdAttachAccept)
@@ -621,6 +645,11 @@ cmdSend = void $ do
liftIO $ putStrLn $ formatMessage tzone msg
Nothing -> return ()
+cmdDelete :: Command
+cmdDelete = void $ do
+ deleteConversation =<< getSelectedConversation
+ modify $ \s -> s { csContext = NoContext }
+
cmdHistory :: Command
cmdHistory = void $ do
conv <- getSelectedConversation
@@ -667,7 +696,7 @@ watchChatroomsForCli eprint h chatroomSetVar contextVar autoSubscribe = do
watchChatrooms h $ \set -> \case
Nothing -> do
- let chatroomList = fromSetBy (comparing roomStateData) set
+ let chatroomList = filter (not . roomStateDeleted) $ fromSetBy (comparing roomStateData) set
(subscribed, notSubscribed) = partition roomStateSubscribe chatroomList
subscribedNum = length subscribed
@@ -727,7 +756,7 @@ cmdChatrooms :: Command
cmdChatrooms = do
ensureWatchedChatrooms
chatroomSetVar <- asks ciChatroomSetVar
- chatroomList <- fromSetBy (comparing roomStateData) <$> liftIO (readMVar chatroomSetVar)
+ chatroomList <- filter (not . roomStateDeleted) . fromSetBy (comparing roomStateData) <$> liftIO (readMVar chatroomSetVar)
set <- asks ciSetContextOptions
set $ map SelectedChatroom chatroomList
forM_ (zip [1..] chatroomList) $ \(i :: Int, rstate) -> do
@@ -879,12 +908,35 @@ cmdDiscovery = void $ do
cmdIceCreate :: Command
cmdIceCreate = do
- role <- asks ciLine >>= return . \case
- 'm':_ -> PjIceSessRoleControlling
- 's':_ -> PjIceSessRoleControlled
- _ -> PjIceSessRoleUnknown
+ let getRole = \case
+ 'm':_ -> PjIceSessRoleControlling
+ 's':_ -> PjIceSessRoleControlled
+ _ -> PjIceSessRoleUnknown
+
+ ( role, stun, turn ) <- asks (words . ciLine) >>= \case
+ [] -> return ( PjIceSessRoleControlling, Nothing, Nothing )
+ [ role ] -> return
+ ( getRole role, Nothing, Nothing )
+ [ role, server ] -> return
+ ( getRole role
+ , Just ( T.pack server, 0 )
+ , Just ( T.pack server, 0 )
+ )
+ [ role, server, port ] -> return
+ ( getRole role
+ , Just ( T.pack server, read port )
+ , Just ( T.pack server, read port )
+ )
+ [ role, stunServer, stunPort, turnServer, turnPort ] -> return
+ ( getRole role
+ , Just ( T.pack stunServer, read stunPort )
+ , Just ( T.pack turnServer, read turnPort )
+ )
+ _ -> throwError "invalid parameters"
+
eprint <- asks ciPrint
- sess <- liftIO $ iceCreate role $ eprint <=< iceShow
+ Just cfg <- liftIO $ iceCreateConfig stun turn
+ sess <- liftIO $ iceCreateSession cfg role $ eprint <=< iceShow
modify $ \s -> s { csIceSessions = sess : csIceSessions s }
cmdIceDestroy :: Command
diff --git a/main/Test.hs b/main/Test.hs
index 550e47f..570dd5d 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -289,6 +289,7 @@ commands = map (T.pack *** id)
, ("dm-list-peer", cmdDmListPeer)
, ("dm-list-contact", cmdDmListContact)
, ("chatroom-create", cmdChatroomCreate)
+ , ("chatroom-delete", cmdChatroomDelete)
, ("chatroom-list-local", cmdChatroomListLocal)
, ("chatroom-watch-local", cmdChatroomWatchLocal)
, ("chatroom-set-name", cmdChatroomSetName)
@@ -774,6 +775,13 @@ cmdChatroomCreate = do
room <- createChatroom (Just name) Nothing
cmdOut $ unwords $ "chatroom-create-done" : chatroomInfo room
+cmdChatroomDelete :: Command
+cmdChatroomDelete = do
+ [ cid ] <- asks tiParams
+ sdata <- getChatroomStateData cid
+ deleteChatroomByStateData sdata
+ cmdOut $ unwords [ "chatroom-delete-done", T.unpack cid ]
+
getChatroomStateData :: Text -> CommandM (Stored ChatroomStateData)
getChatroomStateData tref = do
st <- asks tiStorage
diff --git a/src/Erebos/Chatroom.hs b/src/Erebos/Chatroom.hs
index 814e1af..fec3fbf 100644
--- a/src/Erebos/Chatroom.hs
+++ b/src/Erebos/Chatroom.hs
@@ -6,6 +6,7 @@ module Erebos.Chatroom (
ChatroomState(..),
ChatroomStateData(..),
createChatroom,
+ deleteChatroomByStateData,
updateChatroomByStateData,
listChatrooms,
findChatroomByRoomData,
@@ -207,9 +208,8 @@ sendRawChatroomMessageByStateData lookupData mbIdentity mdReplyTo mdText mdLeave
else []
mdata <- mstore =<< sign secret =<< mstore ChatMessageData {..}
- mergeSorted . (:[]) <$> mstore ChatroomStateData
+ mergeSorted . (:[]) <$> mstore emptyChatroomStateData
{ rsdPrev = roomStateData cstate
- , rsdRoom = []
, rsdSubscribe = Just (not mdLeave)
, rsdIdentity = mbIdentity
, rsdMessages = [ mdata ]
@@ -219,15 +219,27 @@ sendRawChatroomMessageByStateData lookupData mbIdentity mdReplyTo mdText mdLeave
data ChatroomStateData = ChatroomStateData
{ rsdPrev :: [Stored ChatroomStateData]
, rsdRoom :: [Stored (Signed ChatroomData)]
+ , rsdDelete :: Bool
, rsdSubscribe :: Maybe Bool
, rsdIdentity :: Maybe UnifiedIdentity
, rsdMessages :: [Stored (Signed ChatMessageData)]
}
+emptyChatroomStateData :: ChatroomStateData
+emptyChatroomStateData = ChatroomStateData
+ { rsdPrev = []
+ , rsdRoom = []
+ , rsdDelete = False
+ , rsdSubscribe = Nothing
+ , rsdIdentity = Nothing
+ , rsdMessages = []
+ }
+
data ChatroomState = ChatroomState
{ roomStateData :: [Stored ChatroomStateData]
, roomStateRoom :: Maybe Chatroom
, roomStateMessageData :: [Stored (Signed ChatMessageData)]
+ , roomStateDeleted :: Bool
, roomStateSubscribe :: Bool
, roomStateIdentity :: Maybe UnifiedIdentity
, roomStateMessages :: [ChatMessage]
@@ -237,6 +249,7 @@ instance Storable ChatroomStateData where
store' ChatroomStateData {..} = storeRec $ do
forM_ rsdPrev $ storeRef "PREV"
forM_ rsdRoom $ storeRef "room"
+ when rsdDelete $ storeEmpty "delete"
forM_ rsdSubscribe $ storeInt "subscribe" . bool @Int 0 1
forM_ rsdIdentity $ storeRef "id" . idExtData
forM_ rsdMessages $ storeRef "msg"
@@ -244,6 +257,7 @@ instance Storable ChatroomStateData where
load' = loadRec $ do
rsdPrev <- loadRefs "PREV"
rsdRoom <- loadRefs "room"
+ rsdDelete <- isJust <$> loadMbEmpty "delete"
rsdSubscribe <- fmap ((/=) @Int 0) <$> loadMbInt "subscribe"
rsdIdentity <- loadMbUnifiedIdentity "id"
rsdMessages <- loadRefs "msg"
@@ -258,7 +272,8 @@ instance Mergeable ChatroomState where
roomStateMessageData = filterAncestors $ concat $ flip findProperty roomStateData $ \case
ChatroomStateData {..} | null rsdMessages -> Nothing
| otherwise -> Just rsdMessages
- roomStateSubscribe = fromMaybe False $ findPropertyFirst rsdSubscribe roomStateData
+ roomStateDeleted = any (rsdDelete . fromStored) roomStateData
+ roomStateSubscribe = not roomStateDeleted && (fromMaybe False $ findPropertyFirst rsdSubscribe roomStateData)
roomStateIdentity = findPropertyFirst rsdIdentity roomStateData
roomStateMessages = threadToListSince [] $ concatMap (rsdMessages . fromStored) roomStateData
in ChatroomState {..}
@@ -273,12 +288,9 @@ createChatroom rdName rdDescription = do
(secret, rdKey) <- liftIO . generateKeys =<< getStorage
let rdPrev = []
rdata <- mstore =<< sign secret =<< mstore ChatroomData {..}
- cstate <- mergeSorted . (:[]) <$> mstore ChatroomStateData
- { rsdPrev = []
- , rsdRoom = [ rdata ]
+ cstate <- mergeSorted . (:[]) <$> mstore emptyChatroomStateData
+ { rsdRoom = [ rdata ]
, rsdSubscribe = Just True
- , rsdIdentity = Nothing
- , rsdMessages = []
}
updateLocalHead $ updateSharedState $ \rooms -> do
@@ -304,6 +316,17 @@ findAndUpdateChatroomState f = do
return (roomSet, Just upd)
[] -> return (roomSet, Nothing)
+deleteChatroomByStateData
+ :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
+ => Stored ChatroomStateData -> m ()
+deleteChatroomByStateData lookupData = void $ findAndUpdateChatroomState $ \cstate -> do
+ guard $ any (lookupData `precedesOrEquals`) $ roomStateData cstate
+ Just $ do
+ mergeSorted . (:[]) <$> mstore emptyChatroomStateData
+ { rsdPrev = roomStateData cstate
+ , rsdDelete = True
+ }
+
updateChatroomByStateData
:: (MonadStorage m, MonadHead LocalState m, MonadError String m)
=> Stored ChatroomStateData
@@ -321,17 +344,16 @@ updateChatroomByStateData lookupData newName newDesc = findAndUpdateChatroomStat
, rdDescription = newDesc
, rdKey = roomKey room
}
- mergeSorted . (:[]) <$> mstore ChatroomStateData
+ mergeSorted . (:[]) <$> mstore emptyChatroomStateData
{ rsdPrev = roomStateData cstate
, rsdRoom = [ rdata ]
, rsdSubscribe = Just True
- , rsdIdentity = Nothing
- , rsdMessages = []
}
listChatrooms :: MonadHead LocalState m => m [ChatroomState]
-listChatrooms = fromSetBy (comparing $ roomName <=< roomStateRoom) .
+listChatrooms = filter (not . roomStateDeleted) .
+ fromSetBy (comparing $ roomName <=< roomStateRoom) .
lookupSharedValue . lsShared . fromStored <$> getLocalHead
findChatroom :: MonadHead LocalState m => (ChatroomState -> Bool) -> m (Maybe ChatroomState)
@@ -352,12 +374,9 @@ chatroomSetSubscribe
chatroomSetSubscribe lookupData subscribe = void $ findAndUpdateChatroomState $ \cstate -> do
guard $ any (lookupData `precedesOrEquals`) $ roomStateData cstate
Just $ do
- mergeSorted . (:[]) <$> mstore ChatroomStateData
+ mergeSorted . (:[]) <$> mstore emptyChatroomStateData
{ rsdPrev = roomStateData cstate
- , rsdRoom = []
, rsdSubscribe = Just subscribe
- , rsdIdentity = Nothing
- , rsdMessages = []
}
chatroomMembers :: ChatroomState -> [ ComposedIdentity ]
@@ -420,7 +439,7 @@ watchChatrooms h f = liftIO $ do
return $ makeChatroomDiff lastList curList
chatroomSetToList :: Set ChatroomState -> [(Stored ChatroomStateData, ChatroomState)]
-chatroomSetToList = map (cmp &&& id) . fromSetBy (comparing cmp)
+chatroomSetToList = map (cmp &&& id) . filter (not . roomStateDeleted) . fromSetBy (comparing cmp)
where
cmp :: ChatroomState -> Stored ChatroomStateData
cmp = head . filterAncestors . concatMap storedRoots . toComponents
@@ -518,12 +537,9 @@ instance Service ChatroomService where
-- update local state only if we got roomInfo not present there
if roomInfo `notElem` prevRoom && roomInfo `elem` room
then do
- sdata <- mstore ChatroomStateData
+ sdata <- mstore emptyChatroomStateData
{ rsdPrev = prev
, rsdRoom = room
- , rsdSubscribe = Nothing
- , rsdIdentity = Nothing
- , rsdMessages = []
}
storeSetAddComponent sdata set
else return set
@@ -563,11 +579,8 @@ instance Service ChatroomService where
-- update local state only if subscribed and we got some new messages
if roomStateSubscribe prev && messages /= prevMessages
then do
- sdata <- mstore ChatroomStateData
+ sdata <- mstore emptyChatroomStateData
{ rsdPrev = prevData
- , rsdRoom = []
- , rsdSubscribe = Nothing
- , rsdIdentity = Nothing
, rsdMessages = messages
}
storeSetAddComponent sdata set
diff --git a/src/Erebos/Conversation.hs b/src/Erebos/Conversation.hs
index fce8780..7c9d329 100644
--- a/src/Erebos/Conversation.hs
+++ b/src/Erebos/Conversation.hs
@@ -18,6 +18,7 @@ module Erebos.Conversation (
conversationHistory,
sendMessage,
+ deleteConversation,
) where
import Control.Monad.Except
@@ -103,3 +104,7 @@ conversationHistory (ChatroomConversation rstate) = map (\msg -> ChatroomMessage
sendMessage :: (MonadHead LocalState m, MonadError String m) => Conversation -> Text -> m (Maybe Message)
sendMessage (DirectMessageConversation thread) text = fmap Just $ DirectMessageMessage <$> (fromStored <$> sendDirectMessage (msgPeer thread) text) <*> pure False
sendMessage (ChatroomConversation rstate) text = sendChatroomMessage rstate text >> return Nothing
+
+deleteConversation :: (MonadHead LocalState m, MonadError String m) => Conversation -> m ()
+deleteConversation (DirectMessageConversation _) = throwError "deleting direct message conversation is not supported"
+deleteConversation (ChatroomConversation rstate) = deleteChatroomByStateData (head $ roomStateData rstate)
diff --git a/src/Erebos/Discovery.hs b/src/Erebos/Discovery.hs
index f0535fe..cbb12ca 100644
--- a/src/Erebos/Discovery.hs
+++ b/src/Erebos/Discovery.hs
@@ -2,6 +2,7 @@
module Erebos.Discovery (
DiscoveryService(..),
+ DiscoveryAttributes(..),
DiscoveryConnection(..)
) where
@@ -16,6 +17,7 @@ import Data.Map.Strict qualified as M
import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as T
+import Data.Word
import Network.Socket
@@ -29,19 +31,35 @@ import Erebos.Service
import Erebos.Storable
-data DiscoveryService = DiscoverySelf [ Text ] (Maybe Int)
- | DiscoveryAcknowledged Text
- | DiscoverySearch Ref
- | DiscoveryResult Ref [ Text ]
- | DiscoveryConnectionRequest DiscoveryConnection
- | DiscoveryConnectionResponse DiscoveryConnection
+data DiscoveryService
+ = DiscoverySelf [ Text ] (Maybe Int)
+ | DiscoveryAcknowledged [ Text ] (Maybe Text) (Maybe Word16) (Maybe Text) (Maybe Word16)
+ | DiscoverySearch Ref
+ | DiscoveryResult Ref [ Text ]
+ | DiscoveryConnectionRequest DiscoveryConnection
+ | DiscoveryConnectionResponse DiscoveryConnection
+
+data DiscoveryAttributes = DiscoveryAttributes
+ { discoveryStunPort :: Maybe Word16
+ , discoveryStunServer :: Maybe Text
+ , discoveryTurnPort :: Maybe Word16
+ , discoveryTurnServer :: Maybe Text
+ }
+
+defaultDiscoveryAttributes :: DiscoveryAttributes
+defaultDiscoveryAttributes = DiscoveryAttributes
+ { discoveryStunPort = Nothing
+ , discoveryStunServer = Nothing
+ , discoveryTurnPort = Nothing
+ , discoveryTurnServer = Nothing
+ }
data DiscoveryConnection = DiscoveryConnection
{ dconnSource :: Ref
, dconnTarget :: Ref
, dconnAddress :: Maybe Text
#ifdef ENABLE_ICE_SUPPORT
- , dconnIceSession :: Maybe IceRemoteInfo
+ , dconnIceInfo :: Maybe IceRemoteInfo
#endif
}
@@ -50,7 +68,7 @@ emptyConnection dconnSource dconnTarget = DiscoveryConnection {..}
where
dconnAddress = Nothing
#ifdef ENABLE_ICE_SUPPORT
- dconnIceSession = Nothing
+ dconnIceInfo = Nothing
#endif
instance Storable DiscoveryService where
@@ -59,8 +77,13 @@ instance Storable DiscoveryService where
DiscoverySelf addrs priority -> do
mapM_ (storeText "self") addrs
mapM_ (storeInt "priority") priority
- DiscoveryAcknowledged addr -> do
- storeText "ack" addr
+ DiscoveryAcknowledged addrs stunServer stunPort turnServer turnPort -> do
+ if null addrs then storeEmpty "ack"
+ else mapM_ (storeText "ack") addrs
+ storeMbText "stun-server" stunServer
+ storeMbInt "stun-port" stunPort
+ storeMbText "turn-server" turnServer
+ storeMbInt "turn-port" turnPort
DiscoverySearch ref -> storeRawRef "search" ref
DiscoveryResult ref addr -> do
storeRawRef "result" ref
@@ -74,7 +97,7 @@ instance Storable DiscoveryService where
storeRawRef "target" $ dconnTarget conn
storeMbText "address" $ dconnAddress conn
#ifdef ENABLE_ICE_SUPPORT
- storeMbRef "ice-session" $ dconnIceSession conn
+ storeMbRef "ice-info" $ dconnIceInfo conn
#endif
load' = loadRec $ msum
@@ -83,8 +106,16 @@ instance Storable DiscoveryService where
guard (not $ null addrs)
DiscoverySelf addrs
<$> loadMbInt "priority"
- , DiscoveryAcknowledged
- <$> loadText "ack"
+ , do
+ addrs <- loadTexts "ack"
+ mbEmpty <- loadMbEmpty "ack"
+ guard (not (null addrs) || isJust mbEmpty)
+ DiscoveryAcknowledged
+ <$> pure addrs
+ <*> loadMbText "stun-server"
+ <*> loadMbInt "stun-port"
+ <*> loadMbText "turn-server"
+ <*> loadMbInt "turn-port"
, DiscoverySearch <$> loadRawRef "search"
, DiscoveryResult
<$> loadRawRef "result"
@@ -100,7 +131,7 @@ instance Storable DiscoveryService where
<*> loadRawRef "target"
<*> loadMbText "address"
#ifdef ENABLE_ICE_SUPPORT
- <*> loadMbRef "ice-session"
+ <*> loadMbRef "ice-info"
#endif
data DiscoveryPeer = DiscoveryPeer
@@ -115,6 +146,14 @@ data DiscoveryPeer = DiscoveryPeer
instance Service DiscoveryService where
serviceID _ = mkServiceID "dd59c89c-69cc-4703-b75b-4ddcd4b3c23c"
+ type ServiceAttributes DiscoveryService = DiscoveryAttributes
+ defaultServiceAttributes _ = defaultDiscoveryAttributes
+
+#ifdef ENABLE_ICE_SUPPORT
+ type ServiceState DiscoveryService = Maybe IceConfig
+ emptyServiceState _ = Nothing
+#endif
+
type ServiceGlobalState DiscoveryService = Map RefDigest DiscoveryPeer
emptyServiceGlobalState _ = M.empty
@@ -124,7 +163,7 @@ instance Service DiscoveryService where
peer <- asks svcPeer
let insertHelper new old | dpPriority new > dpPriority old = new
| otherwise = old
- mbaddr <- fmap (listToMaybe . catMaybes) $ forM addrs $ \addr -> case words (T.unpack addr) of
+ matchedAddrs <- fmap catMaybes $ forM addrs $ \addr -> case words (T.unpack addr) of
[ipaddr, port] | DatagramAddress paddr <- peerAddress peer -> do
saddr <- liftIO $ head <$> getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just ipaddr) (Just port)
return $ if paddr == addrAddress saddr
@@ -140,9 +179,40 @@ instance Service DiscoveryService where
, dpIceSession = Nothing
#endif
}
- replyPacket $ DiscoveryAcknowledged $ fromMaybe (T.pack "ICE") mbaddr
-
- DiscoveryAcknowledged _ -> do
+ let matchedAddrs' = matchedAddrs
+#ifdef ENABLE_ICE_SUPPORT
+ ++ filter (== T.pack "ICE") addrs
+#endif
+ attrs <- asks svcAttributes
+ replyPacket $ DiscoveryAcknowledged matchedAddrs'
+ (discoveryStunServer attrs)
+ (discoveryStunPort attrs)
+ (discoveryTurnServer attrs)
+ (discoveryTurnPort attrs)
+
+ DiscoveryAcknowledged addrs 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
+ _ -> 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 )
+
+ cfg <- liftIO $ iceCreateConfig
+ (toIceServer stunServer stunPort)
+ (toIceServer turnServer turnPort)
+ svcSet cfg
+#endif
return ()
DiscoverySearch ref -> do
@@ -156,16 +226,19 @@ instance Service DiscoveryService where
-- TODO: check if we really requested that
server <- asks svcServer
self <- svcSelf
+ mbIceConfig <- svcGet
discoveryPeer <- asks svcPeer
let runAsService = runPeerService @DiscoveryService discoveryPeer
liftIO $ void $ forkIO $ forM_ addrs $ \addr -> if
- | addr == T.pack "ICE" -> do
+ | addr == T.pack "ICE"
#ifdef ENABLE_ICE_SUPPORT
- ice <- iceCreate PjIceSessRoleControlling $ \ice -> do
+ , Just config <- mbIceConfig
+ -> do
+ ice <- iceCreateSession config PjIceSessRoleControlling $ \ice -> do
rinfo <- iceRemoteInfo ice
res <- runExceptT $ sendToPeer discoveryPeer $
- DiscoveryConnectionRequest (emptyConnection (storedRef $ idData self) ref) { dconnIceSession = Just rinfo }
+ DiscoveryConnectionRequest (emptyConnection (storedRef $ idData self) ref) { dconnIceInfo = Just rinfo }
case res of
Right _ -> return ()
Left err -> putStrLn $ "Discovery: failed to send connection request: " ++ err
@@ -178,6 +251,7 @@ instance Service DiscoveryService where
, dpIceSession = Just ice
}
#else
+ -> do
return ()
#endif
@@ -208,15 +282,19 @@ instance Service DiscoveryService where
-- request for us, create ICE sesssion
server <- asks svcServer
peer <- asks svcPeer
- liftIO $ void $ iceCreate PjIceSessRoleControlled $ \ice -> do
- rinfo <- iceRemoteInfo ice
- res <- runExceptT $ sendToPeer peer $ DiscoveryConnectionResponse rconn { dconnIceSession = Just rinfo }
- case res of
- Right _ -> do
- case dconnIceSession conn of
- Just prinfo -> iceConnect ice prinfo $ void $ serverPeerIce server ice
- Nothing -> putStrLn $ "Discovery: connection request without ICE remote info"
- Left err -> putStrLn $ "Discovery: failed to send connection response: " ++ err
+ svcGet >>= \case
+ Just config -> do
+ liftIO $ void $ iceCreateSession config PjIceSessRoleControlled $ \ice -> do
+ rinfo <- iceRemoteInfo ice
+ res <- runExceptT $ sendToPeer peer $ DiscoveryConnectionResponse rconn { dconnIceInfo = Just rinfo }
+ case res of
+ Right _ -> do
+ case dconnIceInfo conn of
+ Just prinfo -> iceConnect ice prinfo $ void $ serverPeerIce server ice
+ Nothing -> putStrLn $ "Discovery: connection request without ICE remote info"
+ Left err -> putStrLn $ "Discovery: failed to send connection response: " ++ err
+ Nothing -> do
+ svcPrint $ "Discovery: ICE request from peer without ICE configuration"
else do
-- request to some of our peers, relay
@@ -250,7 +328,7 @@ instance Service DiscoveryService where
| Just dp <- M.lookup (refDigest $ dconnTarget conn) dpeers
, Just ice <- dpIceSession dp
- , Just rinfo <- dconnIceSession conn -> do
+ , Just rinfo <- dconnIceInfo conn -> do
liftIO $ iceConnect ice rinfo $ void $ serverPeerIce server ice
| otherwise -> svcPrint $ "Discovery: connection request failed"
@@ -271,6 +349,11 @@ instance Service DiscoveryService where
let addrToText saddr = do
( addr, port ) <- IP.fromSockAddr saddr
Just $ T.pack $ show addr <> " " <> show port
- addrs <- catMaybes . map addrToText <$> liftIO (getServerAddresses server)
+ addrs <- concat <$> sequence
+ [ catMaybes . map addrToText <$> liftIO (getServerAddresses server)
+#ifdef ENABLE_ICE_SUPPORT
+ , return [ T.pack "ICE" ]
+#endif
+ ]
sendToPeer peer $ DiscoverySelf addrs Nothing
diff --git a/src/Erebos/ICE.chs b/src/Erebos/ICE.chs
index 2d3177d..e0b1b34 100644
--- a/src/Erebos/ICE.chs
+++ b/src/Erebos/ICE.chs
@@ -4,9 +4,11 @@
module Erebos.ICE (
IceSession,
IceSessionRole(..),
+ IceConfig,
IceRemoteInfo,
- iceCreate,
+ iceCreateConfig,
+ iceCreateSession,
iceDestroy,
iceRemoteInfo,
iceShow,
@@ -23,17 +25,19 @@ import Control.Monad.Except
import Control.Monad.Identity
import Data.ByteString (ByteString, packCStringLen, useAsCString)
-import qualified Data.ByteString.Lazy.Char8 as BLC
+import Data.ByteString.Lazy.Char8 qualified as BLC
import Data.ByteString.Unsafe
import Data.Function
import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
-import qualified Data.Text.Read as T
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as T
+import Data.Text.Read qualified as T
import Data.Void
+import Data.Word
import Foreign.C.String
import Foreign.C.Types
+import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Ptr
@@ -48,6 +52,7 @@ import Erebos.Storage
data IceSession = IceSession
{ isStrans :: PjIceStrans
+ , _isConfig :: IceConfig
, isChan :: MVar (Either [ByteString] (Flow Void ByteString))
}
@@ -118,14 +123,34 @@ instance StorableText IceCandidate where
{#enum pj_ice_sess_role as IceSessionRole {underscoreToCase} deriving (Show, Eq) #}
+data PjIceStransCfg
+newtype IceConfig = IceConfig (ForeignPtr PjIceStransCfg)
+
+foreign import ccall unsafe "pjproject.h &ice_cfg_free"
+ ice_cfg_free :: FunPtr (Ptr PjIceStransCfg -> IO ())
+foreign import ccall unsafe "pjproject.h ice_cfg_create"
+ ice_cfg_create :: CString -> Word16 -> CString -> Word16 -> IO (Ptr PjIceStransCfg)
+
+iceCreateConfig :: Maybe ( Text, Word16 ) -> Maybe ( Text, Word16 ) -> IO (Maybe IceConfig)
+iceCreateConfig stun turn =
+ maybe ($ nullPtr) (withText . fst) stun $ \cstun ->
+ maybe ($ nullPtr) (withText . fst) turn $ \cturn -> do
+ cfg <- ice_cfg_create cstun (maybe 0 snd stun) cturn (maybe 0 snd turn)
+ if cfg == nullPtr
+ then return Nothing
+ else Just . IceConfig <$> newForeignPtr ice_cfg_free cfg
+
{#pointer *pj_ice_strans as ^ #}
-iceCreate :: IceSessionRole -> (IceSession -> IO ()) -> IO IceSession
-iceCreate role cb = do
+iceCreateSession :: IceConfig -> IceSessionRole -> (IceSession -> IO ()) -> IO IceSession
+iceCreateSession icfg@(IceConfig fcfg) role cb = do
rec sptr <- newStablePtr sess
cbptr <- newStablePtr $ cb sess
sess <- IceSession
- <$> {#call ice_create #} (fromIntegral $ fromEnum role) (castStablePtrToPtr sptr) (castStablePtrToPtr cbptr)
+ <$> (withForeignPtr fcfg $ \cfg ->
+ {#call ice_create #} (castPtr cfg) (fromIntegral $ fromEnum role) (castStablePtrToPtr sptr) (castStablePtrToPtr cbptr)
+ )
+ <*> pure icfg
<*> (newMVar $ Left [])
return $ sess
diff --git a/src/Erebos/ICE/pjproject.c b/src/Erebos/ICE/pjproject.c
index d3037bf..2374340 100644
--- a/src/Erebos/ICE/pjproject.c
+++ b/src/Erebos/ICE/pjproject.c
@@ -12,7 +12,6 @@ static struct
{
pj_caching_pool cp;
pj_pool_t * pool;
- pj_ice_strans_cfg cfg;
pj_sockaddr def_addr;
} ice;
@@ -31,9 +30,9 @@ static void ice_perror(const char * msg, pj_status_t status)
fprintf(stderr, "ICE: %s: %s\n", msg, err);
}
-static int ice_worker_thread(void * unused)
+static int ice_worker_thread(void * vcfg)
{
- PJ_UNUSED_ARG(unused);
+ pj_ice_strans_cfg * cfg = (pj_ice_strans_cfg *) vcfg;
while (true) {
pj_time_val max_timeout = { 0, 0 };
@@ -41,7 +40,7 @@ static int ice_worker_thread(void * unused)
max_timeout.msec = 500;
- pj_timer_heap_poll(ice.cfg.stun_cfg.timer_heap, &timeout);
+ pj_timer_heap_poll(cfg->stun_cfg.timer_heap, &timeout);
pj_assert(timeout.sec >= 0 && timeout.msec >= 0);
if (timeout.msec >= 1000)
@@ -50,7 +49,7 @@ static int ice_worker_thread(void * unused)
if (PJ_TIME_VAL_GT(timeout, max_timeout))
timeout = max_timeout;
- int c = pj_ioqueue_poll(ice.cfg.stun_cfg.ioqueue, &timeout);
+ int c = pj_ioqueue_poll(cfg->stun_cfg.ioqueue, &timeout);
if (c < 0)
pj_thread_sleep(PJ_TIME_VAL_MSEC(timeout));
}
@@ -105,7 +104,7 @@ static void ice_init(void)
if (done) {
pthread_mutex_unlock(&mutex);
- goto exit;
+ return;
}
pj_log_set_level(1);
@@ -125,48 +124,88 @@ static void ice_init(void)
pj_caching_pool_init(&ice.cp, NULL, 0);
- pj_ice_strans_cfg_default(&ice.cfg);
- ice.cfg.stun_cfg.pf = &ice.cp.factory;
-
ice.pool = pj_pool_create(&ice.cp.factory, "ice", 512, 512, NULL);
- if (pj_timer_heap_create(ice.pool, 100,
- &ice.cfg.stun_cfg.timer_heap) != PJ_SUCCESS) {
- fprintf(stderr, "pj_timer_heap_create failed\n");
- goto exit;
+exit:
+ done = true;
+ pthread_mutex_unlock(&mutex);
+}
+
+pj_ice_strans_cfg * ice_cfg_create( const char * stun_server, uint16_t stun_port,
+ const char * turn_server, uint16_t turn_port )
+{
+ ice_init();
+
+ pj_ice_strans_cfg * cfg = malloc( sizeof(pj_ice_strans_cfg) );
+ pj_ice_strans_cfg_default( cfg );
+
+ cfg->stun_cfg.pf = &ice.cp.factory;
+ if( pj_timer_heap_create( ice.pool, 100,
+ &cfg->stun_cfg.timer_heap ) != PJ_SUCCESS ){
+ fprintf( stderr, "pj_timer_heap_create failed\n" );
+ goto fail;
}
- if (pj_ioqueue_create(ice.pool, 16, &ice.cfg.stun_cfg.ioqueue) != PJ_SUCCESS) {
- fprintf(stderr, "pj_ioqueue_create failed\n");
- goto exit;
+ if( pj_ioqueue_create( ice.pool, 16, &cfg->stun_cfg.ioqueue ) != PJ_SUCCESS ){
+ fprintf( stderr, "pj_ioqueue_create failed\n" );
+ goto fail;
}
pj_thread_t * thread;
- if (pj_thread_create(ice.pool, "ice", &ice_worker_thread,
- NULL, 0, 0, &thread) != PJ_SUCCESS) {
- fprintf(stderr, "pj_thread_create failed\n");
- goto exit;
+ if( pj_thread_create( ice.pool, NULL, &ice_worker_thread,
+ cfg, 0, 0, &thread ) != PJ_SUCCESS ){
+ fprintf( stderr, "pj_thread_create failed\n" );
+ goto fail;
}
- ice.cfg.af = pj_AF_INET();
- ice.cfg.opt.aggressive = PJ_TRUE;
+ cfg->af = pj_AF_INET();
+ cfg->opt.aggressive = PJ_TRUE;
- ice.cfg.stun.server.ptr = "discovery1.erebosprotocol.net";
- ice.cfg.stun.server.slen = strlen(ice.cfg.stun.server.ptr);
- ice.cfg.stun.port = 29670;
+ if( stun_server ){
+ cfg->stun.server.ptr = malloc( strlen( stun_server ));
+ pj_strcpy2( &cfg->stun.server, stun_server );
+ if( stun_port )
+ cfg->stun.port = stun_port;
+ }
- ice.cfg.turn.server = ice.cfg.stun.server;
- ice.cfg.turn.port = ice.cfg.stun.port;
- ice.cfg.turn.auth_cred.type = PJ_STUN_AUTH_CRED_STATIC;
- ice.cfg.turn.auth_cred.data.static_cred.data_type = PJ_STUN_PASSWD_PLAIN;
- ice.cfg.turn.conn_type = PJ_TURN_TP_UDP;
+ if( turn_server ){
+ cfg->turn.server.ptr = malloc( strlen( turn_server ));
+ pj_strcpy2( &cfg->turn.server, turn_server );
+ if( turn_port )
+ cfg->turn.port = turn_port;
+ cfg->turn.auth_cred.type = PJ_STUN_AUTH_CRED_STATIC;
+ cfg->turn.auth_cred.data.static_cred.data_type = PJ_STUN_PASSWD_PLAIN;
+ cfg->turn.conn_type = PJ_TURN_TP_UDP;
+ }
-exit:
- done = true;
- pthread_mutex_unlock(&mutex);
+ return cfg;
+fail:
+ ice_cfg_free( cfg );
+ return NULL;
+}
+
+void ice_cfg_free( pj_ice_strans_cfg * cfg )
+{
+ if( ! cfg )
+ return;
+
+ if( cfg->turn.server.ptr )
+ free( cfg->turn.server.ptr );
+
+ if( cfg->stun.server.ptr )
+ free( cfg->stun.server.ptr );
+
+ if( cfg->stun_cfg.ioqueue )
+ pj_ioqueue_destroy( cfg->stun_cfg.ioqueue );
+
+ if( cfg->stun_cfg.timer_heap )
+ pj_timer_heap_destroy( cfg->stun_cfg.timer_heap );
+
+ free( cfg );
}
-pj_ice_strans * ice_create(pj_ice_sess_role role, HsStablePtr sptr, HsStablePtr cb)
+pj_ice_strans * ice_create( const pj_ice_strans_cfg * cfg, pj_ice_sess_role role,
+ HsStablePtr sptr, HsStablePtr cb )
{
ice_init();
@@ -182,8 +221,8 @@ pj_ice_strans * ice_create(pj_ice_sess_role role, HsStablePtr sptr, HsStablePtr
.on_ice_complete = cb_on_ice_complete,
};
- pj_status_t status = pj_ice_strans_create(NULL, &ice.cfg, 1,
- udata, &icecb, &res);
+ pj_status_t status = pj_ice_strans_create( NULL, cfg, 1,
+ udata, &icecb, &res );
if (status != PJ_SUCCESS)
ice_perror("error creating ice", status);
diff --git a/src/Erebos/ICE/pjproject.h b/src/Erebos/ICE/pjproject.h
index e230e75..e4fcbdb 100644
--- a/src/Erebos/ICE/pjproject.h
+++ b/src/Erebos/ICE/pjproject.h
@@ -3,7 +3,12 @@
#include <pjnath.h>
#include <HsFFI.h>
-pj_ice_strans * ice_create(pj_ice_sess_role role, HsStablePtr sptr, HsStablePtr cb);
+pj_ice_strans_cfg * ice_cfg_create( const char * stun_server, uint16_t stun_port,
+ const char * turn_server, uint16_t turn_port );
+void ice_cfg_free( pj_ice_strans_cfg * cfg );
+
+pj_ice_strans * ice_create( const pj_ice_strans_cfg *, pj_ice_sess_role role,
+ HsStablePtr sptr, HsStablePtr cb );
void ice_destroy(pj_ice_strans * strans);
ssize_t ice_encode_session(pj_ice_strans *, char * ufrag, char * pass,
diff --git a/src/Erebos/Service.hs b/src/Erebos/Service.hs
index f640feb..5c81a3d 100644
--- a/src/Erebos/Service.hs
+++ b/src/Erebos/Service.hs
@@ -38,7 +38,13 @@ import Erebos.State
import Erebos.Storable
import Erebos.Storage.Head
-class (Typeable s, Storable s, Typeable (ServiceState s), Typeable (ServiceGlobalState s)) => Service s where
+class (
+ Typeable s, Storable s,
+ Typeable (ServiceAttributes s),
+ Typeable (ServiceState s),
+ Typeable (ServiceGlobalState s)
+ ) => Service s where
+
serviceID :: proxy s -> ServiceID
serviceHandler :: Stored s -> ServiceHandler s ()
diff --git a/test/chatroom.test b/test/chatroom.test
index 862087d..54f9b2a 100644
--- a/test/chatroom.test
+++ b/test/chatroom.test
@@ -1,3 +1,5 @@
+def refpat = /blake2#[0-9a-f]+/
+
test ChatroomSetup:
let services = "chatroom"
@@ -489,3 +491,172 @@ test ChatroomIdentity:
guard (name1 == "Custom1")
expect /chatroom-message-new [a-z0-9#]+ room first_room from ([^ ]+) text message4/ capture name2
guard (name2 == "Custom2")
+
+
+test ChatroomDelete:
+ let services = "chatroom"
+
+ node n1
+ node n2
+ node n3
+
+ # Create and sync chatrooms on n1 and sync to n2
+ local:
+ spawn as p1 on n1
+ with p1:
+ send "create-identity Device1 Owner1"
+ expect /create-identity-done .*/
+
+ send "chatroom-watch-local"
+ send "start-server services $services"
+
+ send "chatroom-create first"
+ send "chatroom-create second"
+ expect /chatroom-create-done $refpat first.*/
+ expect /chatroom-create-done $refpat second.*/
+
+
+ spawn as p2 on n2
+ with p2:
+ send "create-identity Device2 Owner2"
+ expect /create-identity-done .*/
+
+ send "chatroom-watch-local"
+ send "start-server services $services"
+
+ expect /chatroom-watched-added ($refpat) first sub false/ capture first
+ expect /chatroom-watched-added ($refpat) second sub false/ capture second
+
+ send "chatroom-subscribe $first"
+ send "chatroom-subscribe $second"
+ expect /chatroom-watched-updated $first first sub true .*/
+ expect /chatroom-watched-updated $second second sub true .*/
+
+ local:
+ spawn as p3 on n3
+ with p3:
+ send "create-identity Device3 Owner3"
+ expect /create-identity-done .*/
+
+ local:
+ spawn as p1 on n1
+ spawn as p2 on n2
+ spawn as p3 on n3
+
+ # Delete first chatroom from n1
+ with p1:
+ send "chatroom-watch-local"
+ send "start-server services $services"
+
+ send "chatroom-list-local"
+ expect /chatroom-list-item ($refpat) first sub true/ capture first
+ expect /chatroom-list-item $refpat second sub true/
+ local:
+ expect /chatroom-list-(.*)/ capture done
+ guard (done == "done")
+
+ send "chatroom-delete $first"
+ expect /chatroom-delete-done .*/
+
+ # Setup n3
+ with p3:
+ send "chatroom-watch-local"
+ send "start-server services $services"
+
+ expect /chatroom-watched-added $refpat second sub false/
+
+ # Check that both n1 and n3 see only the second chatroom
+ for p in [ p1, p3 ]:
+ with p:
+ send "chatroom-list-local"
+ expect /chatroom-list-item $refpat second .*/
+ local:
+ expect /chatroom-list-(.*)/ capture done
+ guard (done == "done")
+
+ # Reactive server on n2 and create third chatroom
+ with p2:
+ send "chatroom-watch-local"
+ send "start-server services $services"
+
+ send "chatroom-create third"
+ expect /chatroom-create-done $refpat third.*/
+
+ # Verify that first chatroom appears only on n3 ...
+ with p3:
+ expect /chatroom-watched-added $refpat first sub false/
+ expect /chatroom-watched-added $refpat third sub false/
+
+ send "chatroom-list-local"
+ expect /chatroom-list-item $refpat first .*/
+ expect /chatroom-list-item $refpat second .*/
+ expect /chatroom-list-item $refpat third .*/
+ local:
+ expect /chatroom-list-(.*)/ capture done
+ guard (done == "done")
+
+ # ... and not on n1
+ with p1:
+ expect /chatroom-watched-added ($refpat) third sub false/ capture third
+ send "chatroom-subscribe $third"
+ expect /chatroom-watched-updated $third third sub true .*/
+
+ send "chatroom-list-local"
+ expect /chatroom-list-item $refpat second .*/
+ expect /chatroom-list-item $refpat third .*/
+ local:
+ expect /chatroom-list-(.*)/ capture done
+ guard (done == "done")
+
+ # Delete second chatroom on n2
+ with p2:
+ send "chatroom-list-local"
+ expect /chatroom-list-item $refpat first .*/
+ expect /chatroom-list-item ($refpat) second .*/ capture second
+ expect /chatroom-list-item $refpat third .*/
+ local:
+ expect /chatroom-list-(.*)/ capture done
+ guard (done == "done")
+
+ send "chatroom-delete $second"
+ expect /chatroom-delete-done .*/
+
+ # Send messages
+ with p3:
+ send "chatroom-list-local"
+ expect /chatroom-list-item ($refpat) first .*/ capture first
+ expect /chatroom-list-item ($refpat) second .*/ capture second
+ expect /chatroom-list-item ($refpat) third .*/ capture third
+ local:
+ expect /chatroom-list-(.*)/ capture done
+ guard (done == "done")
+
+ send "chatroom-message-send $first message_first"
+ send "chatroom-message-send $second message_second"
+ send "chatroom-message-send $third message_third"
+
+ # Receive only to non-deleted ones
+ with p1:
+ expect /chatroom-message-new $refpat room second from Owner3 text message_second/
+ expect /chatroom-message-new $refpat room ([a-z]+) from Owner3 text ([a-z_]+)/ capture room, msg
+ guard (room == "third")
+ guard (msg == "message_third")
+
+ send "chatroom-list-local"
+ expect /chatroom-list-item $refpat second .*/
+ expect /chatroom-list-item $refpat third .*/
+ local:
+ expect /chatroom-list-(.*)/ capture done
+ guard (done == "done")
+ with p2:
+ expect /chatroom-message-new $refpat room first from Owner3 text message_first/
+ expect /chatroom-message-new $refpat room ([a-z]+) from Owner3 text ([a-z_]+)/ capture room, msg
+ guard (room == "third")
+ guard (msg == "message_third")
+
+ send "chatroom-list-local"
+ expect /chatroom-list-item $refpat first .*/
+ expect /chatroom-list-item $refpat third .*/
+ local:
+ expect /chatroom-list-(.*)/ capture done
+ guard (done == "done")
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-01 20:22:02 +0000