thereadme/serverman
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

feat(vsftpd): file sharing via vsftpd

Browse Source
This commit is contained in:
Mahdi Dibaiee
2017-03-04 13:47:24 +03:30
parent 3595464b11
commit 48c1208dc7
10 changed files with 202 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files

37
src/System/Serverman/Actions/FileSharing.hs Normal file
View File

@ -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"

8
src/System/Serverman/Actions/Nginx.hs
View File

@ -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

43
src/System/Serverman/Actions/VsFTPd.hs Normal file
View File

@ -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

42
src/System/Serverman/Actions/WebServer.hs
View File

@ -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"