feat(mongodb): mongodb dummy data and initialization

feat(utils, execute): executeRoot for running as sudo, by default runs
as current user
This commit is contained in:
Mahdi Dibaiee 2017-02-23 12:38:39 +03:30
parent 4f736b738b
commit 3595464b11
12 changed files with 247 additions and 22 deletions

View File

@ -23,8 +23,10 @@ library
, System.Serverman.Actions.Nginx , System.Serverman.Actions.Nginx
, System.Serverman.Actions.Database , System.Serverman.Actions.Database
, System.Serverman.Actions.MySQL , System.Serverman.Actions.MySQL
, System.Serverman.Actions.MongoDB
, System.Serverman.Actions.Install , System.Serverman.Actions.Install
, System.Serverman.Actions.Env , System.Serverman.Actions.Env
, System.Serverman.Actions.Start
, System.Serverman.Services , System.Serverman.Services
build-depends: base >= 4.7 && < 5 build-depends: base >= 4.7 && < 5
, free >= 4.12.4 && < 5 , free >= 4.12.4 && < 5
@ -35,6 +37,10 @@ library
, directory , directory
, filepath , filepath
, async , async
, mysql >= 0.1.4 && < 1
, mongoDB >= 2.1.1.1 && < 3
, text
, bytestring
default-language: Haskell2010 default-language: Haskell2010
executable serverman executable serverman

View File

