diff options
Diffstat (limited to 'src/Erebos/Network.hs')
| -rw-r--r-- | src/Erebos/Network.hs | 32 |
1 files changed, 15 insertions, 17 deletions
diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs index 7c8c1e1..dfcb88f 100644 --- a/src/Erebos/Network.hs +++ b/src/Erebos/Network.hs @@ -294,22 +294,7 @@ startServer serverOptions serverOrigHead logd' serverServices = do either (atomically . logd . showErebosError) return =<< runExceptT =<< atomically (readTQueue serverIOActions) - let open addr = do - sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) - putMVar serverSocket sock - setSocketOption sock Broadcast 1 - withFdSocket sock setCloseOnExecIfNeeded - bind sock (addrAddress addr) `catchIOError` \e -> if - | isAlreadyInUseError e && serverRetryUnspecifiedPort serverOptions - , SockAddrInet6 _ f h s <- addrAddress addr - -> do atomically $ logd $ if serverPort serverOptions == discoveryPort - then "Failed to bind default discovery port, will not receive discovery packets on local network." - else "Failed to bind port " <> show (serverPort serverOptions) <> ", retrying with ephemeral one." - bind sock (SockAddrInet6 0 f h s) - | otherwise -> ioError e - return sock - - loop sock = do + let loop sock = do when (serverLocalDiscovery serverOptions) $ forkServerThread server "discovery" $ do announceAddreses <- fmap concat $ sequence $ [ map (SockAddrInet6 discoveryPort 0 discoveryMulticastGroup) <$> joinMulticast sock @@ -433,7 +418,20 @@ startServer serverOptions serverOrigHead logd' serverServices = do , addrSocketType = Datagram } addr:_ <- getAddrInfo (Just hints) Nothing (Just $ show $ serverPort serverOptions) - bracket (open addr) close loop + let open = socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) + bracket open close $ \sock -> do + withFdSocket sock setCloseOnExecIfNeeded + setSocketOption sock Broadcast 1 + bind sock (addrAddress addr) `catchIOError` \e -> if + | isAlreadyInUseError e && serverRetryUnspecifiedPort serverOptions + , SockAddrInet6 _ f h s <- addrAddress addr + -> do atomically $ logd $ if serverPort serverOptions == discoveryPort + then "Failed to bind default discovery port, will not receive discovery packets on local network." + else "Failed to bind port " <> show (serverPort serverOptions) <> ", retrying with ephemeral one." + bind sock (SockAddrInet6 0 f h s) + | otherwise -> ioError e + putMVar serverSocket sock + loop sock forkServerThread server "service-handler" $ forever $ do ( peer, paddr, svc, ref, streams ) <- atomically $ readTQueue chanSvc |