fix(webserver, ssl): email is required for generating a certificate

This commit is contained in:
Mahdi Dibaiee 2017-02-22 13:25:17 +03:30
parent 9311e349cb
commit 4b48fd0f2a
3 changed files with 11 additions and 3 deletions

View File

@ -16,7 +16,7 @@ module System.Serverman.Actions.Nginx (nginx) where
import Data.List import Data.List
nginx :: ServerParams -> IO () nginx :: ServerParams -> IO ()
nginx params@(ServerParams { ssl, serverService, domain, directory, serverType }) = nginx params@(ServerParams { ssl, serverService, domain, directory, serverType, email }) =
do do
-- 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
let content = show (params { ssl = False, port = "80" }) let content = show (params { ssl = False, port = "80" })
@ -64,7 +64,7 @@ module System.Serverman.Actions.Nginx (nginx) where
putStrLn $ "restarted " ++ show serverService putStrLn $ "restarted " ++ show serverService
createCert path cmd = do createCert path cmd = do
result <- execute cmd ["certonly", "--webroot", "--webroot-path", directory, "-d", domain] "" False result <- execute cmd ["certonly", "--webroot", "--webroot-path", directory, "-d", domain, "--email", email] "" False
case result of case result of
Left _ -> if cmd == "letsencrypt" then createCert path "certbot" else return () Left _ -> if cmd == "letsencrypt" then createCert path "certbot" else return ()
Right stdout -> do Right stdout -> do

View File

@ -9,6 +9,7 @@ module System.Serverman.Actions.WebServer (ServerParams(..), ServerType(..)) whe
, domain :: String , domain :: String
, port :: String , port :: String
, forward :: String , forward :: String
, email :: String
, ssl :: Bool , ssl :: Bool
, serverType :: ServerType , serverType :: ServerType
, serverService :: Service , serverService :: Service

View File

@ -9,8 +9,10 @@ module System.Term ( initialize ) where
import qualified System.Console.CmdArgs.Explicit as E import qualified System.Console.CmdArgs.Explicit as E
import System.Environment import System.Environment
import System.Directory import System.Directory
import System.Exit
import Data.Monoid import Data.Monoid
import Data.Maybe import Data.Maybe
import Control.Monad
initialize = do initialize = do
args <- getArgs args <- getArgs
@ -48,6 +50,7 @@ module System.Term ( initialize ) where
, forward :: String , forward :: String
, wService :: String , wService :: String
, ssl :: Bool , ssl :: Bool
, email :: String
} }
| DatabaseParams { databaseName :: String | DatabaseParams { databaseName :: String
, dService :: String } , dService :: String }
@ -61,6 +64,7 @@ module System.Term ( initialize ) where
, port = def &= typ "PORT" &= help "port number to listen to, defaults to 80 for http and 443 for https" , port = def &= typ "PORT" &= help "port number to listen to, defaults to 80 for http and 443 for https"
, forward = def &= typ "PORT" &= help "the port to forward to (in case of a port-forwarding server)" , forward = def &= typ "PORT" &= help "the port to forward to (in case of a port-forwarding server)"
, ssl = False &= help "create a letsencrypt certificate for this domain, defaults to false" , ssl = False &= help "create a letsencrypt certificate for this domain, defaults to false"
, email = def &= help "email required for registering your certificate"
, wService = "nginx" &= help "service to build config for: nginx, defaults to nginx" &= explicit &= name "service" , wService = "nginx" &= help "service to build config for: nginx, defaults to nginx" &= explicit &= name "service"
} &= explicit &= name "webserver" } &= explicit &= name "webserver"
@ -72,7 +76,9 @@ module System.Term ( initialize ) where
install = InstallParams { iService = def &= argPos 0 install = InstallParams { iService = def &= argPos 0
} &= explicit &= name "install" } &= explicit &= name "install"
webserverSetup (WebServerParams { directory, domain, port, ssl, forward, wService }) = do webserverSetup (WebServerParams { directory, domain, port, ssl, forward, wService, email }) = do
when (ssl && null email) $ die "Email is required for generating a certificate"
let serverType let serverType
| (not . null) forward = S.PortForwarding | (not . null) forward = S.PortForwarding
| otherwise = S.Static | otherwise = S.Static
@ -93,6 +99,7 @@ module System.Term ( initialize ) where
, S.forward = forward , S.forward = forward
, S.serverType = serverType , S.serverType = serverType
, S.serverService = serviceName , S.serverService = serviceName
, S.email = email
} }
S.run $ S.detectOS >>= (S.install serviceName) >> S.newServer params S.run $ S.detectOS >>= (S.install serviceName) >> S.newServer params