diff options
| -rw-r--r-- | main/Test.hs | 1 | ||||
| -rw-r--r-- | src/Erebos/Network.hs | 9 |
2 files changed, 6 insertions, 4 deletions
diff --git a/main/Test.hs b/main/Test.hs index 02534fd..01570ea 100644 --- a/main/Test.hs +++ b/main/Test.hs @@ -728,6 +728,7 @@ cmdStartServer = do modifyMVar_ rsPeers update modify $ \s -> s { tsServer = Just RunningServer {..} } + cmdOut "start-server-done" cmdStopServer :: Command cmdStopServer = do diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs index 2f3b278..225ba4a 100644 --- a/src/Erebos/Network.hs +++ b/src/Erebos/Network.hs @@ -449,16 +449,16 @@ startServer serverOptions serverOrigHead logd' serverServices = do erebosNetworkProtocol (headLocalIdentity serverOrigHead) logd logt protocolRawPath protocolControlFlow - forkServerThread server "main-loop" $ withSocketsDo $ do + withSocketsDo $ do let hints = defaultHints - { addrFlags = [AI_PASSIVE] + { addrFlags = [ AI_PASSIVE ] , addrFamily = AF_INET6 , addrSocketType = Datagram } addr:_ <- getAddrInfo (Just hints) Nothing (Just $ show $ serverPort serverOptions) let open = socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) closeAndNotify sock = close sock >> putMVar serverSocketClosed () - bracket open closeAndNotify $ \sock -> do + bracketOnError open closeAndNotify $ \sock -> do withFdSocket sock setCloseOnExecIfNeeded setSocketOption sock Broadcast 1 bind sock (addrAddress addr) `catchIOError` \e -> if @@ -470,7 +470,8 @@ startServer serverOptions serverOrigHead logd' serverServices = do bind sock (SockAddrInet6 0 f h s) | otherwise -> ioError e putMVar serverSocket sock - loop sock + forkServerThread server "main-loop" $ do + loop sock `finally` closeAndNotify sock forkServerThread server "service-handler" $ forever $ do ( peer, paddr, svc, ref, streams ) <- atomically $ readTQueue chanSvc |