initial commit

src/System/Serverman.hs

@@ -0,0 +1,29 @@
+module System.Serverman ( run
+                        , module System.Serverman.Action
+                        , module System.Serverman.Utils
+                        , module System.Serverman.Services
+                        , module System.Serverman.Actions.WebServer
+                        , module System.Serverman.Actions.Env
+                        , module System.Serverman.Actions.Install) where
+
+  import System.Serverman.Action
+  import System.Serverman.Utils
+  import System.Serverman.Services
+  import System.Serverman.Actions.WebServer
+  import System.Serverman.Actions.Install
+  import System.Serverman.Actions.Env
+
+  import System.Serverman.Actions.Nginx
+  import System.Serverman.Actions.WebServer
+
+  import Control.Monad.Free
+
+  run :: Action r -> IO r
+  run (Pure r) = return r
+  run (Free (NewWebServer params next))
+    | service params == NGINX = nginx params >> run next
+    -- | service == Apache = apache n >> run next
+    | otherwise = run next
+  run (Free (DetectOS next)) = getOS >>= run . next
+  run (Free (Install os service next)) = installService os service >> run next
+

src/System/Serverman/Action.hs

@@ -0,0 +1,42 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module System.Serverman.Action ( ActionF(..)
+                               , Action
+                               , newServer
+                               , install
+                               , detectOS) where
+
+  import System.Serverman.Actions.WebServer
+  import System.Serverman.Actions.Env
+  import System.Serverman.Utils
+  import System.Serverman.Services
+
+  import System.Directory
+  import System.FilePath
+  import System.IO
+  import System.Process
+  import Control.Concurrent.Async
+  import Control.Monad
+  import Control.Monad.Free
+  import System.IO.Error
+  import Data.Char
+
+  data ActionF x = NewWebServer ServerParams x
+                 | DetectOS (OS -> x)
+                 | Install Service OS x
+
+  instance Functor ActionF where
+    fmap f (NewWebServer params x) = NewWebServer params (f x)
+    fmap f (Install service os x) = Install service os (f x)
+    fmap f (DetectOS x) = DetectOS (f . x)
+
+  type Action = Free ActionF
+
+  newServer :: ServerParams -> Action ()
+  newServer params = liftF $ NewWebServer params ()
+
+  install :: Service -> OS -> Action ()
+  install service os = liftF $ Install service os ()
+
+  detectOS :: Action OS
+  detectOS = liftF $ DetectOS id

src/System/Serverman/Actions/Env.hs

@@ -0,0 +1,20 @@
+module System.Serverman.Actions.Env (OS(..), getOS) where
+  import System.Process
+  import Data.List
+  import System.IO.Error
+  import Data.Either
+
+  data OS = Debian | Arch | 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" ["-productVersion"] ""
+
+    let (_, release, _) = head $ rights [arch_release, deb_release, mac_release] 
+        distro
+            | or $ map (`isInfixOf` release) ["ubuntu", "debian", "raspbian"] = Debian
+            | "arch" `isInfixOf` release = Arch
+            | otherwise = Unknown
+
+    return distro

src/System/Serverman/Actions/Install.hs

@@ -0,0 +1,38 @@
+module System.Serverman.Actions.Install (installService) where
+  import System.Serverman.Action
+  import System.Serverman.Utils
+  import System.Serverman.Services
+  import System.Serverman.Actions.Env
+
+
+  import System.IO.Error
+  import System.Process
+  import Control.Concurrent.Async
+  import Control.Monad.Free
+
+  class Installable a where
+    dependencies :: a -> [String]
+    package :: a -> String
+
+  instance Installable Service where
+    dependencies _ = []
+
+    package NGINX = "nginx"
+    package Apache = "apache2"
+
+  installService :: Service -> OS -> IO ()
+  installService service os = do
+    let command = case os of
+          Arch -> "pacman -S "
+          Debian -> "apt-get install "
+          _ -> "echo 'Unknown operating system'"
+
+    process <- async $ do
+      result <- tryIOError $ callCommand (command ++ package service)
+
+      case result of
+        Left err ->
+          putStrLn $ commandError command
+        Right _ ->
+          putStrLn $ "installed " ++ show service ++ "."
+    wait process

src/System/Serverman/Actions/Nginx.hs

