Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-03-26 02:11:53 +00:00
Code Issues Packages Projects Releases Wiki Activity

fixes file descriptor leak

Browse Source
This commit is contained in:
Keagan McClelland
2022-02-01 17:35:00 -07:00
parent b43d85ea63
commit 139ba20e2f
2 changed files with 25 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
src/Application.hs
View File

@@ -301,23 +301,27 @@ startWeb foundation = do
runLog $ $logInfo $ [i|Launching Tor Web Server on port #{torPort}|] runLog $ $logInfo $ [i|Launching Tor Web Server on port #{torPort}|]
torAction <- async $ runSettings (warpSettings torPort foundation) app torAction <- async $ runSettings (warpSettings torPort foundation) app
runLog $ $logInfo $ [i|Launching Web Server on port #{appPort}|] runLog $ $logInfo $ [i|Launching Web Server on port #{appPort}|]
action <- if sslAuto action <- async $ if sslAuto
then async $ runTLS (tlsSettings sslCertLocation sslKeyLocation) (warpSettings appPort foundation) app then runTLS (tlsSettings sslCertLocation sslKeyLocation) (warpSettings appPort foundation) app
else async $ runSettings (warpSettings appPort foundation) app else runSettings (warpSettings appPort foundation) app
let actions = (action, torAction)
setWebProcessThreadId (join (***) asyncThreadId actions) foundation setWebProcessThreadId (asyncThreadId action, asyncThreadId torAction) foundation
(clearRes, torRes) <- both waitCatch actions res <- waitEitherCatchCancel action torAction
case clearRes of case res of
Left e -> do Left clearRes -> case clearRes of
putStr @Text "Clearnet ServerError: " Left e -> do
print e putStr @Text "Clearnet ServerError: "
Right _ -> pure () print e
case torRes of Right _ -> do
Left e -> do putStrLn @Text "Clearnet Server Exited"
putStr @Text "Tor ServerError: " void $ swapMVar (appShouldRestartWeb foundation) True
print e Right torRes -> case torRes of
Right _ -> pure () Left e -> do
putStr @Text "Tor ServerError: "
print e
Right _ -> do
putStrLn @Text "Tor Server Exited"
void $ swapMVar (appShouldRestartWeb foundation) True
shouldRestart <- takeMVar (appShouldRestartWeb foundation) shouldRestart <- takeMVar (appShouldRestartWeb foundation)
when shouldRestart $ do when shouldRestart $ do
putMVar (appShouldRestartWeb foundation) False putMVar (appShouldRestartWeb foundation) False

5
stack.yaml
View File

@@ -44,6 +44,11 @@ extra-deps:
- esqueleto-3.5.1.0 - esqueleto-3.5.1.0
- monad-logger-extras-0.1.1.1 - monad-logger-extras-0.1.1.1
- wai-request-spec-0.10.2.4 - wai-request-spec-0.10.2.4
- git: https://github.com/ProofOfKeags/wai
commit: 2eef8506c7eec67fa5c1be0e0470a38e277ab5d8
subdirs:
- warp
- warp-tls
# Override default flag values for local packages and extra-deps # Override default flag values for local packages and extra-deps
# flags: {} # flags: {}