fix(install): don't show output of install to user
feat(mysql): add mysql as a service, only installation works right now, there's no configuration feat(execute): internal function to execute commands
This commit is contained in:
Mahdi Dibaiee
9
src/System/Serverman/Actions/Database.hs
Normal file
9
src/System/Serverman/Actions/Database.hs
Normal file
@ -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)
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
8
src/System/Serverman/Actions/MySQL.hs
Normal file
8
src/System/Serverman/Actions/MySQL.hs
Normal file
@ -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 ()
|
||||
@ -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 <YOUR_APPLICATION_DIRECTORY> -d " ++ domain params
|
||||
putStrLn $ "sudo certbot certonly --webroot --webroot-path <YOUR_APPLICATION_DIRECTORY> -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
|
||||
|
||||
|
||||
@ -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")
|
||||
|
||||
Reference in New Issue
Block a user