@@ -0,0 +1,68 @@
+module System.Serverman.Actions.Nginx (nginx) where
+  import System.Serverman.Action
+  import System.Serverman.Actions.WebServer
+  import System.Serverman.Utils
+
+  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
+
+  nginx :: ServerParams -> IO ()
+  nginx params = 
+    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
+
+      createDirectoryIfMissing True targetDir
+      createDirectoryIfMissing True parent
+
+      when (ssl params) $ do
+        let sslPath = output params </> "ssl.conf"
+        writeFileIfMissing sslPath nginxSSL
+        putStrLn $ "wrote ssl configuration to " ++ sslPath
+
+      writeFile path content
+
+      putStrLn $ "wrote your configuration file to " ++ path
+
+      restart <- async $ do
+        let command = "systemctl restart nginx"
+        result <- tryIOError $ callCommand command
+        case result of
+          Left err -> do
+            putStrLn $ commandError command
+          Right _ ->
+            putStrLn $ "restarted " ++ show (service params)
+
+      wait restart
+      
+      when (ssl params) $ do
+        case serverType params of
+          Static -> do
+            let command = "certbot certonly --webroot --webroot-path " ++ directory params ++ " -d " ++ domain params
+            letsencrypt <- async $ do
+              result <- tryIOError $ callCommand command
+              case result of
+                Left err -> do
+                  putStrLn $ commandError command
+                Right _ -> do
+                  putStrLn $ "created a certificate for " ++ domain params
+                  writeFile path (show params)
+                  
+            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 $ "my suggestion is running this command:"
+            putStrLn $ "sudo certbot certonly --webroot --webroot-path <YOUR_APPLICATION_DIRECTORY> -d " ++ domain params
+
+        putStrLn $ "for more information, see: https://certbot.eff.org/"
+      return ()

src/System/Serverman/Actions/WebServer.hs

@@ -0,0 +1,44 @@
+module System.Serverman.Actions.WebServer (ServerParams(..), ServerType(..)) where
+  import System.Serverman.Utils
+  import System.Serverman.Services
+
+  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
+                                   } deriving (Eq)
+  instance Show ServerParams where
+    show conf 
+      | service 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")
+                             , ("include", "ssl.conf")]
+                | otherwise = []
+
+              base = [ ("server_name", domain conf)
+                     , ("listen", port conf)
+                     , ("index", "index.html index.html index.php")
+                     ] ++ https
+          in 
+            case serverType conf of
+              Static -> 
+                nginxBlock "server" $ keyvalue (base ++ [("root", directory conf)])
+
+              PortForwarding -> 
+                let proxyBlock = nginxBlock "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 nginxBlock "server" $ keyvalue base ++ proxyBlock
+
+      | otherwise = "Unknown service provider"

src/System/Serverman/Services.hs

@@ -0,0 +1,9 @@
+module System.Serverman.Services ( Service(..)
+                                 , ) where
+
+  data Service = NGINX | Apache deriving (Eq, Show)
+
+  instance Read Service where
+    readsPrec _ service
+          | service == "nginx" || service == "n" = [(NGINX, [])]
+          | service == "apache" || service == "a" = [(Apache, [])]

src/System/Serverman/Utils.hs

@@ -0,0 +1,39 @@
+module System.Serverman.Utils ( keyvalue
+                              , nginxBlock
+                              , nginxSSL
+                              , writeFileIfMissing
+                              , commandError) where
+
+  import System.IO
+  import Control.Monad
+  import System.Directory
+
+  keyvalue :: [(String, String)] -> String
+  keyvalue ((a, b):xs) = a ++ " " ++ b ++ ";\n" ++ keyvalue xs
+  keyvalue [] = ""
+
+  nginxBlock :: String -> String -> String
+  nginxBlock blockName content = blockName ++ " {\n" ++ indent content ++ "}"
+
+  writeFileIfMissing :: FilePath -> String -> IO ()
+  writeFileIfMissing path content = do
+    exists <- doesFileExist path
+    
+    when (not exists) $ do
+      writeFile path content
+
+  indent :: String -> String
+  indent s = unlines $ map ("\t" ++) (lines s)
+
+  commandError :: String -> String
+  commandError command = "[Error] an error occured while running: " ++ command ++ "\nplease try running the command manually."
+
+  nginxSSL = "ssl_protocols TLSv1 TLSv1.1 TLSv1.2;\n\
+\ssl_prefer_server_ciphers on;\n\
+\ssl_dhparam /etc/ssl/certs/dhparam.pem;\n\
+\ssl_ciphers 'ECDHE-RSA-AES128-GCM-SHA256:ECDHE-ECDSA-AES128-GCM-SHA256:ECDHE-RSA-AES256-GCM-SHA384:ECDHE-ECDSA-AES256-GCM-SHA384:DHE-RSA-AES128-GCM-SHA256:DHE-DSS-AES128-GCM-SHA256:kEDH+AESGCM:ECDHE-RSA-AES128-SHA256:ECDHE-ECDSA-AES128-SHA256:ECDHE-RSA-AES128-SHA:ECDHE-ECDSA-AES128-SHA:ECDHE-RSA-AES256-SHA384:ECDHE-ECDSA-AES256-SHA384:ECDHE-RSA-AES256-SHA:ECDHE-ECDSA-AES256-SHA:DHE-RSA-AES128-SHA256:DHE-RSA-AES128-SHA:DHE-DSS-AES128-SHA256:DHE-RSA-AES256-SHA256:DHE-DSS-AES256-SHA:DHE-RSA-AES256-SHA:AES128-GCM-SHA256:AES256-GCM-SHA384:AES128-SHA256:AES256-SHA256:AES128-SHA:AES256-SHA:AES:CAMELLIA:DES-CBC3-SHA:!aNULL:!eNULL:!EXPORT:!DES:!RC4:!MD5:!PSK:!aECDH:!EDH-DSS-DES-CBC3-SHA:!EDH-RSA-DES-CBC3-SHA:!KRB5-DES-CBC3-SHA';\n\
+\ssl_session_timeout 1d;\n\
+\ssl_session_cache shared:SSL:50m;\n\
+\ssl_stapling on;\n\
+\ssl_stapling_verify on;\n\
+\add_header Strict-Transport-Security max-age=15768000;"

