diff --git a/serverman.cabal b/serverman.cabal index 67d1c0e..b210e54 100644 --- a/serverman.cabal +++ b/serverman.cabal @@ -23,8 +23,10 @@ library , System.Serverman.Actions.Nginx , System.Serverman.Actions.Database , System.Serverman.Actions.MySQL + , System.Serverman.Actions.MongoDB , System.Serverman.Actions.Install , System.Serverman.Actions.Env + , System.Serverman.Actions.Start , System.Serverman.Services build-depends: base >= 4.7 && < 5 , free >= 4.12.4 && < 5 @@ -35,6 +37,10 @@ library , directory , filepath , async + , mysql >= 0.1.4 && < 1 + , mongoDB >= 2.1.1.1 && < 3 + , text + , bytestring default-language: Haskell2010 executable serverman diff --git a/src/System/Serverman.hs b/src/System/Serverman.hs index a152fb7..0694255 100644 --- a/src/System/Serverman.hs +++ b/src/System/Serverman.hs @@ -11,14 +11,16 @@ module System.Serverman ( run import System.Serverman.Utils import System.Serverman.Services - import System.Serverman.Actions.Install import System.Serverman.Actions.Env + import System.Serverman.Actions.Install + import System.Serverman.Actions.Start import System.Serverman.Actions.WebServer import System.Serverman.Actions.Nginx import System.Serverman.Actions.Database import System.Serverman.Actions.MySQL + import System.Serverman.Actions.MongoDB import Control.Monad.Free @@ -28,8 +30,10 @@ module System.Serverman ( run | serverService params == NGINX = nginx params >> run next | otherwise = 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 (NewDatabase params next)) | databaseService params == MySQL = mysql params >> run next + | databaseService params == MongoDB = mongodb params >> run next | otherwise = run next diff --git a/src/System/Serverman/Action.hs b/src/System/Serverman/Action.hs index 0412ec7..1bcb2fa 100644 --- a/src/System/Serverman/Action.hs +++ b/src/System/Serverman/Action.hs @@ -4,10 +4,13 @@ module System.Serverman.Action ( ActionF(..) , Action , newServer , newDatabase + , newFileSharing + , start , install , detectOS) where import System.Serverman.Actions.WebServer + import System.Serverman.Actions.FileSharing import System.Serverman.Actions.Database import System.Serverman.Actions.Env import System.Serverman.Utils @@ -25,13 +28,17 @@ module System.Serverman.Action ( ActionF(..) data ActionF x = NewWebServer ServerParams x | NewDatabase DatabaseParams x + | NewFileSharing FileSharingParams x | DetectOS (OS -> x) | Install Service OS x + | Start 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 (NewSharedFolder params x) = NewSharedFolder params (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) type Action = Free ActionF @@ -42,8 +49,14 @@ module System.Serverman.Action ( ActionF(..) newDatabase :: DatabaseParams -> Action () newDatabase params = liftF $ NewDatabase params () + newFileSharing :: FileSharingParams -> Action () + newFileSharing params = liftF $ NewFileSharing params () + install :: Service -> OS -> Action () install service os = liftF $ Install service os () + start :: Service -> OS -> Action () + start service os = liftF $ Start service os () + detectOS :: Action OS detectOS = liftF $ DetectOS id diff --git a/src/System/Serverman/Actions/Database.hs b/src/System/Serverman/Actions/Database.hs index 7768cd8..3663f61 100644 --- a/src/System/Serverman/Actions/Database.hs +++ b/src/System/Serverman/Actions/Database.hs @@ -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.Services @@ -6,4 +6,49 @@ module System.Serverman.Actions.Database (DatabaseParams(..)) where data DatabaseParams = DatabaseParams { database :: String , databaseService :: Service + , dummyData :: Bool + , databaseUser :: String + , databasePass :: String + , databaseHost :: String } 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"]]) diff --git a/src/System/Serverman/Actions/Install.hs b/src/System/Serverman/Actions/Install.hs index f8fc382..71a3691 100644 --- a/src/System/Serverman/Actions/Install.hs +++ b/src/System/Serverman/Actions/Install.hs @@ -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.Utils import System.Serverman.Services @@ -19,12 +19,17 @@ module System.Serverman.Actions.Install (installService) where dependencies NGINX = [LetsEncrypt] dependencies _ = [] - package NGINX _ = "nginx" - package MySQL _ = "mysql" - package LetsEncrypt Arch = "certbot" package LetsEncrypt _ = "letsencrypt" + package NGINX _ = "nginx" + + package MySQL _ = "mysql" + + package MongoDB _ = "mongodb" + + package VsFTPd _ = "vsftpd" + installService :: Service -> OS -> IO () installService service os = do forM_ (dependencies service) (`installService` os) @@ -37,7 +42,7 @@ module System.Serverman.Actions.Install (installService) where pkg = package service os process <- async $ do - result <- execute (fst base) (snd base ++ [pkg]) "" True + result <- executeRoot (fst base) (snd base ++ [pkg]) "" True case result of Left err -> return () diff --git a/src/System/Serverman/Actions/MongoDB.hs b/src/System/Serverman/Actions/MongoDB.hs new file mode 100644 index 0000000..1440e3d --- /dev/null +++ b/src/System/Serverman/Actions/MongoDB.hs @@ -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 ++ "')" + diff --git a/src/System/Serverman/Actions/MySQL.hs b/src/System/Serverman/Actions/MySQL.hs index 5a04a53..1b27fab 100644 --- a/src/System/Serverman/Actions/MySQL.hs +++ b/src/System/Serverman/Actions/MySQL.hs @@ -1,8 +1,45 @@ {-# LANGUAGE NamedFieldPuns #-} + module System.Serverman.Actions.MySQL (mysql) where 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 { 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 () + + 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 ++ "')" + diff --git a/src/System/Serverman/Actions/Nginx.hs b/src/System/Serverman/Actions/Nginx.hs index d4af647..cb36ced 100644 --- a/src/System/Serverman/Actions/Nginx.hs +++ b/src/System/Serverman/Actions/Nginx.hs @@ -46,7 +46,7 @@ module System.Serverman.Actions.Nginx (nginx) where dhExists <- doesFileExist dhparamPath when (not dhExists) $ do - dhparam <- async $ execute "openssl" ["dhparam", "-out", dhparamPath, "2048"] "" True + dhparam <- async $ executeRoot "openssl" ["dhparam", "-out", dhparamPath, "2048"] "" True wait dhparam return () @@ -65,14 +65,14 @@ module System.Serverman.Actions.Nginx (nginx) where return () where restart = async $ do - result <- execute "systemctl" ["restart", "nginx"] "" True + result <- executeRoot "systemctl" ["restart", "nginx"] "" True case result of Left err -> return () Right _ -> putStrLn $ "restarted " ++ show serverService 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 Left _ -> if cmd == "letsencrypt" then createCert path "certbot" else return () Right stdout -> do diff --git a/src/System/Serverman/Actions/Start.hs b/src/System/Serverman/Actions/Start.hs new file mode 100644 index 0000000..6ec0675 --- /dev/null +++ b/src/System/Serverman/Actions/Start.hs @@ -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 () diff --git a/src/System/Serverman/Services.hs b/src/System/Serverman/Services.hs index 39903f5..f93ee56 100644 --- a/src/System/Serverman/Services.hs +++ b/src/System/Serverman/Services.hs @@ -3,6 +3,8 @@ module System.Serverman.Services ( Service(..) data Service = NGINX | MySQL + | MongoDB + | VsFTPd | LetsEncrypt deriving (Eq, Show) @@ -11,10 +13,14 @@ module System.Serverman.Services ( Service(..) instance Configurable Service where configDirectory NGINX = "/etc/nginx/" - configDirectory mysql = "/etc/mysql/" + configDirectory MySQL = "/etc/mysql/" + configDirectory MongoDB = "/etc/mongodb" + configDirectory VsFTPd = "/etc/vsftpd" instance Read Service where readsPrec _ service | service == "nginx" = [(NGINX, [])] | service == "mysql" = [(MySQL, [])] + | service == "mongodb" = [(MongoDB, [])] + | service == "vsftpd" = [(VsFTPd, [])] | service == "letsencrypt" = [(LetsEncrypt, [])] diff --git a/src/System/Serverman/Utils.hs b/src/System/Serverman/Utils.hs index 0fe3110..528b84e 100644 --- a/src/System/Serverman/Utils.hs +++ b/src/System/Serverman/Utils.hs @@ -4,7 +4,8 @@ module System.Serverman.Utils ( keyvalue , writeFileIfMissing , commandError , appendAfter - , execute) where + , execute + , executeRoot) where import System.IO import Control.Monad @@ -14,6 +15,7 @@ module System.Serverman.Utils ( keyvalue import Control.Concurrent.Async import Data.List import Control.Exception + import System.Exit keyvalue :: [(String, String)] -> String keyvalue ((a, b):xs) = a ++ " " ++ b ++ ";\n" ++ keyvalue xs @@ -50,9 +52,22 @@ module System.Serverman.Utils ( keyvalue result <- tryIOError $ readProcessWithExitCode cmd args stdin 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 - when logErrors $ putStrLn (commandError command) + when logErrors $ do + putStrLn $ show err + putStrLn $ commandError command return $ Left (show err) wait process + + executeRoot :: String -> [String] -> String -> Bool -> IO (Either String String) + executeRoot cmd args stdin logErrors = execute "sudo" (cmd:args) stdin logErrors diff --git a/src/System/Term.hs b/src/System/Term.hs index 12ed181..fbb7694 100644 --- a/src/System/Term.hs +++ b/src/System/Term.hs @@ -21,6 +21,12 @@ module System.Term ( initialize ) where &= summary "serverman v0.1.0, (C) Mahdi Dibaiee 2017" &= 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 | null args = ["--help"] | otherwise = args @@ -53,7 +59,12 @@ module System.Term ( initialize ) where , email :: String } | DatabaseParams { databaseName :: String - , dService :: String } + , dService :: String + , dummyData :: Bool + , dUser :: String + , dPass :: String + , dHost :: 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" , 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" @@ -101,16 +116,29 @@ module System.Term ( initialize ) where , S.serverService = serviceName , 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 - 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 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