exit cleanly on eg, failure to bind socket

This commit is contained in:
Joey Hess 2024-07-22 20:37:37 -04:00
parent 9984252ab5
commit 53000cf06e
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38

View file

@ -185,26 +185,35 @@ withLocalP2PConnections workerpool a = do
myuuid <- getUUID myuuid <- getUUID
reqv <- liftIO newEmptyTMVarIO reqv <- liftIO newEmptyTMVarIO
relv <- liftIO newEmptyTMVarIO relv <- liftIO newEmptyTMVarIO
asyncservicer <- liftIO $ async $ servicer myuuid reqv relv endv <- liftIO newEmptyTMVarIO
a (acquireconn reqv) `finally` join (liftIO (wait asyncservicer)) asyncservicer <- liftIO $ async $ servicer myuuid reqv relv endv
let endit = do
liftIO $ atomically $ putTMVar endv ()
liftIO $ wait asyncservicer
a (acquireconn reqv) `finally` endit
where where
acquireconn reqv connparams = do acquireconn reqv connparams = do
respvar <- newEmptyTMVarIO respvar <- newEmptyTMVarIO
atomically $ putTMVar reqv (connparams, respvar) atomically $ putTMVar reqv (connparams, respvar)
atomically $ takeTMVar respvar atomically $ takeTMVar respvar
servicer myuuid reqv relv = do servicer myuuid reqv relv endv = do
reqrel <- liftIO $ reqrel <- liftIO $
atomically $ atomically $
(Right <$> takeTMVar reqv) (Right <$> takeTMVar reqv)
`orElse` `orElse`
(Left <$> takeTMVar relv) (Left . Right <$> takeTMVar relv)
`orElse`
(Left . Left <$> takeTMVar endv)
case reqrel of case reqrel of
Right (connparams, respvar) -> Right (connparams, respvar) -> do
servicereq myuuid relv connparams servicereq myuuid relv connparams
>>= atomically . putTMVar respvar >>= atomically . putTMVar respvar
Left releaseconn -> releaseconn servicer myuuid reqv relv endv
servicer myuuid reqv relv Left (Right releaseconn) -> do
releaseconn
servicer myuuid reqv relv endv
Left (Left ()) -> return ()
servicereq myuuid relv connparams servicereq myuuid relv connparams
| connectionServerUUID connparams /= myuuid = | connectionServerUUID connparams /= myuuid =