diff --git a/serverman.cabal b/serverman.cabal index 93069e2..67d1c0e 100644 --- a/serverman.cabal +++ b/serverman.cabal @@ -19,8 +19,10 @@ library , System.Serverman , System.Serverman.Utils , System.Serverman.Action - , System.Serverman.Actions.Nginx , System.Serverman.Actions.WebServer + , System.Serverman.Actions.Nginx + , System.Serverman.Actions.Database + , System.Serverman.Actions.MySQL , System.Serverman.Actions.Install , System.Serverman.Actions.Env , System.Serverman.Services diff --git a/src/System/Serverman.hs b/src/System/Serverman.hs index b29663f..a152fb7 100644 --- a/src/System/Serverman.hs +++ b/src/System/Serverman.hs @@ -3,27 +3,33 @@ module System.Serverman ( run , module System.Serverman.Utils , module System.Serverman.Services , module System.Serverman.Actions.WebServer + , module System.Serverman.Actions.Database , module System.Serverman.Actions.Env , module System.Serverman.Actions.Install) where import System.Serverman.Action import System.Serverman.Utils import System.Serverman.Services - import System.Serverman.Actions.WebServer + import System.Serverman.Actions.Install import System.Serverman.Actions.Env - import System.Serverman.Actions.Nginx import System.Serverman.Actions.WebServer + import System.Serverman.Actions.Nginx + + import System.Serverman.Actions.Database + import System.Serverman.Actions.MySQL import Control.Monad.Free run :: Action r -> IO r run (Pure r) = return r run (Free (NewWebServer params next)) - | service params == NGINX = nginx params >> run next - -- | service == Apache = apache n >> run next + | serverService params == NGINX = nginx params >> run next | otherwise = run next run (Free (DetectOS next)) = getOS >>= run . next run (Free (Install os service next)) = installService os service >> run next + run (Free (NewDatabase params next)) + | databaseService params == MySQL = mysql params >> run next + | otherwise = run next diff --git a/src/System/Serverman/Action.hs b/src/System/Serverman/Action.hs index caad012..0412ec7 100644 --- a/src/System/Serverman/Action.hs +++ b/src/System/Serverman/Action.hs @@ -3,10 +3,12 @@ module System.Serverman.Action ( ActionF(..) , Action , newServer + , newDatabase , install , detectOS) where import System.Serverman.Actions.WebServer + import System.Serverman.Actions.Database import System.Serverman.Actions.Env import System.Serverman.Utils import System.Serverman.Services @@ -22,11 +24,13 @@ module System.Serverman.Action ( ActionF(..) import Data.Char data ActionF x = NewWebServer ServerParams x + | NewDatabase DatabaseParams x | DetectOS (OS -> x) | Install Service OS x instance Functor ActionF where fmap f (NewWebServer params x) = NewWebServer params (f x) + fmap f (NewDatabase params x) = NewDatabase params (f x) fmap f (Install service os x) = Install service os (f x) fmap f (DetectOS x) = DetectOS (f . x) @@ -35,6 +39,9 @@ module System.Serverman.Action ( ActionF(..) newServer :: ServerParams -> Action () newServer params = liftF $ NewWebServer params () + newDatabase :: DatabaseParams -> Action () + newDatabase params = liftF $ NewDatabase params () + install :: Service -> OS -> Action () install service os = liftF $ Install service os () diff --git a/src/System/Serverman/Actions/Database.hs b/src/System/Serverman/Actions/Database.hs new file mode 100644 index 0000000..7768cd8 --- /dev/null +++ b/src/System/Serverman/Actions/Database.hs @@ -0,0 +1,9 @@ +module System.Serverman.Actions.Database (DatabaseParams(..)) where + import System.Serverman.Utils + import System.Serverman.Services + + import Control.Monad.Free + + data DatabaseParams = DatabaseParams { database :: String + , databaseService :: Service + } deriving (Eq) diff --git a/src/System/Serverman/Actions/Env.hs b/src/System/Serverman/Actions/Env.hs index 67ed620..57cb9bb 100644 --- a/src/System/Serverman/Actions/Env.hs +++ b/src/System/Serverman/Actions/Env.hs @@ -1,4 +1,5 @@ module System.Serverman.Actions.Env (OS(..), getOS) where + import System.Serverman.Utils import System.Process import Data.List import System.IO.Error @@ -7,11 +8,11 @@ module System.Serverman.Actions.Env (OS(..), getOS) where data OS = Debian | Arch | Mac | Unknown deriving (Show, Eq) getOS = do - arch_release <- tryIOError $ readProcessWithExitCode "/usr/bin/cat" ["/etc/os-release"] "" - deb_release <- tryIOError $ readProcessWithExitCode "/usr/bin/cat" ["/etc/lsb-release"] "" - mac_release <- tryIOError $ readProcessWithExitCode "/usr/bin/sw_vers" ["-productName"] "" + arch_release <- execute "/usr/bin/cat" ["/etc/os-release"] "" False + deb_release <- execute "/usr/bin/cat" ["/etc/lsb-release"] "" False + mac_release <- execute "/usr/bin/sw_vers" ["-productName"] "" False - let (_, release, _) = head $ rights [arch_release, deb_release, mac_release] + let release = head $ rights [arch_release, deb_release, mac_release] distro | or $ map (`isInfixOf` release) ["ubuntu", "debian", "raspbian"] = Debian | "arch" `isInfixOf` release = Arch diff --git a/src/System/Serverman/Actions/Install.hs b/src/System/Serverman/Actions/Install.hs index c8133d3..ae05b99 100644 --- a/src/System/Serverman/Actions/Install.hs +++ b/src/System/Serverman/Actions/Install.hs @@ -12,28 +12,30 @@ module System.Serverman.Actions.Install (installService) where class Installable a where dependencies :: a -> [String] - package :: a -> String + package :: a -> OS -> String instance Installable Service where dependencies _ = [] - package NGINX = "nginx" - package Apache = "apache2" + package NGINX _ = "nginx" + package MySQL _ = "mysql" installService :: Service -> OS -> IO () installService service os = do - let command = case os of - Arch -> "pacman -S " - Debian -> "apt-get install " - Mac -> "brew install " - _ -> "echo 'Unknown operating system'" + let base = case os of + Arch -> ("pacman", ["-S", "--noconfirm", "--quiet"]) + Debian -> ("apt-get", ["install", "-y"]) + Mac -> ("brew", ["install", "-y"]) + _ -> ("echo", ["Unknown operating system"]) + pkg = package service os + process <- async $ do - result <- tryIOError $ callCommand (command ++ package service) + result <- execute (fst base) (snd base ++ [pkg]) "" True case result of - Left err -> - putStrLn $ commandError command - Right _ -> + Left err -> return () + Right stdout -> do + putStrLn stdout putStrLn $ "installed " ++ show service ++ "." wait process diff --git a/src/System/Serverman/Actions/MySQL.hs b/src/System/Serverman/Actions/MySQL.hs new file mode 100644 index 0000000..5a04a53 --- /dev/null +++ b/src/System/Serverman/Actions/MySQL.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE NamedFieldPuns #-} +module System.Serverman.Actions.MySQL (mysql) where + import System.Serverman.Actions.Database + import System.Serverman.Utils + + mysql :: DatabaseParams -> IO () + mysql (DatabaseParams { database, databaseService }) = do + return () diff --git a/src/System/Serverman/Actions/Nginx.hs b/src/System/Serverman/Actions/Nginx.hs index f68dbca..307a460 100644 --- a/src/System/Serverman/Actions/Nginx.hs +++ b/src/System/Serverman/Actions/Nginx.hs @@ -1,7 +1,9 @@ +{-# LANGUAGE NamedFieldPuns #-} module System.Serverman.Actions.Nginx (nginx) where import System.Serverman.Action import System.Serverman.Actions.WebServer import System.Serverman.Utils + import System.Serverman.Services import System.Directory import System.IO @@ -13,19 +15,19 @@ module System.Serverman.Actions.Nginx (nginx) where import Control.Monad.Free nginx :: ServerParams -> IO () - nginx params = + nginx params@(ServerParams { ssl, serverService, domain, directory, serverType }) = do -- Turn SSL off at first, because we have not yet received a certificate let content = show (params { ssl = False }) - parent = output params "configs" - path = parent domain params - targetDir = directory params + parent = configDirectory serverService "configs" + path = parent domain + targetDir = directory createDirectoryIfMissing True targetDir createDirectoryIfMissing True parent - when (ssl params) $ do - let sslPath = output params "ssl.conf" + when ssl $ do + let sslPath = configDirectory serverService "ssl.conf" writeFileIfMissing sslPath nginxSSL putStrLn $ "wrote ssl configuration to " ++ sslPath @@ -35,36 +37,32 @@ module System.Serverman.Actions.Nginx (nginx) where wait =<< restart - when (ssl params) $ do - case serverType params of + when ssl $ do + case serverType of Static -> do - let command = "certbot certonly --webroot --webroot-path " ++ directory params ++ " -d " ++ domain params letsencrypt <- async $ do - result <- tryIOError $ callCommand command + result <- execute "certbot" ["certonly", "--webroot", "--webroot-path", directory, "-d", domain] "" True case result of - Left err -> do - putStrLn $ commandError command + Left _ -> return () Right _ -> do - putStrLn $ "created a certificate for " ++ domain params + putStrLn $ "created a certificate for " ++ domain writeFile path (show params) wait =<< restart wait letsencrypt _ -> do putStrLn $ "you should use letsencrypt to create a certificate for your domain" - putStrLn $ "and put it in /etc/letsencrypt/live/" ++ domain params ++ "/fullchain.pem" + putStrLn $ "and put it in /etc/letsencrypt/live/" ++ domain ++ "/fullchain.pem" putStrLn $ "my suggestion is running this command:" - putStrLn $ "sudo certbot certonly --webroot --webroot-path -d " ++ domain params + putStrLn $ "sudo certbot certonly --webroot --webroot-path -d " ++ domain putStrLn $ "for more information, see: https://certbot.eff.org/" return () where restart = async $ do - let command = "systemctl restart nginx" - result <- tryIOError $ callCommand command + result <- execute "systemctl" ["restart", "nginx"] "" True case result of - Left err -> do - putStrLn $ commandError command + Left err -> return () Right _ -> - putStrLn $ "restarted " ++ show (service params) + putStrLn $ "restarted " ++ show serverService diff --git a/src/System/Serverman/Actions/WebServer.hs b/src/System/Serverman/Actions/WebServer.hs index 58cab75..6eab681 100644 --- a/src/System/Serverman/Actions/WebServer.hs +++ b/src/System/Serverman/Actions/WebServer.hs @@ -5,18 +5,17 @@ module System.Serverman.Actions.WebServer (ServerParams(..), ServerType(..)) whe import Control.Monad.Free data ServerType = Static | PortForwarding deriving (Show, Eq) - data ServerParams = ServerParams { directory :: String - , domain :: String - , port :: String - , forward :: String - , output :: String - , ssl :: Bool - , serverType :: ServerType - , service :: Service + data ServerParams = ServerParams { directory :: String + , domain :: String + , port :: String + , forward :: String + , ssl :: Bool + , serverType :: ServerType + , serverService :: Service } deriving (Eq) instance Show ServerParams where show conf - | service conf == NGINX = + | serverService conf == NGINX = let https | ssl conf = [ ("ssl_certificate", "/etc/letsencrypt/live/" ++ domain conf ++ "/fullchain.pem") , ("ssl_certificate_key", "/etc/letsencrypt/live/" ++ domain conf ++ "/privkey.pem") diff --git a/src/System/Serverman/Services.hs b/src/System/Serverman/Services.hs index 438f10b..5985c91 100644 --- a/src/System/Serverman/Services.hs +++ b/src/System/Serverman/Services.hs @@ -1,9 +1,18 @@ module System.Serverman.Services ( Service(..) - , ) where + , configDirectory) where - data Service = NGINX | Apache deriving (Eq, Show) + data Service = NGINX + | MySQL + deriving (Eq, Show) + + class Configurable a where + configDirectory :: a -> FilePath + + instance Configurable Service where + configDirectory NGINX = "/etc/nginx/" + configDirectory mysql = "/etc/mysql/" instance Read Service where readsPrec _ service - | service == "nginx" || service == "n" = [(NGINX, [])] - | service == "apache" || service == "a" = [(Apache, [])] + | service == "nginx" = [(NGINX, [])] + | service == "mysql" = [(MySQL, [])] diff --git a/src/System/Serverman/Utils.hs b/src/System/Serverman/Utils.hs index 7494d4c..e77f7e0 100644 --- a/src/System/Serverman/Utils.hs +++ b/src/System/Serverman/Utils.hs @@ -2,11 +2,17 @@ module System.Serverman.Utils ( keyvalue , nginxBlock , nginxSSL , writeFileIfMissing - , commandError) where + , commandError + , execute) where import System.IO import Control.Monad import System.Directory + import System.Process + import System.IO.Error + import Control.Concurrent.Async + import Data.List + import Control.Exception keyvalue :: [(String, String)] -> String keyvalue ((a, b):xs) = a ++ " " ++ b ++ ";\n" ++ keyvalue xs @@ -28,6 +34,21 @@ module System.Serverman.Utils ( keyvalue commandError :: String -> String commandError command = "[Error] an error occured while running: " ++ command ++ "\nplease try running the command manually." + execute :: String -> [String] -> String -> Bool -> IO (Either String String) + execute cmd args stdin logErrors = do + let command = cmd ++ " " ++ intercalate " " args + + process <- async $ do + result <- tryIOError $ readProcessWithExitCode cmd args stdin + + case result of + Right (_, stdout, _) -> return $ Right stdout + Left err -> do + when logErrors $ putStrLn (commandError command) + return $ Left (show err) + + wait process + nginxSSL = "ssl_protocols TLSv1 TLSv1.1 TLSv1.2;\n\ \ssl_prefer_server_ciphers on;\n\ \ssl_dhparam /etc/ssl/certs/dhparam.pem;\n\ diff --git a/src/System/Term.hs b/src/System/Term.hs index c752665..e6ab98c 100644 --- a/src/System/Term.hs +++ b/src/System/Term.hs @@ -12,18 +12,31 @@ module System.Term ( initialize ) where import Data.Maybe initialize = do - let mode = cmdArgsMode $ modes [webserver, install] &= program "serverman" &= summary "serverman v0.1.0, (C) Mahdi Dibaiee 2017" + args <- getArgs + let mode = cmdArgsMode $ modes [install, webserver, database] + &= program "serverman" + &= summary "serverman v0.1.0, (C) Mahdi Dibaiee 2017" + &= helpArg [name "h"] - (CmdArgs args help version _ _) <- E.processArgs mode + let fixArgs + | null args = ["--help"] + | otherwise = args - if isJust help then - putStrLn $ fromJust help - else if isJust version then - putStrLn $ fromJust version - else - case args of - p@(WebServerParams _ _ _ _ _ _ _) -> webServer p - p@(InstallParams _) -> manualInstall p + let result = E.process mode fixArgs + + case result of + Right (CmdArgs args help version _ _) -> + if isJust help then + putStrLn $ fromJust help + else if isJust version then + putStrLn $ fromJust version + else + case args of + p@(WebServerParams {}) -> webserverSetup p + p@(InstallParams {}) -> manualInstall p + p@(DatabaseParams {}) -> databaseSetup p + Left err -> + print err return () @@ -31,29 +44,34 @@ module System.Term ( initialize ) where data Params = WebServerParams { directory :: String , domain :: String , port :: String - , ssl :: Bool , forward :: String - , wService :: String - , output :: String + , wService :: String + , ssl :: Bool } + | DatabaseParams { databaseName :: String + , dService :: String } | InstallParams { iService :: String } deriving (Show, Data, Typeable) webserver = WebServerParams { directory = "/var/www/html/" &= typDir &= help "directory to serve static files from, defaults to /var/www/html/" - , domain = "test.dev" &= typ "DOMAIN" &= help "domain/server name, defaults to test.dev" - , 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)" - , ssl = False &= help "create a letsencrypt certificate for this domain, defaults to false" - , wService = "nginx" &= help "service to build config for: (n)ginx, (a)pache, defaults to nginx" &= explicit &= name "service" - , output = def &= help "output directory for the selected service, defaults to /etc/nginx for nginx and /etc/apache2 for apache" + , domain = "test.dev" &= typ "DOMAIN" &= help "domain/server name, defaults to test.dev" + , 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)" + , ssl = False &= help "create a letsencrypt certificate for this domain, defaults to false" + , wService = "nginx" &= help "service to build config for: nginx, defaults to nginx" &= explicit &= name "service" } &= explicit &= name "webserver" + database = DatabaseParams { databaseName = "test" &= help "database name, defaults to test" &= explicit &= name "name" + , dService = "mysql" &= help "service to setup: mysql, defaults to mysql" &= explicit &= name "service" + } &= explicit &= name "database" + + install = InstallParams { iService = def &= argPos 0 } &= explicit &= name "install" - webServer (WebServerParams { directory, domain, port, ssl, forward, wService, output }) = do + webserverSetup (WebServerParams { directory, domain, port, ssl, forward, wService }) = do let serverType | (not . null) forward = S.PortForwarding | otherwise = S.Static @@ -65,22 +83,22 @@ module System.Term ( initialize ) where | ssl = "403" | otherwise = "80" - let outDir - | (not . null) output = output - | serviceName == S.NGINX = "/etc/nginx/" - | serviceName == S.Apache = "/etc/apache2/" - - let params = S.ServerParams { S.directory = directory - , S.domain = domain - , S.port = portNumber - , S.ssl = ssl - , S.forward = forward - , S.serverType = serverType - , S.service = serviceName - , S.output = outDir + let params = S.ServerParams { S.directory = directory + , S.domain = domain + , S.port = portNumber + , S.ssl = ssl + , S.forward = forward + , S.serverType = serverType + , S.serverService = serviceName } S.run $ S.newServer params manualInstall (InstallParams { iService }) = do S.run $ S.detectOS >>= (S.install (read iService)) + databaseSetup (DatabaseParams { databaseName, dService }) = do + let params = S.DatabaseParams { S.database = databaseName + , S.databaseService = read dService } + + S.run $ S.newDatabase params +