src/System/Term.hs

@@ -0,0 +1,86 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module System.Term ( initialize ) where
+  import System.Serverman.Services
+  import qualified System.Serverman as S
+
+  import System.Console.CmdArgs
+  import qualified System.Console.CmdArgs.Explicit as E
+  import System.Environment
+  import Data.Monoid
+  import Data.Maybe
+
+  initialize = do
+    let mode = cmdArgsMode $ modes [webserver, install] &= program "serverman" &= summary "serverman v0.1.0, (C) Mahdi Dibaiee 2017"
+
+    (CmdArgs args help version _ _) <- E.processArgs mode
+
+    if isJust help then
+      putStrLn $ fromJust help
+    else if isJust version then
+      putStrLn $ fromJust version
+    else
+      case args of
+        p@(WebServerParams _ _ _ _ _ _ _) -> webServer p
+        p@(InstallParams _) -> manualInstall p
+
+    return ()
+
+  -- WEB SERVER 
+  data Params = WebServerParams { directory :: String
+                                , domain    :: String
+                                , port      :: String
+                                , ssl       :: Bool
+                                , forward   :: String
+                                , wService   :: String
+                                , output    :: String
+                                }
+
+              | InstallParams { iService :: String }
+
+              deriving (Show, Data, Typeable)
+
+  webserver = WebServerParams { directory = "/var/www/html/" &= typDir &= help "directory to serve static files from, defaults to /var/www/html/" 
+                              , domain = "test.dev" &= typ "DOMAIN" &= help "domain/server name, defaults to test.dev" 
+                              , port = def &= typ "PORT" &= help "port number to listen to, defaults to 80 for http and 443 for https" 
+                              , forward = def &= typ "PORT" &= help "the port to forward to (in case of a port-forwarding server)" 
+                              , ssl = False &= help "create a letsencrypt certificate for this domain, defaults to false" 
+                              , wService = "nginx" &= help "service to build config for: (n)ginx, (a)pache, defaults to nginx" &= explicit &= name "service"
+                              , output = def &= help "output directory for the selected service, defaults to /etc/nginx for nginx and /etc/apache2 for apache"
+                              } &= explicit &= name "webserver"
+
+  install = InstallParams { iService = def &= argPos 0
+                          } &= explicit &= name "install"
+
+  webServer (WebServerParams { directory, domain, port, ssl, forward, wService, output }) = do
+    let serverType 
+          | (not . null) forward = S.PortForwarding
+          | otherwise = S.Static
+
+    let serviceName = read wService :: Service
+
+    let portNumber
+          | (not . null) port = port
+          | ssl = "403"
+          | otherwise = "80"
+
+    let outDir
+          | (not . null) output = output
+          | serviceName == S.NGINX = "/etc/nginx/"
+          | serviceName == S.Apache = "/etc/apache2/"
+
+    let params = S.ServerParams { S.directory  = directory
+                                , S.domain     = domain
+                                , S.port       = portNumber
+                                , S.ssl        = ssl
+                                , S.forward    = forward
+                                , S.serverType = serverType
+                                , S.service    = serviceName
+                                , S.output     = outDir
+                                }
+    S.run $ S.newServer params
+
+  manualInstall (InstallParams { iService }) = do
+    S.run $ S.detectOS >>= (S.install (read iService))
+