From 48c1208dc74d1fd1f9aca1a5332a0dbfeda682d3 Mon Sep 17 00:00:00 2001 From: Mahdi Dibaiee Date: Sat, 4 Mar 2017 13:47:24 +0330 Subject: [PATCH] feat(vsftpd): file sharing via vsftpd --- serverman.cabal | 6 ++ src/System/Serverman.hs | 17 +++++- src/System/Serverman/Action.hs | 2 +- src/System/Serverman/Actions/FileSharing.hs | 37 ++++++++++++ src/System/Serverman/Actions/Nginx.hs | 8 +-- src/System/Serverman/Actions/VsFTPd.hs | 43 +++++++++++++ src/System/Serverman/Actions/WebServer.hs | 42 +++++++------ src/System/Serverman/Services.hs | 2 +- src/System/Serverman/Utils.hs | 22 ++++++- src/System/Term.hs | 67 +++++++++++++++++---- 10 files changed, 202 insertions(+), 44 deletions(-) create mode 100644 src/System/Serverman/Actions/FileSharing.hs create mode 100644 src/System/Serverman/Actions/VsFTPd.hs diff --git a/serverman.cabal b/serverman.cabal index b210e54..0a64c88 100644 --- a/serverman.cabal +++ b/serverman.cabal @@ -19,11 +19,17 @@ library , System.Serverman , System.Serverman.Utils , System.Serverman.Action + , System.Serverman.Actions.WebServer , System.Serverman.Actions.Nginx + , System.Serverman.Actions.Database , System.Serverman.Actions.MySQL , System.Serverman.Actions.MongoDB + + , System.Serverman.Actions.FileSharing + , System.Serverman.Actions.VsFTPd + , System.Serverman.Actions.Install , System.Serverman.Actions.Env , System.Serverman.Actions.Start diff --git a/src/System/Serverman.hs b/src/System/Serverman.hs index 0694255..feb4199 100644 --- a/src/System/Serverman.hs +++ b/src/System/Serverman.hs @@ -4,6 +4,7 @@ module System.Serverman ( run , module System.Serverman.Services , module System.Serverman.Actions.WebServer , module System.Serverman.Actions.Database + , module System.Serverman.Actions.FileSharing , module System.Serverman.Actions.Env , module System.Serverman.Actions.Install) where @@ -22,18 +23,28 @@ module System.Serverman ( run import System.Serverman.Actions.MySQL import System.Serverman.Actions.MongoDB + import System.Serverman.Actions.FileSharing + import System.Serverman.Actions.VsFTPd + import Control.Monad.Free run :: Action r -> IO r run (Pure r) = return r - run (Free (NewWebServer params next)) - | 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 (NewWebServer params next)) + | serverService params == NGINX = nginx params >> run next + | otherwise = run next + run (Free (NewDatabase params next)) | databaseService params == MySQL = mysql params >> run next | databaseService params == MongoDB = mongodb params >> run next | otherwise = run next + run (Free (NewFileSharing params next)) + | fService params == VsFTPd = vsftpd params >> run next + | otherwise = run next + + diff --git a/src/System/Serverman/Action.hs b/src/System/Serverman/Action.hs index 1bcb2fa..a5f16a3 100644 --- a/src/System/Serverman/Action.hs +++ b/src/System/Serverman/Action.hs @@ -36,7 +36,7 @@ module System.Serverman.Action ( ActionF(..) 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 (NewFileSharing params x) = NewFileSharing 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) diff --git a/src/System/Serverman/Actions/FileSharing.hs b/src/System/Serverman/Actions/FileSharing.hs new file mode 100644 index 0000000..315f8e5 --- /dev/null +++ b/src/System/Serverman/Actions/FileSharing.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE NamedFieldPuns #-} + +module System.Serverman.Actions.FileSharing (FileSharingParams(..)) where + import System.Serverman.Services + import System.Serverman.Utils + + data FileSharingParams = FileSharingParams { fDirectory :: FilePath + , fUser :: String + , fPass :: String + , fPort :: String + , fWritable :: Bool + , fAnonymous :: Bool + , fAnonymousWrite :: Bool + , fRecreateUser :: Bool + , fService :: Service + } deriving (Eq) + + instance Show FileSharingParams where + show (FileSharingParams { fDirectory, fUser, fPass, fPort, fWritable, fAnonymous, fAnonymousWrite, fService }) + | fService == VsFTPd = + let boolToEnglish True = "YES" + boolToEnglish False = "NO" + in + keyvalue [ ("anonymous_enable", boolToEnglish fAnonymous) + , ("write_enable", boolToEnglish fWritable) + , ("allow_writeable_chroot", boolToEnglish fWritable) + , ("anon_upload_enable", boolToEnglish fAnonymousWrite) + , ("anon_mkdir_write_enable", boolToEnglish fAnonymousWrite) + , ("listen", "YES") + , ("userlist_enable", "YES") + , ("userlist_file", "/etc/vsftpd-serverman-user-list") + , ("userlist_deny", "NO") + , ("chroot_local_user", "YES") + , ("xferlog_enable", "YES") + , ("local_enable", "YES")] "=" + + | otherwise = "Unknown service provider" diff --git a/src/System/Serverman/Actions/Nginx.hs b/src/System/Serverman/Actions/Nginx.hs index cb36ced..4ac8f09 100644 --- a/src/System/Serverman/Actions/Nginx.hs +++ b/src/System/Serverman/Actions/Nginx.hs @@ -16,14 +16,14 @@ module System.Serverman.Actions.Nginx (nginx) where import Data.List nginx :: ServerParams -> IO () - nginx params@(ServerParams { ssl, serverService, domain, directory, serverType, email }) = + nginx params@(ServerParams { ssl, serverService, domain, wDirectory, serverType, email }) = do -- Turn SSL off at first, because we have not yet received a certificate let content = show (params { ssl = False, port = "80" }) mainConfig = configDirectory serverService "nginx.conf" parent = configDirectory serverService "serverman-configs" path = parent domain - targetDir = directory + targetDir = wDirectory createDirectoryIfMissing True targetDir createDirectoryIfMissing True parent @@ -65,14 +65,14 @@ module System.Serverman.Actions.Nginx (nginx) where return () where restart = async $ do - result <- executeRoot "systemctl" ["restart", "nginx"] "" True + result <- restartService "nginx" case result of Left err -> return () Right _ -> putStrLn $ "restarted " ++ show serverService createCert path cmd = do - result <- executeRoot cmd ["certonly", "--webroot", "--webroot-path", directory, "-d", domain, "--email", email, "--agree-tos", "-n"] "" False + result <- executeRoot cmd ["certonly", "--webroot", "--webroot-path", wDirectory, "-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/VsFTPd.hs b/src/System/Serverman/Actions/VsFTPd.hs new file mode 100644 index 0000000..cd6d784 --- /dev/null +++ b/src/System/Serverman/Actions/VsFTPd.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE NamedFieldPuns #-} + +module System.Serverman.Actions.VsFTPd (vsftpd) where + import System.Serverman.Utils + import System.Serverman.Services + import System.Serverman.Actions.FileSharing + + import System.Directory + import System.IO + import System.IO.Error + import System.FilePath + import System.Process + import Control.Concurrent.Async + import Control.Monad + import Control.Monad.Free + import Data.List + import Data.Either + + vsftpd :: FileSharingParams -> IO () + vsftpd params@(FileSharingParams { fDirectory, fPort, fUser, fPass, fAnonymous, fAnonymousWrite, fWritable, fService, fRecreateUser }) = + do + let content = show params + original = configDirectory fService + userList = takeDirectory original "vsftpd-serverman-user-list" + + when fRecreateUser $ executeRoot "userdel" [fUser] "" True >> return () + + (Right opensslResponse) <- execute "openssl" ["passwd", "-1", fPass] "" True + let encryptedPassword = head . lines $ opensslResponse + + executeRoot "useradd" [fUser, "-d", fDirectory, "-G", "ftp", "-p", encryptedPassword] "" True + + renameFileIfMissing original (original ++ ".backup") + + writeFile original content + + writeFile userList fUser + + result <- restartService "vsftpd" + case result of + Left err -> return () + Right _ -> + putStrLn $ "restarted " ++ show fService diff --git a/src/System/Serverman/Actions/WebServer.hs b/src/System/Serverman/Actions/WebServer.hs index 4a2d446..66a27c3 100644 --- a/src/System/Serverman/Actions/WebServer.hs +++ b/src/System/Serverman/Actions/WebServer.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE NamedFieldPuns #-} + module System.Serverman.Actions.WebServer (ServerParams(..), ServerType(..)) where import System.Serverman.Utils import System.Serverman.Services @@ -5,7 +7,7 @@ module System.Serverman.Actions.WebServer (ServerParams(..), ServerType(..)) whe import Control.Monad.Free data ServerType = Static | PortForwarding deriving (Show, Eq) - data ServerParams = ServerParams { directory :: String + data ServerParams = ServerParams { wDirectory :: FilePath , domain :: String , port :: String , forward :: String @@ -15,41 +17,43 @@ module System.Serverman.Actions.WebServer (ServerParams(..), ServerType(..)) whe , serverService :: Service } deriving (Eq) instance Show ServerParams where - show conf - | serverService conf == NGINX = + show (ServerParams { wDirectory, domain, port, forward, email, ssl, serverType, serverService }) + | serverService == NGINX = let redirect - | ssl conf = block "server" $ + | ssl = block "server" $ + semicolon $ keyvalue ([ ("listen", "80") , ("listen", "[::]:80") - , ("server_name", domain conf) + , ("server_name", domain) , ("rewrite", "^ https://$server_name$request_uri? permanent") - ]) + ]) " " | otherwise = "" https - | ssl conf = [ ("ssl_certificate", "/etc/letsencrypt/live/" ++ domain conf ++ "/fullchain.pem") - , ("ssl_certificate_key", "/etc/letsencrypt/live/" ++ domain conf ++ "/privkey.pem") - , ("include", "ssl.conf")] + | ssl = [ ("ssl_certificate", "/etc/letsencrypt/live/" ++ domain ++ "/fullchain.pem") + , ("ssl_certificate_key", "/etc/letsencrypt/live/" ++ domain ++ "/privkey.pem") + , ("include", "ssl.conf")] | otherwise = [] - listen = port conf ++ (if ssl conf then " ssl" else "") + listen = port ++ (if ssl then " ssl" else "") - base = [ ("server_name", domain conf) + base = [ ("server_name", domain) , ("listen", listen) , ("listen", "[::]:" ++ listen) , ("index", "index.html index.html index.php") ] ++ https in - case serverType conf of + case serverType of Static -> - (block "server" $ keyvalue (base ++ [("root", directory conf)])) ++ "\n" ++ redirect + (block "server" $ keyvalue (base ++ [("root", wDirectory)]) " ") ++ "\n" ++ redirect PortForwarding -> let proxyBlock = block "location /" $ - keyvalue ([ ("proxy_pass", "http://127.0.0.1:" ++ forward conf) - , ("proxy_set_header", "X-Forwarded-Host $host") - , ("proxy_set_header", "X-Forwarded-Server $host") - , ("proxy_set_header", "X-Forwarded-For $proxy_add_x_forwarded_for") - ]) - in (block "server" $ keyvalue base ++ proxyBlock) ++ "\n" ++ redirect + semicolon $ + keyvalue ([ ("proxy_pass", "http://127.0.0.1:" ++ forward) + , ("proxy_set_header", "X-Forwarded-Host $host") + , ("proxy_set_header", "X-Forwarded-Server $host") + , ("proxy_set_header", "X-Forwarded-For $proxy_add_x_forwarded_for") + ]) " " + in (block "server" $ semicolon (keyvalue base " ") ++ proxyBlock) ++ "\n" ++ redirect | otherwise = "Unknown service provider" diff --git a/src/System/Serverman/Services.hs b/src/System/Serverman/Services.hs index f93ee56..c054828 100644 --- a/src/System/Serverman/Services.hs +++ b/src/System/Serverman/Services.hs @@ -15,7 +15,7 @@ module System.Serverman.Services ( Service(..) configDirectory NGINX = "/etc/nginx/" configDirectory MySQL = "/etc/mysql/" configDirectory MongoDB = "/etc/mongodb" - configDirectory VsFTPd = "/etc/vsftpd" + configDirectory VsFTPd = "/etc/vsftpd.conf" instance Read Service where readsPrec _ service diff --git a/src/System/Serverman/Utils.hs b/src/System/Serverman/Utils.hs index 528b84e..07336ae 100644 --- a/src/System/Serverman/Utils.hs +++ b/src/System/Serverman/Utils.hs @@ -1,10 +1,13 @@ module System.Serverman.Utils ( keyvalue + , semicolon , block , indent , writeFileIfMissing + , renameFileIfMissing , commandError , appendAfter , execute + , restartService , executeRoot) where import System.IO @@ -17,9 +20,12 @@ module System.Serverman.Utils ( keyvalue import Control.Exception import System.Exit - keyvalue :: [(String, String)] -> String - keyvalue ((a, b):xs) = a ++ " " ++ b ++ ";\n" ++ keyvalue xs - keyvalue [] = "" + keyvalue :: [(String, String)] -> String -> String + keyvalue ((a, b):xs) delimit = a ++ delimit ++ b ++ "\n" ++ keyvalue xs delimit + keyvalue [] _ = "" + + semicolon :: String -> String + semicolon text = unlines $ map (++ ";") (lines text) block :: String -> String -> String block blockName content = blockName ++ " {\n" ++ indent content ++ "}" @@ -31,6 +37,13 @@ module System.Serverman.Utils ( keyvalue when (not exists) $ do writeFile path content + renameFileIfMissing :: FilePath -> String -> IO () + renameFileIfMissing path content = do + exists <- doesFileExist path + + when (not exists) $ do + renameFile path content + appendAfter :: String -> String -> String -> String appendAfter content after line = let ls = lines content @@ -69,5 +82,8 @@ module System.Serverman.Utils ( keyvalue wait process + restartService :: String -> IO (Either String String) + restartService service = executeRoot "systemctl" ["restart", service] "" True + 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 fbb7694..3ff7cd8 100644 --- a/src/System/Term.hs +++ b/src/System/Term.hs @@ -16,16 +16,16 @@ module System.Term ( initialize ) where initialize = do args <- getArgs - let mode = cmdArgsMode $ modes [install, webserver, database] + let mode = cmdArgsMode $ modes [install, webserver, database, filesharing] &= program "serverman" &= 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." + {-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"] @@ -41,9 +41,10 @@ module System.Term ( initialize ) where putStrLn $ fromJust version else case args of - p@(WebServerParams {}) -> webserverSetup p - p@(InstallParams {}) -> manualInstall p - p@(DatabaseParams {}) -> databaseSetup p + p@(WebServerParams {}) -> webserverSetup p + p@(InstallParams {}) -> manualInstall p + p@(DatabaseParams {}) -> databaseSetup p + p@(FileSharingParams {}) -> fileSharingSetup p Left err -> print err @@ -66,6 +67,17 @@ module System.Term ( initialize ) where , dHost :: String } + | FileSharingParams { fDirectory :: String + , fUser :: String + , fPass :: String + , fPort :: String + , fWritable :: Bool + , fAnonymous :: Bool + , fAnonymousWrite :: Bool + , fRecreateUser :: Bool + , fService :: String + } + | InstallParams { iService :: String } deriving (Show, Data, Typeable) @@ -87,6 +99,17 @@ module System.Term ( initialize ) where , dHost = "127.0.0.1" &= help "database's host, defaults to localhost" &= explicit &= name "host" } &= explicit &= name "database" + filesharing = FileSharingParams { fDirectory = "/srv/ftp/" &= typDir &= help "directory to share, defaults to /srv/ftp/" &= explicit &= name "directory" + , fUser = "serverman" &= typDir &= help "username, defaults to serverman" &= explicit &= name "user" + , fPass = "" &= help "password, defaults to serverman (please change this to avoid security risks)" &= explicit &= name "password" + , fAnonymous = False &= help "allow anonymous connections, defaults to False" &= explicit &= name "anonymous" + , fAnonymousWrite = False &= help "allow anonymous write operations, defaults to False" &= explicit &= name "anonymous-write" + , fWritable = True &= help "allow write operations, defaults to True" &= explicit &= name "writable" + , fPort = "21" &= help "service port, defaults to 21" &= explicit &= name "port" + , fService = "vsftpd" &= help "service to use for file sharing, defaults to vsftpd" &= explicit &= name "service" + , fRecreateUser = False &= help "recreate the user" &= explicit &= name "recreate-user" + } &= explicit &= name "filesharing" + install = InstallParams { iService = def &= argPos 0 } &= explicit &= name "install" @@ -107,7 +130,7 @@ module System.Term ( initialize ) where absoluteDirectory <- makeAbsolute directory - let params = S.ServerParams { S.directory = absoluteDirectory + let params = S.ServerParams { S.wDirectory = absoluteDirectory , S.domain = domain , S.port = portNumber , S.ssl = ssl @@ -130,15 +153,33 @@ module System.Term ( initialize ) where databaseSetup (DatabaseParams { databaseName, dService, dummyData, dUser, dPass, dHost }) = do let serviceName = read dService - let params = S.DatabaseParams { S.database = databaseName + let params = S.DatabaseParams { S.database = databaseName , S.databaseService = serviceName - , S.dummyData = dummyData - , S.databaseUser = dUser - , S.databasePass = dPass - , S.databaseHost = dHost + , S.dummyData = dummyData + , S.databaseUser = dUser + , S.databasePass = dPass + , S.databaseHost = dHost } S.run $ S.detectOS >>= (S.install serviceName) >> S.detectOS >>= (S.start serviceName) >> S.newDatabase params + fileSharingSetup (FileSharingParams { fDirectory, fUser, fPass, fPort, fAnonymous, fAnonymousWrite, fWritable, fService, fRecreateUser }) = do + let serviceName = read fService + + let params = S.FileSharingParams { S.fDirectory = fDirectory + , S.fUser = fUser + , S.fPass = fPass + , S.fPort = fPort + , S.fAnonymous = fAnonymous + , S.fAnonymousWrite = fAnonymousWrite + , S.fWritable = fWritable + , S.fService = serviceName + , S.fRecreateUser = fRecreateUser + } + + S.run $ S.detectOS >>= (S.install serviceName) + >> S.detectOS >>= (S.start serviceName) + >> S.newFileSharing params +