thereadme/serverman-repository
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

fix(nginx): better logging

Browse Source
This commit is contained in:
Mahdi Dibaiee 2017-04-01 12:00:50 +04:30
parent a646e2bd33
commit 587e54d6b6
1 changed files with 12 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
services/nginx/src/Main.hs
View File

@ -11,6 +11,7 @@ module Main (call, main) where
import System.FilePath import System.FilePath
import System.Process import System.Process
import Control.Concurrent.Async import Control.Concurrent.Async
import Control.Concurrent
import Control.Monad import Control.Monad
import Control.Monad.State hiding (liftIO) import Control.Monad.State hiding (liftIO)
import Control.Monad.Free import Control.Monad.Free
@ -36,6 +37,8 @@ module Main (call, main) where
(AppState { arguments }) <- get (AppState { arguments }) <- get
let params@(ServerParams { ssl, domain, directory, serverType, email }) = toServerParams arguments let params@(ServerParams { ssl, domain, directory, serverType, email }) = toServerParams arguments
done <- progressText "setting up nginx configuration"
verbose $ show params verbose $ show params
-- Turn SSL off at first, because we have not yet received a certificate -- Turn SSL off at first, because we have not yet received a certificate
@ -57,7 +60,7 @@ module Main (call, main) where
when (not ("error" `isInfixOf` stdout)) $ do when (not ("error" `isInfixOf` stdout)) $ do
verbose $ "writing params to " ++ path verbose $ "writing params to " ++ path
liftIO $ writeFile path (show params) liftIO $ writeFile path (show params)
liftIO . wait =<< restart restart
return () return ()
verbose $ "creating directories " ++ targetDir ++ ", " ++ parent verbose $ "creating directories " ++ targetDir ++ ", " ++ parent
@ -76,27 +79,28 @@ module Main (call, main) where
info $ "wrote ssl configuration to " ++ sslPath info $ "wrote ssl configuration to " ++ sslPath
done
liftIO $ writeFile path content liftIO $ writeFile path content
info $ "wrote your configuration file to " ++ path info $ "wrote your configuration file to " ++ path
liftIO . wait =<< restart restart
when ssl $ do when ssl $ do
done <- progressText "creating SSL certificate"
let dhparamPath = "/etc/ssl/certs/dhparam.pem" let dhparamPath = "/etc/ssl/certs/dhparam.pem"
dhExists <- liftIO $ doesFileExist dhparamPath dhExists <- liftIO $ doesFileExist dhparamPath
when (not dhExists) $ do when (not dhExists) $ do
verbose $ "creating dhparam using openssl" verbose $ "creating dhparam using openssl"
dhparam <- liftedAsync $ executeRoot "openssl" ["dhparam", "-out", dhparamPath, "2048"] "" True dhparam <- executeRoot "openssl" ["dhparam", "-out", dhparamPath, "2048"] "" True
liftIO $ wait dhparam
return () return ()
case serverType of case serverType of
Static -> do Static -> do
letsencrypt <- liftedAsync $ createCert path "letsencrypt" letsencrypt <- createCert path "letsencrypt"
done
liftIO $ wait letsencrypt
return () return ()
_ -> do _ -> do
info $ "you should use letsencrypt to create a certificate for your domain" info $ "you should use letsencrypt to create a certificate for your domain"
@ -108,7 +112,7 @@ module Main (call, main) where
return () return ()
where where
restart = liftedAsync $ do restart = do
result <- restartService "nginx" result <- restartService "nginx"
case result of case result of
Left err -> return () Left err -> return ()