@ -11,14 +11,16 @@ module System.Serverman ( run
import System.Serverman.Utils import System.Serverman.Utils
import System.Serverman.Services import System.Serverman.Services
import System.Serverman.Actions.Install
import System.Serverman.Actions.Env import System.Serverman.Actions.Env
import System.Serverman.Actions.Install
import System.Serverman.Actions.Start
import System.Serverman.Actions.WebServer import System.Serverman.Actions.WebServer
import System.Serverman.Actions.Nginx import System.Serverman.Actions.Nginx
import System.Serverman.Actions.Database import System.Serverman.Actions.Database
import System.Serverman.Actions.MySQL import System.Serverman.Actions.MySQL
import System.Serverman.Actions.MongoDB
import Control.Monad.Free import Control.Monad.Free
@ -28,8 +30,10 @@ module System.Serverman ( run
| serverService params == NGINX = nginx params >> run next | serverService params == NGINX = nginx params >> run next
| otherwise = run next | otherwise = run next
run (Free (DetectOS next)) = getOS >>= run . next run (Free (DetectOS next)) = getOS >>= run . next
run (Free (Start os service next)) = startService os service >> run next
run (Free (Install os service next)) = installService os service >> run next run (Free (Install os service next)) = installService os service >> run next
run (Free (NewDatabase params next)) run (Free (NewDatabase params next))
| databaseService params == MySQL = mysql params >> run next | databaseService params == MySQL = mysql params >> run next
| databaseService params == MongoDB = mongodb params >> run next
| otherwise = run next | otherwise = run next

View File

@ -4,10 +4,13 @@ module System.Serverman.Action ( ActionF(..)
, Action , Action
, newServer , newServer
, newDatabase , newDatabase
, newFileSharing
, start
, install , install
, detectOS) where , detectOS) where
import System.Serverman.Actions.WebServer import System.Serverman.Actions.WebServer
import System.Serverman.Actions.FileSharing
import System.Serverman.Actions.Database import System.Serverman.Actions.Database
import System.Serverman.Actions.Env import System.Serverman.Actions.Env
import System.Serverman.Utils import System.Serverman.Utils
@ -25,13 +28,17 @@ module System.Serverman.Action ( ActionF(..)
data ActionF x = NewWebServer ServerParams x data ActionF x = NewWebServer ServerParams x
| NewDatabase DatabaseParams x | NewDatabase DatabaseParams x
| NewFileSharing FileSharingParams x
| DetectOS (OS -> x) | DetectOS (OS -> x)
| Install Service OS x | Install Service OS x
| Start Service OS x
instance Functor ActionF where instance Functor ActionF where
fmap f (NewWebServer params x) = NewWebServer params (f x) fmap f (NewWebServer params x) = NewWebServer params (f x)
fmap f (NewDatabase params x) = NewDatabase params (f x) fmap f (NewDatabase params x) = NewDatabase params (f x)
fmap f (NewSharedFolder params x) = NewSharedFolder params (f x)
fmap f (Install service os x) = Install service os (f x) fmap f (Install service os x) = Install service os (f x)
fmap f (Start service os x) = Start service os (f x)
fmap f (DetectOS x) = DetectOS (f . x) fmap f (DetectOS x) = DetectOS (f . x)
type Action = Free ActionF type Action = Free ActionF
@ -42,8 +49,14 @@ module System.Serverman.Action ( ActionF(..)
newDatabase :: DatabaseParams -> Action () newDatabase :: DatabaseParams -> Action ()
newDatabase params = liftF $ NewDatabase params () newDatabase params = liftF $ NewDatabase params ()
newFileSharing :: FileSharingParams -> Action ()
newFileSharing params = liftF $ NewFileSharing params ()
install :: Service -> OS -> Action () install :: Service -> OS -> Action ()
install service os = liftF $ Install service os () install service os = liftF $ Install service os ()
start :: Service -> OS -> Action ()
start service os = liftF $ Start service os ()
detectOS :: Action OS detectOS :: Action OS
detectOS = liftF $ DetectOS id detectOS = liftF $ DetectOS id

View File

@ -1,4 +1,4 @@
module System.Serverman.Actions.Database (DatabaseParams(..)) where module System.Serverman.Actions.Database (DatabaseParams(..), dummy) where
import System.Serverman.Utils import System.Serverman.Utils
import System.Serverman.Services import System.Serverman.Services
@ -6,4 +6,49 @@ module System.Serverman.Actions.Database (DatabaseParams(..)) where
data DatabaseParams = DatabaseParams { database :: String data DatabaseParams = DatabaseParams { database :: String
, databaseService :: Service , databaseService :: Service
, dummyData :: Bool
, databaseUser :: String
, databasePass :: String
, databaseHost :: String
} deriving (Eq) } deriving (Eq)
dummy = ("serverman_users", ["first_name", "last_name", "email", "children", "birth_date", "gender"], [
["MacKenzie","Wilcox","vel.sapien.imperdiet@bibendumsedest.com","4","1997-10-30T06:29:02-08:00","Male"],
["Martha","Elliott","Phasellus@luctusetultrices.com","3","2000-03-04T00:53:32-08:00","Male"],
["Declan","Nash","ut.quam@ultriciessemmagna.net","1","1975-08-02T00:27:02-07:00","Female"],
["Kasimir","Fisher","sit.amet.consectetuer@sapien.net","2","2015-06-09T21:45:41-07:00","Male"],
["Uma","Kelley","vulputate@maurisa.ca","2","1990-05-27T06:28:00-07:00","Female"],
["Hayley","Owen","eu.eros@velnisl.org","4","2013-07-02T06:13:04-07:00","Male"],
["Pamela","Hebert","vestibulum.lorem@molestietellus.net","1","1998-01-21T05:32:18-08:00","Female"],
["Sydnee","Irwin","ultrices@consectetueradipiscing.edu","4","1984-01-15T22:55:10-08:00","Female"],
["Brandon","Sharp","non@nunc.co.uk","3","2000-06-21T10:05:13-07:00","Female"],
["Gray","Guerrero","ipsum@magnaUttincidunt.net","1","1975-12-02T06:59:56-08:00","Female"],
["Nomlanga","Mercado","dolor.Quisque.tincidunt@Donec.edu","1","2015-07-04T01:21:44-07:00","Male"],
["Luke","Frazier","Aenean.sed.pede@Etiamvestibulum.co.uk","1","2007-01-22T22:03:24-08:00","Male"],
["Cynthia","Farmer","vel@eratEtiam.co.uk","3","1975-06-20T06:40:51-07:00","Female"],
["Timothy","Hopper","magna.Praesent.interdum@Phasellusvitaemauris.org","1","1991-03-18T15:36:03-08:00","Male"],
["Graiden","Walton","est.mauris@aultricies.edu","1","1997-12-06T10:35:10-08:00","Female"],
["Abigail","Webster","elementum.dui@Duissitamet.com","4","1978-05-03T13:39:42-07:00","Female"],
["Samuel","Dyer","parturient.montes@Etiamligula.org","3","2002-08-30T21:34:17-07:00","Female"],
["May","Blackburn","montes.nascetur.ridiculus@Aliquameratvolutpat.org","1","2004-11-01T13:10:43-08:00","Female"],
["Regina","Hicks","Sed.nulla.ante@atpretium.edu","2","2005-08-28T02:52:49-07:00","Female"],
["Roth","Bright","lacus@feugiattellus.edu","4","2010-07-26T14:27:31-07:00","Male"],
["Sylvester","Chapman","Sed.eu@sitametdiam.edu","4","1975-01-23T19:36:26-08:00","Male"],
["Martin","Sharp","Nullam@Vivamusnibh.net","2","2016-10-18T23:48:20-07:00","Male"],
["Mary","Schroeder","sem.egestas.blandit@nullaatsem.com","1","1993-03-16T17:41:10-08:00","Female"],
["Blythe","Alston","amet.faucibus.ut@ornareFuscemollis.org","1","1980-09-22T04:58:53-07:00","Female"],
["Nathan","Ramsey","in.molestie@Mauris.ca","4","2006-05-07T08:30:57-07:00","Female"],
["Zelenia","Meadows","nunc@Aenean.com","3","1983-04-03T01:42:18-08:00","Female"],
["Karyn","Booker","tempor@sagittissemperNam.ca","3","2006-10-13T02:29:44-07:00","Male"],
["Hiram","Booth","semper@risusDonecegestas.ca","4","2001-10-30T19:53:13-08:00","Male"],
["Robert","Mcclure","semper@nonduinec.org","1","2012-11-14T17:32:09-08:00","Female"],
["Celeste","Callahan","convallis@NulladignissimMaecenas.edu","1","1984-08-22T22:56:35-07:00","Female"],
["Magee","Olsen","ligula.consectetuer.rhoncus@fermentumvel.com","2","1978-04-09T15:12:05-08:00","Female"],
["Dana","Mccullough","ut.sem.Nulla@eleifendnec.net","4","2000-08-23T07:54:53-07:00","Male"],
["Yen","Blanchard","et@Morbi.org","3","1997-05-09T03:30:56-07:00","Male"],
["Cora","Valdez","lorem.vitae.odio@vulputateullamcorpermagna.net","2","1998-10-24T16:06:46-07:00","Male"],
["Amela","Blackburn","vulputate.dui@ultrices.co.uk","3","2006-03-08T07:42:27-08:00","Male"],
["Dean","Blanchard","ac.tellus@nonummyipsumnon.co.uk","2","2014-12-21T14:38:37-08:00","Female"],
["Alika","Shields","est.mauris@mollis.co.uk","3","1976-11-08T22:32:16-08:00","Female"],
["Byron","Dudley","mattis@nequeNullam.org","1","1992-07-04T12:32:20-07:00","Female"],
["Noelle","Young","et.malesuada.fames@aliquetmolestietellus.net","2","2009-04-05T03:05:01-07:00","Female"]])

View File

@ -1,4 +1,4 @@
module System.Serverman.Actions.Install (installService) where module System.Serverman.Actions.Install (installService, package, dependencies) where
import System.Serverman.Action import System.Serverman.Action
import System.Serverman.Utils import System.Serverman.Utils
import System.Serverman.Services import System.Serverman.Services
@ -19,12 +19,17 @@ module System.Serverman.Actions.Install (installService) where
dependencies NGINX = [LetsEncrypt] dependencies NGINX = [LetsEncrypt]
dependencies _ = [] dependencies _ = []
package NGINX _ = "nginx"
package MySQL _ = "mysql"
package LetsEncrypt Arch = "certbot" package LetsEncrypt Arch = "certbot"
package LetsEncrypt _ = "letsencrypt" package LetsEncrypt _ = "letsencrypt"
package NGINX _ = "nginx"
package MySQL _ = "mysql"
package MongoDB _ = "mongodb"
package VsFTPd _ = "vsftpd"
installService :: Service -> OS -> IO () installService :: Service -> OS -> IO ()
installService service os = do installService service os = do
forM_ (dependencies service) (`installService` os) forM_ (dependencies service) (`installService` os)
@ -37,7 +42,7 @@ module System.Serverman.Actions.Install (installService) where
pkg = package service os pkg = package service os
process <- async $ do process <- async $ do
result <- execute (fst base) (snd base ++ [pkg]) "" True result <- executeRoot (fst base) (snd base ++ [pkg]) "" True
case result of case result of
Left err -> return () Left err -> return ()

View File

@ -0,0 +1,54 @@
{-# LANGUAGE NamedFieldPuns #-}
module System.Serverman.Actions.MongoDB (mongodb) where
import System.Serverman.Actions.Database
import System.Serverman.Utils hiding (execute)
import Database.MongoDB
import qualified Data.ByteString.Char8 as BS
import Data.List hiding (delete)
import qualified Data.Text as T
import Control.Monad
import System.IO.Error
mongodb :: DatabaseParams -> IO ()
mongodb (DatabaseParams { database, dummyData, databaseHost }) = do
result <- tryIOError $ connect (readHostPort databaseHost)
case result of
Right pipe -> do
e <- access pipe master (T.pack database) run
close pipe
Left err -> do
putStrLn $ show err
putStrLn $ "[Error] could not connect to MongoDB server " ++ databaseHost
where
run = do
when dummyData $ do
clearCollection
insertToCollection
return ()
clearCollection = delete (select [] (T.pack collectionName))
where (collectionName, _, _) = dummy
insertToCollection = insertMany (T.pack collectionName) records
where
(collectionName, definitions, rows) = dummy
records = map (\row -> zipWith (\def value -> def =: row) (map T.pack definitions) row) rows
createDummyTables = createTable dummy
where
createTable (tableName, columns, rows) = "CREATE TABLE IF NOT EXISTS " ++ tableName ++ "(" ++ intercalate "," (map columnDef columns) ++ ")";
columnDef "children" = "children INT"
columnDef "birth_date" = "birth_date DATETIME"
columnDef "gender" = "gender ENUM('Male', 'Female')"
columnDef name = name ++ " VARCHAR(255)"
insertToDummyTables = insertTable dummy
where
insertTable (tableName, _, rows) = "INSERT INTO " ++ tableName ++ " VALUES " ++ intercalate "," (map insertRow rows)
insertRow row = "('" ++ intercalate "','" row ++ "')"

View File

@ -1,8 +1,45 @@
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
module System.Serverman.Actions.MySQL (mysql) where module System.Serverman.Actions.MySQL (mysql) where
import System.Serverman.Actions.Database import System.Serverman.Actions.Database
import System.Serverman.Utils import System.Serverman.Utils hiding (execute)
import Database.MySQL.Base
import qualified Data.ByteString.Char8 as BS
import Data.List
import Control.Monad
mysql :: DatabaseParams -> IO () mysql :: DatabaseParams -> IO ()
mysql (DatabaseParams { database, databaseService }) = do mysql (DatabaseParams { database, dummyData, databaseUser, databasePass, databaseHost }) = do
conn <- connect $ defaultConnectInfo { connectUser = databaseUser, connectPassword = databasePass, connectHost = databaseHost }
query conn $ BS.pack ("CREATE DATABASE IF NOT EXISTS " ++ database)
when dummyData $ do
let (tableName, _, _) = dummy
query conn $ BS.pack createDummyTables
query conn $ BS.pack clearTable
query conn $ BS.pack insertToDummyTables
putStrLn $ "Created dummy table '" ++ tableName ++ "' and filled it with data."
return () return ()
return ()
clearTable = "DELETE FROM " ++ tableName
where (tableName, _, _) = dummy
createDummyTables = createTable dummy
where
createTable (tableName, columns, rows) = "CREATE TABLE IF NOT EXISTS " ++ tableName ++ "(" ++ intercalate "," (map columnDef columns) ++ ")";
columnDef "children" = "children INT"
columnDef "birth_date" = "birth_date DATETIME"
columnDef "gender" = "gender ENUM('Male', 'Female')"
columnDef name = name ++ " VARCHAR(255)"
insertToDummyTables = insertTable dummy
where
insertTable (tableName, _, rows) = "INSERT INTO " ++ tableName ++ " VALUES " ++ intercalate "," (map insertRow rows)
insertRow row = "('" ++ intercalate "','" row ++ "')"

View File

@ -46,7 +46,7 @@ module System.Serverman.Actions.Nginx (nginx) where
dhExists <- doesFileExist dhparamPath dhExists <- doesFileExist dhparamPath
when (not dhExists) $ do when (not dhExists) $ do
dhparam <- async $ execute "openssl" ["dhparam", "-out", dhparamPath, "2048"] "" True dhparam <- async $ executeRoot "openssl" ["dhparam", "-out", dhparamPath, "2048"] "" True
wait dhparam wait dhparam
return () return ()
@ -65,14 +65,14 @@ module System.Serverman.Actions.Nginx (nginx) where
return () return ()
where where
restart = async $ do restart = async $ do
result <- execute "systemctl" ["restart", "nginx"] "" True result <- executeRoot "systemctl" ["restart", "nginx"] "" True
case result of case result of
Left err -> return () Left err -> return ()
Right _ -> Right _ ->
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, "--email", email, "--agree-tos", "-n"] "" False result <- executeRoot cmd ["certonly", "--webroot", "--webroot-path", directory, "-d", domain, "--email", email, "--agree-tos", "-n"] "" 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

@ -0,0 +1,12 @@
module System.Serverman.Actions.Start (startService) where
import System.Serverman.Utils
import System.Serverman.Actions.Env
import System.Serverman.Actions.Install
import System.Serverman.Services
startService :: Service -> OS -> IO ()
startService service os
| os == Mac = putStrLn $ "Couldn't start " ++ package service os ++ " automatically. If you encounter any problems, make sure it is running."
| otherwise = executeRoot "systemctl" ["start", package service os] "" True
>> execute "sleep" ["5s"] "" True
>> return ()

View File

@ -3,6 +3,8 @@ module System.Serverman.Services ( Service(..)
data Service = NGINX data Service = NGINX
| MySQL | MySQL
| MongoDB
| VsFTPd
| LetsEncrypt | LetsEncrypt
deriving (Eq, Show) deriving (Eq, Show)
@ -11,10 +13,14 @@ module System.Serverman.Services ( Service(..)
instance Configurable Service where instance Configurable Service where
configDirectory NGINX = "/etc/nginx/" configDirectory NGINX = "/etc/nginx/"
configDirectory mysql = "/etc/mysql/" configDirectory MySQL = "/etc/mysql/"
configDirectory MongoDB = "/etc/mongodb"
configDirectory VsFTPd = "/etc/vsftpd"
instance Read Service where instance Read Service where
readsPrec _ service readsPrec _ service
| service == "nginx" = [(NGINX, [])] | service == "nginx" = [(NGINX, [])]
| service == "mysql" = [(MySQL, [])] | service == "mysql" = [(MySQL, [])]
| service == "mongodb" = [(MongoDB, [])]
| service == "vsftpd" = [(VsFTPd, [])]
| service == "letsencrypt" = [(LetsEncrypt, [])] | service == "letsencrypt" = [(LetsEncrypt, [])]

View File

@ -4,7 +4,8 @@ module System.Serverman.Utils ( keyvalue
, writeFileIfMissing , writeFileIfMissing
, commandError , commandError
, appendAfter , appendAfter
, execute) where , execute
, executeRoot) where
import System.IO import System.IO
import Control.Monad import Control.Monad
@ -14,6 +15,7 @@ module System.Serverman.Utils ( keyvalue
import Control.Concurrent.Async import Control.Concurrent.Async
import Data.List import Data.List
import Control.Exception import Control.Exception
import System.Exit
keyvalue :: [(String, String)] -> String keyvalue :: [(String, String)] -> String
keyvalue ((a, b):xs) = a ++ " " ++ b ++ ";\n" ++ keyvalue xs keyvalue ((a, b):xs) = a ++ " " ++ b ++ ";\n" ++ keyvalue xs
@ -50,9 +52,22 @@ module System.Serverman.Utils ( keyvalue
result <- tryIOError $ readProcessWithExitCode cmd args stdin result <- tryIOError $ readProcessWithExitCode cmd args stdin
case result of case result of
Right (_, stdout, _) -> return $ Right stdout Right (ExitSuccess, stdout, _) -> return $ Right stdout
Right (ExitFailure code, stdout, stderr) -> do
when logErrors $ do
putStrLn $ "exit code: " ++ show code
putStrLn stdout
putStrLn stderr
putStrLn $ commandError command
return $ Left stdout
Left err -> do Left err -> do
when logErrors $ putStrLn (commandError command) when logErrors $ do
putStrLn $ show err
putStrLn $ commandError command
return $ Left (show err) return $ Left (show err)
wait process wait process
executeRoot :: String -> [String] -> String -> Bool -> IO (Either String String)
executeRoot cmd args stdin logErrors = execute "sudo" (cmd:args) stdin logErrors

View File

@ -21,6 +21,12 @@ module System.Term ( initialize ) where
&= summary "serverman v0.1.0, (C) Mahdi Dibaiee 2017" &= summary "serverman v0.1.0, (C) Mahdi Dibaiee 2017"
&= helpArg [name "h"] &= helpArg [name "h"]
user <- getEnv "USER"
when (user == "ROOT") $ do
putStrLn $ "It's recommended that you don't run serverman as root."
putStrLn $ "Serverman will automatically use sudo whenever needed."
let fixArgs let fixArgs
| null args = ["--help"] | null args = ["--help"]
| otherwise = args | otherwise = args
@ -53,7 +59,12 @@ module System.Term ( initialize ) where
, email :: String , email :: String
} }
| DatabaseParams { databaseName :: String | DatabaseParams { databaseName :: String
, dService :: String } , dService :: String
, dummyData :: Bool
, dUser :: String
, dPass :: String
, dHost :: String
}
| InstallParams { iService :: String } | InstallParams { iService :: String }
@ -70,6 +81,10 @@ module System.Term ( initialize ) where
database = DatabaseParams { databaseName = "test" &= help "database name, defaults to test" &= explicit &= name "name" 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" , dService = "mysql" &= help "service to setup: mysql, defaults to mysql" &= explicit &= name "service"
, dummyData = False &= help "generate dummy data in the database" &= explicit &= name "dummy-data"
, dUser = "root" &= help "database's username, defaults to root" &= explicit &= name "user"
, dPass = "" &= help "database's password, defaults to blank string" &= explicit &= name "password"
, dHost = "127.0.0.1" &= help "database's host, defaults to localhost" &= explicit &= name "host"
} &= explicit &= name "database" } &= explicit &= name "database"
@ -101,16 +116,29 @@ module System.Term ( initialize ) where
, S.serverService = serviceName , S.serverService = serviceName
, S.email = email , S.email = email
} }
S.run $ S.detectOS >>= (S.install serviceName) >> S.newServer params S.run $ S.detectOS >>= (S.install serviceName)
>> S.detectOS >>= (S.start serviceName)
>> S.newServer params
manualInstall (InstallParams { iService }) = do manualInstall (InstallParams { iService }) = do
S.run $ S.detectOS >>= (S.install (read iService)) let serviceName = read iService :: Service
databaseSetup (DatabaseParams { databaseName, dService }) = do S.run $ S.detectOS >>= (S.install serviceName)
>> S.detectOS >>= (S.start serviceName)
databaseSetup (DatabaseParams { databaseName, dService, dummyData, dUser, dPass, dHost }) = do
let serviceName = read dService let serviceName = read dService
let params = S.DatabaseParams { S.database = databaseName let params = S.DatabaseParams { S.database = databaseName
, S.databaseService = serviceName } , S.databaseService = serviceName
, S.dummyData = dummyData
, S.databaseUser = dUser
, S.databasePass = dPass
, S.databaseHost = dHost
}
S.run $ S.detectOS >>= (S.install serviceName) >> S.newDatabase params S.run $ S.detectOS >>= (S.install serviceName)
>> S.detectOS >>= (S.start serviceName)
>> S.newDatabase params