feat: moved services from source to here, still untested: vsftpd,
mongodb, mysql, nginx
This commit is contained in:
Mahdi Dibaiee
parent
a5cc8582fc
commit
5550b17522
23
.gitignore
vendored
Normal file
23
.gitignore
vendored
Normal file
@ -0,0 +1,23 @@
|
|||||||
|
#### joe made this: http://goel.io/joe
|
||||||
|
#### haskell ####
|
||||||
|
dist
|
||||||
|
dist-*
|
||||||
|
cabal-dev
|
||||||
|
*.o
|
||||||
|
*.hi
|
||||||
|
*.chi
|
||||||
|
*.chs.h
|
||||||
|
*.dyn_o
|
||||||
|
*.dyn_hi
|
||||||
|
.hpc
|
||||||
|
.hsenv
|
||||||
|
.cabal-sandbox/
|
||||||
|
cabal.sandbox.config
|
||||||
|
*.prof
|
||||||
|
*.aux
|
||||||
|
*.hp
|
||||||
|
*.eventlog
|
||||||
|
.stack-work/
|
||||||
|
cabal.project.local
|
||||||
|
.HTF/
|
||||||
|
|
||||||
@ -2,11 +2,8 @@
|
|||||||
{
|
{
|
||||||
"name": "nginx",
|
"name": "nginx",
|
||||||
"service": "nginx",
|
"service": "nginx",
|
||||||
"config": "/etc/nginx/",
|
|
||||||
"version": "0.1.0",
|
"version": "0.1.0",
|
||||||
"dependencies": {
|
"dependencies": ["letsencrypt"],
|
||||||
"letsencrypt": "^0.1.0"
|
|
||||||
},
|
|
||||||
"packages": {
|
"packages": {
|
||||||
"_": ["nginx"]
|
"_": ["nginx"]
|
||||||
},
|
},
|
||||||
@ -15,9 +12,8 @@
|
|||||||
|
|
||||||
{
|
{
|
||||||
"name": "vsftpd",
|
"name": "vsftpd",
|
||||||
"config": "/etc/vsftpd.conf",
|
|
||||||
"version": "0.1.0",
|
"version": "0.1.0",
|
||||||
"dependencies": {},
|
"dependencies": [],
|
||||||
"service": "vsftpd",
|
"service": "vsftpd",
|
||||||
"packages": {
|
"packages": {
|
||||||
"_": ["vsftpd"]
|
"_": ["vsftpd"]
|
||||||
@ -27,13 +23,23 @@
|
|||||||
|
|
||||||
{
|
{
|
||||||
"name": "mysql",
|
"name": "mysql",
|
||||||
"config": "/etc/mysql/",
|
|
||||||
"version": "0.1.0",
|
"version": "0.1.0",
|
||||||
"dependencies": {},
|
"dependencies": [],
|
||||||
"service": "mysql",
|
"service": "mysql",
|
||||||
"packages": {
|
"packages": {
|
||||||
"_": ["mysql"]
|
"_": ["mysql"]
|
||||||
},
|
},
|
||||||
"category": "database"
|
"category": "database"
|
||||||
|
},
|
||||||
|
|
||||||
|
{
|
||||||
|
"name": "mongodb",
|
||||||
|
"version": "0.1.0",
|
||||||
|
"dependencies": [],
|
||||||
|
"service": "mongodb",
|
||||||
|
"packages": {
|
||||||
|
"_": ["mongodb"]
|
||||||
|
},
|
||||||
|
"category": "database"
|
||||||
}
|
}
|
||||||
]
|
]
|
||||||
|
|||||||
24
services/mongodb/serverman-service-mongodb.cabal
Normal file
24
services/mongodb/serverman-service-mongodb.cabal
Normal file
@ -0,0 +1,24 @@
|
|||||||
|
name: serverman-service-mongodb
|
||||||
|
version: 0.1.0.0
|
||||||
|
-- synopsis:
|
||||||
|
-- description:
|
||||||
|
homepage: https://github.com/mdibaiee/mongodb#readme
|
||||||
|
license: GPL-3
|
||||||
|
license-file: LICENSE
|
||||||
|
author: Mahdi Dibaiee
|
||||||
|
maintainer: mahdi@theread.me
|
||||||
|
copyright: 2017 Mahdi Dibaiee
|
||||||
|
category: mongodb
|
||||||
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
|
|
||||||
|
executable mongodb
|
||||||
|
hs-source-dirs: src
|
||||||
|
main-is: Main.hs
|
||||||
|
default-language: Haskell2010
|
||||||
|
build-depends: base >= 4.7 && < 5
|
||||||
|
, data-default-class
|
||||||
|
, mtl
|
||||||
|
, mongoDB >= 2.1.1.1 && < 3
|
||||||
|
, bytestring
|
||||||
|
, text
|
||||||
62
services/mongodb/src/Main.hs
Normal file
62
services/mongodb/src/Main.hs
Normal file
@ -0,0 +1,62 @@
|
|||||||
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
|
module Main (call, main) where
|
||||||
|
import System.Serverman.Types
|
||||||
|
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 Control.Monad.State
|
||||||
|
import System.IO.Error
|
||||||
|
|
||||||
|
call :: Service -> App ()
|
||||||
|
call s@(Service { name, version, service })= do
|
||||||
|
(AppState { arguments }) <- get
|
||||||
|
|
||||||
|
let params@(DatabaseParams { database, dummyData, user, pass, host }) = toDBParams arguments
|
||||||
|
|
||||||
|
liftIO $ 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 ++ "')"
|
||||||
|
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = return ()
|
||||||
68
services/mongodb/src/Types.hs
Normal file
68
services/mongodb/src/Types.hs
Normal file
@ -0,0 +1,68 @@
|
|||||||
|
module Types (DatabaseParams(..), toDBParams, dummy) where
|
||||||
|
import System.Serverman.Utils
|
||||||
|
|
||||||
|
import Data.Default.Class
|
||||||
|
|
||||||
|
toDBParams :: [(String, Maybe String)] -> DatabaseParams
|
||||||
|
toDBParams (("database", Just value):xs) = (toDBParams xs) { database = value }
|
||||||
|
toDBParams (("user", Just value):xs) = (toDBParams xs) { user = value }
|
||||||
|
toDBParams (("pass", Just value):xs) = (toDBParams xs) { pass = value }
|
||||||
|
toDBParams (("host", Just value):xs) = (toDBParams xs) { host = value }
|
||||||
|
toDBParams (("dummy-data", Just value):xs) = (toDBParams xs) { dummyData = True }
|
||||||
|
toDBParams _ = def
|
||||||
|
|
||||||
|
data DatabaseParams = DatabaseParams { database :: String
|
||||||
|
, dummyData :: Bool
|
||||||
|
, user :: String
|
||||||
|
, pass :: String
|
||||||
|
, host :: String
|
||||||
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
instance Default DatabaseParams where
|
||||||
|
def = DatabaseParams { database = "serverman"
|
||||||
|
, dummyData = False
|
||||||
|
, user = "serverman"
|
||||||
|
, pass = "serverman"
|
||||||
|
, host = "localhost"
|
||||||
|
}
|
||||||
|
|
||||||
|
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"]])
|
||||||
66
services/mongodb/stack.yaml
Normal file
66
services/mongodb/stack.yaml
Normal file
@ -0,0 +1,66 @@
|
|||||||
|
# This file was automatically generated by 'stack init'
|
||||||
|
#
|
||||||
|
# Some commonly used options have been documented as comments in this file.
|
||||||
|
# For advanced use and comprehensive documentation of the format, please see:
|
||||||
|
# http://docs.haskellstack.org/en/stable/yaml_configuration/
|
||||||
|
|
||||||
|
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
|
||||||
|
# A snapshot resolver dictates the compiler version and the set of packages
|
||||||
|
# to be used for project dependencies. For example:
|
||||||
|
#
|
||||||
|
# resolver: lts-3.5
|
||||||
|
# resolver: nightly-2015-09-21
|
||||||
|
# resolver: ghc-7.10.2
|
||||||
|
# resolver: ghcjs-0.1.0_ghc-7.10.2
|
||||||
|
# resolver:
|
||||||
|
# name: custom-snapshot
|
||||||
|
# location: "./custom-snapshot.yaml"
|
||||||
|
resolver: lts-8.5
|
||||||
|
|
||||||
|
# User packages to be built.
|
||||||
|
# Various formats can be used as shown in the example below.
|
||||||
|
#
|
||||||
|
# packages:
|
||||||
|
# - some-directory
|
||||||
|
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
|
||||||
|
# - location:
|
||||||
|
# git: https://github.com/commercialhaskell/stack.git
|
||||||
|
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
|
||||||
|
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
|
||||||
|
# extra-dep: true
|
||||||
|
# subdirs:
|
||||||
|
# - auto-update
|
||||||
|
# - wai
|
||||||
|
#
|
||||||
|
# A package marked 'extra-dep: true' will only be built if demanded by a
|
||||||
|
# non-dependency (i.e. a user package), and its test suites and benchmarks
|
||||||
|
# will not be run. This is useful for tweaking upstream packages.
|
||||||
|
packages:
|
||||||
|
- '.'
|
||||||
|
# Dependency packages to be pulled from upstream that are not in the resolver
|
||||||
|
# (e.g., acme-missiles-0.3)
|
||||||
|
extra-deps: []
|
||||||
|
|
||||||
|
# Override default flag values for local packages and extra-deps
|
||||||
|
flags: {}
|
||||||
|
|
||||||
|
# Extra package databases containing global packages
|
||||||
|
extra-package-dbs: []
|
||||||
|
|
||||||
|
# Control whether we use the GHC we find on the path
|
||||||
|
# system-ghc: true
|
||||||
|
#
|
||||||
|
# Require a specific version of stack, using version ranges
|
||||||
|
# require-stack-version: -any # Default
|
||||||
|
# require-stack-version: ">=1.1"
|
||||||
|
#
|
||||||
|
# Override the architecture used by stack, especially useful on Windows
|
||||||
|
# arch: i386
|
||||||
|
# arch: x86_64
|
||||||
|
#
|
||||||
|
# Extra directories used by stack for building
|
||||||
|
# extra-include-dirs: [/path/to/dir]
|
||||||
|
# extra-lib-dirs: [/path/to/dir]
|
||||||
|
#
|
||||||
|
# Allow a newer minor version of GHC than the snapshot specifies
|
||||||
|
# compiler-check: newer-minor
|
||||||
22
services/mysql/serverman-service-mysql.cabal
Normal file
22
services/mysql/serverman-service-mysql.cabal
Normal file
@ -0,0 +1,22 @@
|
|||||||
|
name: serverman-service-mysql
|
||||||
|
version: 0.1.0.0
|
||||||
|
-- synopsis:
|
||||||
|
-- description:
|
||||||
|
homepage: https://github.com/mdibaiee/mysql#readme
|
||||||
|
license: GPL-3
|
||||||
|
license-file: LICENSE
|
||||||
|
author: Mahdi Dibaiee
|
||||||
|
maintainer: mahdi@theread.me
|
||||||
|
copyright: 2017 Mahdi Dibaiee
|
||||||
|
category: mysql
|
||||||
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
|
|
||||||
|
executable mysql
|
||||||
|
hs-source-dirs: src
|
||||||
|
main-is: Main.hs
|
||||||
|
default-language: Haskell2010
|
||||||
|
build-depends: base >= 4.7 && < 5
|
||||||
|
, data-default-class
|
||||||
|
, mtl
|
||||||
|
, mysql >= 0.1.4 && < 1
|
||||||
56
services/mysql/src/Main.hs
Normal file
56
services/mysql/src/Main.hs
Normal file
@ -0,0 +1,56 @@
|
|||||||
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
|
module Main (call, main) where
|
||||||
|
import System.Serverman.Types
|
||||||
|
import System.Serverman.Utils hiding (execute)
|
||||||
|
import Types
|
||||||
|
|
||||||
|
import Database.MySQL.Base
|
||||||
|
import qualified Data.ByteString.Char8 as BS
|
||||||
|
import Data.List
|
||||||
|
import Control.Monad
|
||||||
|
import Control.Monad.State
|
||||||
|
|
||||||
|
call :: Service -> App ()
|
||||||
|
call s@(Service { name, version, service }) = do
|
||||||
|
(AppState { arguments }) <- get
|
||||||
|
|
||||||
|
let params@(DatabaseParams { database, dummyData, user, pass, host }) = toDBParams arguments
|
||||||
|
|
||||||
|
liftIO $ do
|
||||||
|
conn <- connect $ defaultConnectInfo { connectUser = user, connectPassword = pass, connectHost = host }
|
||||||
|
|
||||||
|
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 ++ "')"
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = return ()
|
||||||
68
services/mysql/src/Types.hs
Normal file
68
services/mysql/src/Types.hs
Normal file
@ -0,0 +1,68 @@
|
|||||||
|
module Types (DatabaseParams(..), toDBParams, dummy) where
|
||||||
|
import System.Serverman.Utils
|
||||||
|
|
||||||
|
import Data.Default.Class
|
||||||
|
|
||||||
|
toDBParams :: [(String, Maybe String)] -> DatabaseParams
|
||||||
|
toDBParams (("database", Just value):xs) = (toDBParams xs) { database = value }
|
||||||
|
toDBParams (("user", Just value):xs) = (toDBParams xs) { user = value }
|
||||||
|
toDBParams (("pass", Just value):xs) = (toDBParams xs) { pass = value }
|
||||||
|
toDBParams (("host", Just value):xs) = (toDBParams xs) { host = value }
|
||||||
|
toDBParams (("dummy-data", Just value):xs) = (toDBParams xs) { dummyData = True }
|
||||||
|
toDBParams _ = def
|
||||||
|
|
||||||
|
data DatabaseParams = DatabaseParams { database :: String
|
||||||
|
, dummyData :: Bool
|
||||||
|
, user :: String
|
||||||
|
, pass :: String
|
||||||
|
, host :: String
|
||||||
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
instance Default DatabaseParams where
|
||||||
|
def = DatabaseParams { database = "serverman"
|
||||||
|
, dummyData = False
|
||||||
|
, user = "serverman"
|
||||||
|
, pass = "serverman"
|
||||||
|
, host = "localhost"
|
||||||
|
}
|
||||||
|
|
||||||
|
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"]])
|
||||||
66
services/mysql/stack.yaml
Normal file
66
services/mysql/stack.yaml
Normal file
@ -0,0 +1,66 @@
|
|||||||
|
# This file was automatically generated by 'stack init'
|
||||||
|
#
|
||||||
|
# Some commonly used options have been documented as comments in this file.
|
||||||
|
# For advanced use and comprehensive documentation of the format, please see:
|
||||||
|
# http://docs.haskellstack.org/en/stable/yaml_configuration/
|
||||||
|
|
||||||
|
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
|
||||||
|
# A snapshot resolver dictates the compiler version and the set of packages
|
||||||
|
# to be used for project dependencies. For example:
|
||||||
|
#
|
||||||
|
# resolver: lts-3.5
|
||||||
|
# resolver: nightly-2015-09-21
|
||||||
|
# resolver: ghc-7.10.2
|
||||||
|
# resolver: ghcjs-0.1.0_ghc-7.10.2
|
||||||
|
# resolver:
|
||||||
|
# name: custom-snapshot
|
||||||
|
# location: "./custom-snapshot.yaml"
|
||||||
|
resolver: lts-8.5
|
||||||
|
|
||||||
|
# User packages to be built.
|
||||||
|
# Various formats can be used as shown in the example below.
|
||||||
|
#
|
||||||
|
# packages:
|
||||||
|
# - some-directory
|
||||||
|
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
|
||||||
|
# - location:
|
||||||
|
# git: https://github.com/commercialhaskell/stack.git
|
||||||
|
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
|
||||||
|
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
|
||||||
|
# extra-dep: true
|
||||||
|
# subdirs:
|
||||||
|
# - auto-update
|
||||||
|
# - wai
|
||||||
|
#
|
||||||
|
# A package marked 'extra-dep: true' will only be built if demanded by a
|
||||||
|
# non-dependency (i.e. a user package), and its test suites and benchmarks
|
||||||
|
# will not be run. This is useful for tweaking upstream packages.
|
||||||
|
packages:
|
||||||
|
- '.'
|
||||||
|
# Dependency packages to be pulled from upstream that are not in the resolver
|
||||||
|
# (e.g., acme-missiles-0.3)
|
||||||
|
extra-deps: []
|
||||||
|
|
||||||
|
# Override default flag values for local packages and extra-deps
|
||||||
|
flags: {}
|
||||||
|
|
||||||
|
# Extra package databases containing global packages
|
||||||
|
extra-package-dbs: []
|
||||||
|
|
||||||
|
# Control whether we use the GHC we find on the path
|
||||||
|
# system-ghc: true
|
||||||
|
#
|
||||||
|
# Require a specific version of stack, using version ranges
|
||||||
|
# require-stack-version: -any # Default
|
||||||
|
# require-stack-version: ">=1.1"
|
||||||
|
#
|
||||||
|
# Override the architecture used by stack, especially useful on Windows
|
||||||
|
# arch: i386
|
||||||
|
# arch: x86_64
|
||||||
|
#
|
||||||
|
# Extra directories used by stack for building
|
||||||
|
# extra-include-dirs: [/path/to/dir]
|
||||||
|
# extra-lib-dirs: [/path/to/dir]
|
||||||
|
#
|
||||||
|
# Allow a newer minor version of GHC than the snapshot specifies
|
||||||
|
# compiler-check: newer-minor
|
||||||
24
services/nginx/serverman-service-nginx.cabal
Normal file
24
services/nginx/serverman-service-nginx.cabal
Normal file
@ -0,0 +1,24 @@
|
|||||||
|
name: serverman-service-nginx
|
||||||
|
version: 0.1.0.0
|
||||||
|
-- synopsis:
|
||||||
|
-- description:
|
||||||
|
homepage: https://github.com/githubuser/nginx#readme
|
||||||
|
license: GPL-3
|
||||||
|
license-file: LICENSE
|
||||||
|
author: Author name here
|
||||||
|
maintainer: example@example.com
|
||||||
|
copyright: 2017 Author name here
|
||||||
|
category: Web
|
||||||
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
|
extra-source-files: README.md
|
||||||
|
|
||||||
|
executable nginx
|
||||||
|
hs-source-dirs: src
|
||||||
|
main-is: Main.hs
|
||||||
|
default-language: Haskell2010
|
||||||
|
build-depends: base >= 4.7 && < 5
|
||||||
|
, data-default-class
|
||||||
|
, monad-control
|
||||||
|
, mtl
|
||||||
|
, free
|
||||||
BIN
services/nginx/src/Main
Executable file
BIN
services/nginx/src/Main
Executable file
Binary file not shown.
BIN
services/nginx/src/Main.hi
Normal file
BIN
services/nginx/src/Main.hi
Normal file
Binary file not shown.
126
services/nginx/src/Main.hs
Normal file
126
services/nginx/src/Main.hs
Normal file
@ -0,0 +1,126 @@
|
|||||||
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
|
module Main (call, main) where
|
||||||
|
import System.Serverman.Types
|
||||||
|
import System.Serverman.Utils
|
||||||
|
import Types
|
||||||
|
|
||||||
|
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.State
|
||||||
|
import Control.Monad.Free
|
||||||
|
import Data.List
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = return ()
|
||||||
|
|
||||||
|
call :: Service -> App ()
|
||||||
|
call _ =
|
||||||
|
do
|
||||||
|
(AppState { arguments }) <- get
|
||||||
|
let params@(ServerParams { ssl, domain, directory, serverType, email }) = toServerParams arguments
|
||||||
|
|
||||||
|
-- Turn SSL off at first, because we have not yet received a certificate
|
||||||
|
let content = show (params { ssl = False, port = "80" })
|
||||||
|
config = "/etc/nginx/"
|
||||||
|
mainConfig = "/etc/nginx/nginx.conf"
|
||||||
|
parent = config </> "serverman-configs"
|
||||||
|
path = parent </> domain
|
||||||
|
targetDir = directory
|
||||||
|
|
||||||
|
createCert path cmd = do
|
||||||
|
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
|
||||||
|
liftIO $ putStrLn stdout
|
||||||
|
|
||||||
|
when (not ("error" `isInfixOf` stdout)) $ do
|
||||||
|
liftIO $ writeFile path (show params)
|
||||||
|
liftIO . wait =<< restart
|
||||||
|
return ()
|
||||||
|
|
||||||
|
liftIO $ do
|
||||||
|
createDirectoryIfMissing True targetDir
|
||||||
|
createDirectoryIfMissing True parent
|
||||||
|
|
||||||
|
writeIncludeStatementIfMissing mainConfig parent
|
||||||
|
|
||||||
|
when ssl $ do
|
||||||
|
let sslPath = config </> "ssl.conf"
|
||||||
|
writeFileIfMissing sslPath nginxSSL
|
||||||
|
putStrLn $ "wrote ssl configuration to " ++ sslPath
|
||||||
|
|
||||||
|
writeFile path content
|
||||||
|
|
||||||
|
putStrLn $ "wrote your configuration file to " ++ path
|
||||||
|
|
||||||
|
liftIO . wait =<< restart
|
||||||
|
|
||||||
|
when ssl $ do
|
||||||
|
let dhparamPath = "/etc/ssl/certs/dhparam.pem"
|
||||||
|
dhExists <- liftIO $ doesFileExist dhparamPath
|
||||||
|
|
||||||
|
when (not dhExists) $ do
|
||||||
|
dhparam <- liftedAsync $ executeRoot "openssl" ["dhparam", "-out", dhparamPath, "2048"] "" True
|
||||||
|
liftIO $ wait dhparam
|
||||||
|
return ()
|
||||||
|
|
||||||
|
case serverType of
|
||||||
|
Static -> do
|
||||||
|
letsencrypt <- liftedAsync $ createCert path "letsencrypt"
|
||||||
|
|
||||||
|
liftIO $ wait letsencrypt
|
||||||
|
return ()
|
||||||
|
_ -> liftIO $ do
|
||||||
|
putStrLn $ "you should use letsencrypt to create a certificate for your domain"
|
||||||
|
putStrLn $ "and put it in /etc/letsencrypt/live/" ++ domain ++ "/fullchain.pem"
|
||||||
|
putStrLn $ "my suggestion is running this command:"
|
||||||
|
putStrLn $ "sudo letsencrypt certonly --webroot --webroot-path <YOUR_APPLICATION_DIRECTORY> -d " ++ domain
|
||||||
|
|
||||||
|
liftIO $ putStrLn $ "for more information, see: https://certbot.eff.org/"
|
||||||
|
|
||||||
|
return ()
|
||||||
|
where
|
||||||
|
restart = liftedAsync $ do
|
||||||
|
result <- restartService "nginx"
|
||||||
|
case result of
|
||||||
|
Left err -> return ()
|
||||||
|
Right _ ->
|
||||||
|
liftIO $ putStrLn $ "restarted nginx"
|
||||||
|
|
||||||
|
writeIncludeStatementIfMissing path target = do
|
||||||
|
content <- readFile path
|
||||||
|
|
||||||
|
let statement = "include " ++ target ++ "/*;"
|
||||||
|
|
||||||
|
when (not (statement `isInfixOf` content)) $ do
|
||||||
|
let newContent = appendAfter content "http {" (indent . indent $ statement)
|
||||||
|
|
||||||
|
writeFile path newContent
|
||||||
|
|
||||||
|
nginxSSL = "# from https://cipherli.st/\n\
|
||||||
|
\# and https://raymii.org/s/tutorials/Strong_SSL_Security_On_nginx.html\n\
|
||||||
|
\\n\
|
||||||
|
\ssl_protocols TLSv1 TLSv1.1 TLSv1.2;\n\
|
||||||
|
\ssl_prefer_server_ciphers on;\n\
|
||||||
|
\ssl_ciphers 'EECDH+AESGCM:EDH+AESGCM:AES256+EECDH:AES256+EDH';\n\
|
||||||
|
\ssl_ecdh_curve secp384r1;\n\
|
||||||
|
\ssl_session_cache shared:SSL:10m;\n\
|
||||||
|
\ssl_session_tickets off;\n\
|
||||||
|
\ssl_stapling on;\n\
|
||||||
|
\ssl_stapling_verify on;\n\
|
||||||
|
\resolver 8.8.8.8 8.8.4.4 valid=300s;\n\
|
||||||
|
\resolver_timeout 5s;\n\
|
||||||
|
\# Disable preloading HSTS for now. You can use the commented out header line that includes\n\
|
||||||
|
\# the 'preload' directive if you understand the implications.\n\
|
||||||
|
\#add_header Strict-Transport-Security 'max-age=63072000; includeSubdomains; preload';\n\
|
||||||
|
\add_header Strict-Transport-Security 'max-age=63072000; includeSubdomains';\n\
|
||||||
|
\add_header X-Frame-Options DENY;\n\
|
||||||
|
\add_header X-Content-Type-Options nosniff;\n\
|
||||||
|
\\n\
|
||||||
|
\ssl_dhparam /etc/ssl/certs/dhparam.pem;\n"
|
||||||
BIN
services/nginx/src/Main.o
Normal file
BIN
services/nginx/src/Main.o
Normal file
Binary file not shown.
76
services/nginx/src/Types.hs
Normal file
76
services/nginx/src/Types.hs
Normal file
@ -0,0 +1,76 @@
|
|||||||
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
|
module Types ( ServerType (..)
|
||||||
|
, ServerParams (..)
|
||||||
|
, toServerParams) where
|
||||||
|
|
||||||
|
import System.Serverman.Types
|
||||||
|
import System.Serverman.Utils
|
||||||
|
|
||||||
|
import Data.Default.Class
|
||||||
|
|
||||||
|
toServerParams :: [(String, Maybe String)] -> ServerParams
|
||||||
|
toServerParams (("directory", Just value):xs) = (toServerParams xs) { directory = value, serverType = Static }
|
||||||
|
toServerParams (("domain", Just value):xs) = (toServerParams xs) { domain = value }
|
||||||
|
toServerParams (("port", Just value):xs) = (toServerParams xs) { port = value }
|
||||||
|
toServerParams (("forward", Just value):xs) = (toServerParams xs) { forward = value, serverType = PortForwarding }
|
||||||
|
toServerParams (("email", Just value):xs) = (toServerParams xs) { email = value }
|
||||||
|
toServerParams (("ssl", Nothing):xs) = (toServerParams xs) { ssl = True }
|
||||||
|
toServerParams _ = def
|
||||||
|
|
||||||
|
data ServerType = Static | PortForwarding deriving (Show, Eq)
|
||||||
|
data ServerParams = ServerParams { directory :: FilePath
|
||||||
|
, domain :: String
|
||||||
|
, port :: String
|
||||||
|
, forward :: String
|
||||||
|
, email :: String
|
||||||
|
, ssl :: Bool
|
||||||
|
, serverType :: ServerType
|
||||||
|
} deriving (Eq)
|
||||||
|
|
||||||
|
instance Default ServerParams where
|
||||||
|
def = ServerParams { directory = "/var/www"
|
||||||
|
, domain = "localhost"
|
||||||
|
, port = "80"
|
||||||
|
, forward = ""
|
||||||
|
, email = ""
|
||||||
|
, ssl = False
|
||||||
|
, serverType = Static }
|
||||||
|
|
||||||
|
instance Show ServerParams where
|
||||||
|
show (ServerParams { directory, domain, port, forward, email, ssl, serverType }) =
|
||||||
|
let redirect
|
||||||
|
| ssl = block "server" $
|
||||||
|
semicolon $
|
||||||
|
keyvalue ([ ("listen", "80")
|
||||||
|
, ("listen", "[::]:80")
|
||||||
|
, ("server_name", domain)
|
||||||
|
, ("rewrite", "^ https://$server_name$request_uri? permanent")
|
||||||
|
]) " "
|
||||||
|
| otherwise = ""
|
||||||
|
https
|
||||||
|
| ssl = [ ("ssl_certificate", "/etc/letsencrypt/live/" ++ domain ++ "/fullchain.pem")
|
||||||
|
, ("ssl_certificate_key", "/etc/letsencrypt/live/" ++ domain ++ "/privkey.pem")
|
||||||
|
, ("include", "ssl.conf")]
|
||||||
|
| otherwise = []
|
||||||
|
|
||||||
|
listen = port ++ (if ssl then " ssl" else "")
|
||||||
|
|
||||||
|
base = [ ("server_name", domain)
|
||||||
|
, ("listen", listen)
|
||||||
|
, ("listen", "[::]:" ++ listen)
|
||||||
|
, ("index", "index.html index.html index.php")
|
||||||
|
] ++ https
|
||||||
|
in
|
||||||
|
case serverType of
|
||||||
|
Static ->
|
||||||
|
(block "server" $ keyvalue (base ++ [("root", directory)]) " ") ++ "\n" ++ redirect
|
||||||
|
|
||||||
|
PortForwarding ->
|
||||||
|
let proxyBlock = block "location /" $
|
||||||
|
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
|
||||||
66
services/nginx/stack.yaml
Normal file
66
services/nginx/stack.yaml
Normal file
@ -0,0 +1,66 @@
|
|||||||
|
# This file was automatically generated by 'stack init'
|
||||||
|
#
|
||||||
|
# Some commonly used options have been documented as comments in this file.
|
||||||
|
# For advanced use and comprehensive documentation of the format, please see:
|
||||||
|
# http://docs.haskellstack.org/en/stable/yaml_configuration/
|
||||||
|
|
||||||
|
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
|
||||||
|
# A snapshot resolver dictates the compiler version and the set of packages
|
||||||
|
# to be used for project dependencies. For example:
|
||||||
|
#
|
||||||
|
# resolver: lts-3.5
|
||||||
|
# resolver: nightly-2015-09-21
|
||||||
|
# resolver: ghc-7.10.2
|
||||||
|
# resolver: ghcjs-0.1.0_ghc-7.10.2
|
||||||
|
# resolver:
|
||||||
|
# name: custom-snapshot
|
||||||
|
# location: "./custom-snapshot.yaml"
|
||||||
|
resolver: lts-8.5
|
||||||
|
|
||||||
|
# User packages to be built.
|
||||||
|
# Various formats can be used as shown in the example below.
|
||||||
|
#
|
||||||
|
# packages:
|
||||||
|
# - some-directory
|
||||||
|
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
|
||||||
|
# - location:
|
||||||
|
# git: https://github.com/commercialhaskell/stack.git
|
||||||
|
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
|
||||||
|
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
|
||||||
|
# extra-dep: true
|
||||||
|
# subdirs:
|
||||||
|
# - auto-update
|
||||||
|
# - wai
|
||||||
|
#
|
||||||
|
# A package marked 'extra-dep: true' will only be built if demanded by a
|
||||||
|
# non-dependency (i.e. a user package), and its test suites and benchmarks
|
||||||
|
# will not be run. This is useful for tweaking upstream packages.
|
||||||
|
packages:
|
||||||
|
- '.'
|
||||||
|
# Dependency packages to be pulled from upstream that are not in the resolver
|
||||||
|
# (e.g., acme-missiles-0.3)
|
||||||
|
extra-deps: []
|
||||||
|
|
||||||
|
# Override default flag values for local packages and extra-deps
|
||||||
|
flags: {}
|
||||||
|
|
||||||
|
# Extra package databases containing global packages
|
||||||
|
extra-package-dbs: []
|
||||||
|
|
||||||
|
# Control whether we use the GHC we find on the path
|
||||||
|
# system-ghc: true
|
||||||
|
#
|
||||||
|
# Require a specific version of stack, using version ranges
|
||||||
|
# require-stack-version: -any # Default
|
||||||
|
# require-stack-version: ">=1.1"
|
||||||
|
#
|
||||||
|
# Override the architecture used by stack, especially useful on Windows
|
||||||
|
# arch: i386
|
||||||
|
# arch: x86_64
|
||||||
|
#
|
||||||
|
# Extra directories used by stack for building
|
||||||
|
# extra-include-dirs: [/path/to/dir]
|
||||||
|
# extra-lib-dirs: [/path/to/dir]
|
||||||
|
#
|
||||||
|
# Allow a newer minor version of GHC than the snapshot specifies
|
||||||
|
# compiler-check: newer-minor
|
||||||
37
services/template.hsfiles
Normal file
37
services/template.hsfiles
Normal file
@ -0,0 +1,37 @@
|
|||||||
|
{-# START_FILE serverman-service-{{name}}.cabal #-}
|
||||||
|
name: serverman-service-{{name}}
|
||||||
|
version: 0.1.0.0
|
||||||
|
-- synopsis:
|
||||||
|
-- description:
|
||||||
|
homepage: https://github.com/{{github-username}}{{^github-username}}githubuser{{/github-username}}/{{name}}#readme
|
||||||
|
license: GPL-3
|
||||||
|
license-file: LICENSE
|
||||||
|
author: {{author-name}}{{^author-name}}Author name here{{/author-name}}
|
||||||
|
maintainer: {{author-email}}{{^author-email}}example@example.com{{/author-email}}
|
||||||
|
copyright: {{year}}{{^year}}2017{{/year}} {{author-name}}{{^author-name}}Author name here{{/author-name}}
|
||||||
|
category: {{category}}{{^category}}serverman{{/category}}
|
||||||
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
|
|
||||||
|
executable {{name}}
|
||||||
|
hs-source-dirs: src
|
||||||
|
main-is: Main.hs
|
||||||
|
default-language: Haskell2010
|
||||||
|
build-depends: base >= 4.7 && < 5
|
||||||
|
, data-default-class
|
||||||
|
, mtl
|
||||||
|
|
||||||
|
{-# START_FILE src/Main.hs #-}
|
||||||
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
|
module Main (call, main) where
|
||||||
|
import System.Serverman.Types
|
||||||
|
import System.Serverman.Utils
|
||||||
|
import Control.Monad.State
|
||||||
|
|
||||||
|
call :: Service -> App ()
|
||||||
|
call s@(Service { name, version, service })= do
|
||||||
|
(AppState { os, arguments }) <- get
|
||||||
|
return ()
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = return ()
|
||||||
21
services/vsftpd/serverman-service-vsftpd.cabal
Normal file
21
services/vsftpd/serverman-service-vsftpd.cabal
Normal file
@ -0,0 +1,21 @@
|
|||||||
|
name: serverman-service-vsftpd
|
||||||
|
version: 0.1.0.0
|
||||||
|
-- synopsis:
|
||||||
|
-- description:
|
||||||
|
homepage: https://github.com/mdibaiee/vsftpd#readme
|
||||||
|
license: GPL-3
|
||||||
|
license-file: LICENSE
|
||||||
|
author: Mahdi Dibaiee
|
||||||
|
maintainer: mahdi@theread.me
|
||||||
|
copyright: 2017 Mahdi Dibaiee
|
||||||
|
category: ftp
|
||||||
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
|
|
||||||
|
executable vsftpd
|
||||||
|
hs-source-dirs: src
|
||||||
|
main-is: Main.hs
|
||||||
|
default-language: Haskell2010
|
||||||
|
build-depends: base >= 4.7 && < 5
|
||||||
|
, data-default-class
|
||||||
|
, mtl
|
||||||
50
services/vsftpd/src/Main.hs
Normal file
50
services/vsftpd/src/Main.hs
Normal file
@ -0,0 +1,50 @@
|
|||||||
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
|
module Main (call, main) where
|
||||||
|
import System.Serverman.Types
|
||||||
|
import System.Serverman.Utils
|
||||||
|
import Types
|
||||||
|
|
||||||
|
import System.Directory hiding (writable)
|
||||||
|
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
|
||||||
|
import Control.Monad.State
|
||||||
|
|
||||||
|
|
||||||
|
call :: Service -> App ()
|
||||||
|
call s@(Service { name, version, service })= do
|
||||||
|
(AppState { os, arguments }) <- get
|
||||||
|
|
||||||
|
let params@(FileSharingParams { directory, port, user, pass, anonymous, anonymousWrite, writable, recreateUser }) = toFSParams arguments
|
||||||
|
|
||||||
|
let content = show params
|
||||||
|
config = "/etc/"
|
||||||
|
original = config </> "vsftpd.conf"
|
||||||
|
userList = config </> "vsftpd-serverman-user-list"
|
||||||
|
|
||||||
|
when recreateUser $ executeRoot "userdel" [user] "" True >> return ()
|
||||||
|
|
||||||
|
(Right opensslResponse) <- execute "openssl" ["passwd", "-1", pass] "" True
|
||||||
|
let encryptedPassword = head . lines $ opensslResponse
|
||||||
|
|
||||||
|
executeRoot "useradd" [user, "-d", directory, "-G", "ftp", "-p", encryptedPassword] "" True
|
||||||
|
|
||||||
|
liftIO $ do
|
||||||
|
renameFileIfMissing original (original ++ ".backup")
|
||||||
|
writeFile original content
|
||||||
|
writeFile userList user
|
||||||
|
|
||||||
|
result <- restartService "vsftpd"
|
||||||
|
case result of
|
||||||
|
Left err -> return ()
|
||||||
|
Right _ ->
|
||||||
|
liftIO $ putStrLn $ "restarted vsftpd"
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = return ()
|
||||||
55
services/vsftpd/src/Types.hs
Normal file
55
services/vsftpd/src/Types.hs
Normal file
@ -0,0 +1,55 @@
|
|||||||
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
|
module Types ( FileSharingParams (..)
|
||||||
|
, toFSParams) where
|
||||||
|
import System.Serverman.Utils
|
||||||
|
import Data.Default.Class
|
||||||
|
|
||||||
|
toFSParams :: [(String, Maybe String)] -> FileSharingParams
|
||||||
|
toFSParams (("directory", Just value):xs) = (toFSParams xs) { directory = value }
|
||||||
|
toFSParams (("user", Just value):xs) = (toFSParams xs) { user = value }
|
||||||
|
toFSParams (("pass", Just value):xs) = (toFSParams xs) { pass = value }
|
||||||
|
toFSParams (("port", Just value):xs) = (toFSParams xs) { port = value }
|
||||||
|
toFSParams (("writable", Nothing):xs) = (toFSParams xs) { writable = True }
|
||||||
|
toFSParams (("anonymous", Nothing):xs) = (toFSParams xs) { anonymous = True }
|
||||||
|
toFSParams (("anonymous-write", Nothing):xs) = (toFSParams xs) { anonymousWrite = True }
|
||||||
|
toFSParams (("recreate-user", Nothing):xs) = (toFSParams xs) { recreateUser = True }
|
||||||
|
toFSParams _ = def
|
||||||
|
|
||||||
|
data FileSharingParams = FileSharingParams { directory :: FilePath
|
||||||
|
, user :: String
|
||||||
|
, pass :: String
|
||||||
|
, port :: String
|
||||||
|
, writable :: Bool
|
||||||
|
, anonymous :: Bool
|
||||||
|
, anonymousWrite :: Bool
|
||||||
|
, recreateUser :: Bool
|
||||||
|
} deriving (Eq)
|
||||||
|
|
||||||
|
instance Default FileSharingParams where
|
||||||
|
def = FileSharingParams { directory = "/srv/ftp/serverman"
|
||||||
|
, user = "serverman"
|
||||||
|
, pass = "serverman"
|
||||||
|
, port = "20"
|
||||||
|
, writable = True
|
||||||
|
, anonymous = False
|
||||||
|
, anonymousWrite = False
|
||||||
|
, recreateUser = False
|
||||||
|
}
|
||||||
|
|
||||||
|
instance Show FileSharingParams where
|
||||||
|
show (FileSharingParams { directory, user, pass, port, writable, anonymous, anonymousWrite }) =
|
||||||
|
let boolToEnglish True = "YES"
|
||||||
|
boolToEnglish False = "NO"
|
||||||
|
in
|
||||||
|
keyvalue [ ("anonymous_enable", boolToEnglish anonymous)
|
||||||
|
, ("write_enable", boolToEnglish writable)
|
||||||
|
, ("allow_writeable_chroot", boolToEnglish writable)
|
||||||
|
, ("anon_upload_enable", boolToEnglish anonymousWrite)
|
||||||
|
, ("anon_mkdir_write_enable", boolToEnglish anonymousWrite)
|
||||||
|
, ("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")] "="
|
||||||
66
services/vsftpd/stack.yaml
Normal file
66
services/vsftpd/stack.yaml
Normal file
@ -0,0 +1,66 @@
|
|||||||
|
# This file was automatically generated by 'stack init'
|
||||||
|
#
|
||||||
|
# Some commonly used options have been documented as comments in this file.
|
||||||
|
# For advanced use and comprehensive documentation of the format, please see:
|
||||||
|
# http://docs.haskellstack.org/en/stable/yaml_configuration/
|
||||||
|
|
||||||
|
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
|
||||||
|
# A snapshot resolver dictates the compiler version and the set of packages
|
||||||
|
# to be used for project dependencies. For example:
|
||||||
|
#
|
||||||
|
# resolver: lts-3.5
|
||||||
|
# resolver: nightly-2015-09-21
|
||||||
|
# resolver: ghc-7.10.2
|
||||||
|
# resolver: ghcjs-0.1.0_ghc-7.10.2
|
||||||
|
# resolver:
|
||||||
|
# name: custom-snapshot
|
||||||
|
# location: "./custom-snapshot.yaml"
|
||||||
|
resolver: lts-8.5
|
||||||
|
|
||||||
|
# User packages to be built.
|
||||||
|
# Various formats can be used as shown in the example below.
|
||||||
|
#
|
||||||
|
# packages:
|
||||||
|
# - some-directory
|
||||||
|
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
|
||||||
|
# - location:
|
||||||
|
# git: https://github.com/commercialhaskell/stack.git
|
||||||
|
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
|
||||||
|
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
|
||||||
|
# extra-dep: true
|
||||||
|
# subdirs:
|
||||||
|
# - auto-update
|
||||||
|
# - wai
|
||||||
|
#
|
||||||
|
# A package marked 'extra-dep: true' will only be built if demanded by a
|
||||||
|
# non-dependency (i.e. a user package), and its test suites and benchmarks
|
||||||
|
# will not be run. This is useful for tweaking upstream packages.
|
||||||
|
packages:
|
||||||
|
- '.'
|
||||||
|
# Dependency packages to be pulled from upstream that are not in the resolver
|
||||||
|
# (e.g., acme-missiles-0.3)
|
||||||
|
extra-deps: []
|
||||||
|
|
||||||
|
# Override default flag values for local packages and extra-deps
|
||||||
|
flags: {}
|
||||||
|
|
||||||
|
# Extra package databases containing global packages
|
||||||
|
extra-package-dbs: []
|
||||||
|
|
||||||
|
# Control whether we use the GHC we find on the path
|
||||||
|
# system-ghc: true
|
||||||
|
#
|
||||||
|
# Require a specific version of stack, using version ranges
|
||||||
|
# require-stack-version: -any # Default
|
||||||
|
# require-stack-version: ">=1.1"
|
||||||
|
#
|
||||||
|
# Override the architecture used by stack, especially useful on Windows
|
||||||
|
# arch: i386
|
||||||
|
# arch: x86_64
|
||||||
|
#
|
||||||
|
# Extra directories used by stack for building
|
||||||
|
# extra-include-dirs: [/path/to/dir]
|
||||||
|
# extra-lib-dirs: [/path/to/dir]
|
||||||
|
#
|
||||||
|
# Allow a newer minor version of GHC than the snapshot specifies
|
||||||
|
# compiler-check: newer-minor
|
||||||
Loading…
Reference in New Issue
Block a user