From 6c92f1034f980718cef54cab58a1bcfdbc485f5d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 21 Nov 2014 18:55:33 -0400 Subject: split out info types --- src/Propellor/Property/Chroot.hs | 1 + src/Propellor/Property/Docker.hs | 3 ++- src/Propellor/Types.hs | 39 ++++----------------------------------- src/Propellor/Types/Chroot.hs | 15 +++++++++++++++ src/Propellor/Types/Docker.hs | 24 ++++++++++++++++++++++++ 5 files changed, 46 insertions(+), 36 deletions(-) create mode 100644 src/Propellor/Types/Chroot.hs create mode 100644 src/Propellor/Types/Docker.hs (limited to 'src') diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 7246e7eb..c3b14a8e 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -10,6 +10,7 @@ module Propellor.Property.Chroot ( ) where import Propellor +import Propellor.Types.Chroot import qualified Propellor.Property.Debootstrap as Debootstrap import qualified Propellor.Property.Systemd.Core as Systemd import qualified Propellor.Shim as Shim diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 5cf60ff9..460bc3ec 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -39,6 +39,7 @@ module Propellor.Property.Docker ( ) where import Propellor hiding (init) +import Propellor.Types.Docker import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Shim as Shim @@ -523,7 +524,7 @@ genProp :: String -> (HostName -> RunParam) -> Property genProp field mkval = pureInfoProperty field $ dockerInfo $ mempty { _dockerRunParams = [DockerRunParam (\hn -> "--"++field++"=" ++ mkval hn)] } -dockerInfo :: DockerInfo -> Info +dockerInfo :: DockerInfo Host -> Info dockerInfo i = mempty { _dockerinfo = i } -- | The ContainerIdent of a container is written to diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index a6c5aafa..e7d63547 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -23,9 +23,6 @@ module Propellor.Types , SshKeyType(..) , Val(..) , fromVal - , DockerInfo(..) - , DockerRunParam(..) - , ChrootInfo(..) , module Propellor.Types.OS , module Propellor.Types.Dns ) where @@ -37,11 +34,12 @@ import System.Posix.Types import "mtl" Control.Monad.Reader import "MonadCatchIO-transformers" Control.Monad.CatchIO import qualified Data.Set as S -import qualified Data.Map as M import qualified Propellor.Types.Dns as Dns import Propellor.Types.OS +import Propellor.Types.Chroot import Propellor.Types.Dns +import Propellor.Types.Docker import Propellor.Types.PrivData -- | Everything Propellor knows about a system: Its hostname, @@ -167,8 +165,8 @@ data Info = Info , _aliases :: S.Set HostName , _dns :: S.Set Dns.Record , _namedconf :: Dns.NamedConfMap - , _dockerinfo :: DockerInfo - , _chrootinfo :: ChrootInfo + , _dockerinfo :: DockerInfo Host + , _chrootinfo :: ChrootInfo Host } deriving (Show) @@ -197,32 +195,3 @@ instance Monoid (Val a) where fromVal :: Val a -> Maybe a fromVal (Val a) = Just a fromVal NoVal = Nothing - -data DockerInfo = DockerInfo - { _dockerRunParams :: [DockerRunParam] - , _dockerContainers :: M.Map String Host - } - deriving (Show) - -instance Monoid DockerInfo where - mempty = DockerInfo mempty mempty - mappend old new = DockerInfo - { _dockerRunParams = _dockerRunParams old <> _dockerRunParams new - , _dockerContainers = M.union (_dockerContainers old) (_dockerContainers new) - } - -newtype DockerRunParam = DockerRunParam (HostName -> String) - -instance Show DockerRunParam where - show (DockerRunParam a) = a "" - -data ChrootInfo = ChrootInfo - { _chroots :: M.Map FilePath Host - } - deriving (Show) - -instance Monoid ChrootInfo where - mempty = ChrootInfo mempty - mappend old new = ChrootInfo - { _chroots = M.union (_chroots old) (_chroots new) - } diff --git a/src/Propellor/Types/Chroot.hs b/src/Propellor/Types/Chroot.hs new file mode 100644 index 00000000..d4dd6eae --- /dev/null +++ b/src/Propellor/Types/Chroot.hs @@ -0,0 +1,15 @@ +module Propellor.Types.Chroot where + +import Data.Monoid +import qualified Data.Map as M + +data ChrootInfo h = ChrootInfo + { _chroots :: M.Map FilePath h + } + deriving (Show) + +instance Monoid (ChrootInfo h) where + mempty = ChrootInfo mempty + mappend old new = ChrootInfo + { _chroots = M.union (_chroots old) (_chroots new) + } diff --git a/src/Propellor/Types/Docker.hs b/src/Propellor/Types/Docker.hs new file mode 100644 index 00000000..42a65923 --- /dev/null +++ b/src/Propellor/Types/Docker.hs @@ -0,0 +1,24 @@ +module Propellor.Types.Docker where + +import Propellor.Types.OS + +import Data.Monoid +import qualified Data.Map as M + +data DockerInfo h = DockerInfo + { _dockerRunParams :: [DockerRunParam] + , _dockerContainers :: M.Map String h + } + deriving (Show) + +instance Monoid (DockerInfo h) where + mempty = DockerInfo mempty mempty + mappend old new = DockerInfo + { _dockerRunParams = _dockerRunParams old <> _dockerRunParams new + , _dockerContainers = M.union (_dockerContainers old) (_dockerContainers new) + } + +newtype DockerRunParam = DockerRunParam (HostName -> String) + +instance Show DockerRunParam where + show (DockerRunParam a) = a "" -- cgit v1.2.3 From 6be49197f6ddf391a21b61e0996ef4bb75cd8b1b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 21 Nov 2014 20:09:33 -0400 Subject: allow configuring systemd-nspawn parameters --- config-joey.hs | 1 + src/Propellor/Property/Systemd.hs | 64 ++++++++++++++++++++++++++++++++++----- src/Propellor/Types/Chroot.hs | 22 +++++++++++--- 3 files changed, 75 insertions(+), 12 deletions(-) (limited to 'src') diff --git a/config-joey.hs b/config-joey.hs index 2971c1a2..26e173b3 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -89,6 +89,7 @@ meow :: Systemd.Container meow = Systemd.container "meow" (Chroot.debootstrapped (System (Debian Unstable) "amd64") mempty) & Apt.serviceInstalledRunning "uptimed" & alias "meow.kitenet.net" + & Systemd.containerCfg "private-network" testChroot :: Chroot.Chroot testChroot = Chroot.debootstrapped (System (Debian Unstable) "amd64") mempty "/tmp/chroot" diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index b50194fa..0b34a3b4 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -5,12 +5,15 @@ module Propellor.Property.Systemd ( enabled, disabled, persistentJournal, + daemonReloaded, Container, container, nspawned, + containerCfg, ) where import Propellor +import Propellor.Types.Chroot import qualified Propellor.Property.Chroot as Chroot import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File @@ -18,6 +21,7 @@ import Propellor.Property.Systemd.Core import Utility.SafeCommand import Utility.FileMode +import Data.List import Data.List.Utils type ServiceName = String @@ -63,6 +67,10 @@ persistentJournal = check (not <$> doesDirectoryExist dir) $ where dir = "/var/log/journal" +-- | Causes systemd to reload its configuration files. +daemonReloaded :: Property +daemonReloaded = trivial $ cmdProperty "systemctl" ["daemon-reload"] + -- | Defines a container with a given machine name. -- -- Properties can be added to configure the Container. @@ -102,7 +110,7 @@ nspawned c@(Container name (Chroot.Chroot loc system builderconf _) h) = steps = [ enterScript c , chrootprovisioned - , nspawnService c + , nspawnService c (_chrootCfg $ _chrootinfo $ hostInfo h) ] -- Chroot provisioning is run in systemd-only mode, @@ -118,19 +126,46 @@ nspawned c@(Container name (Chroot.Chroot loc system builderconf _) h) = chroot = Chroot.Chroot loc system builderconf h -nspawnService :: Container -> RevertableProperty -nspawnService (Container name _ _) = RevertableProperty setup teardown +-- | Sets up the service file for the container, and then starts +-- it running. +nspawnService :: Container -> ChrootCfg -> RevertableProperty +nspawnService (Container name _ _) cfg = RevertableProperty setup teardown where service = nspawnServiceName name servicefile = "/etc/systemd/system/multi-user.target.wants" service - setup = check (not <$> doesFileExist servicefile) $ - started service - `requires` enabled service + servicefilecontent = do + ls <- lines <$> readFile "/lib/systemd/system/ssh.service" + return $ unlines $ + "# deployed by propellor" : map addparams ls + addparams l + | "ExecStart=" `isPrefixOf` l = + l ++ " " ++ unwords (nspawnServiceParams cfg) + | otherwise = l + + goodservicefile = (==) + <$> servicefilecontent + <*> catchDefaultIO "" (readFile servicefile) + + writeservicefile = property servicefile $ liftIO $ do + viaTmp writeFile servicefile =<< servicefilecontent + return MadeChange + + setupservicefile = check (not <$> goodservicefile) $ + -- if it's running, it has the wrong configuration, + -- so stop it + stopped service + `requires` daemonReloaded + `requires` writeservicefile + + setup = started service `requires` setupservicefile teardown = check (doesFileExist servicefile) $ - disabled service - `requires` stopped service + disabled service `requires` stopped service + +nspawnServiceParams :: ChrootCfg -> [String] +nspawnServiceParams ChrootCfg = [] +nspawnServiceParams (SystemdNspawnCfg ps) = ps -- | Installs a "enter-machinename" script that root can use to run a -- command inside the container. @@ -171,3 +206,16 @@ containerDir name = "/var/lib/container" mungename name mungename :: MachineName -> String mungename = replace "/" "_" + +-- | This configures how systemd-nspawn(1) starts the container, +-- by specifying a parameter, such as "--private-network", or +-- "--link-journal=guest" +-- +-- When there is no leading dash, "--" is prepended to the parameter. +containerCfg :: String -> Property +containerCfg p = pureInfoProperty ("container configured with " ++ p') $ + mempty { _chrootinfo = mempty { _chrootCfg = SystemdNspawnCfg [p'] } } + where + p' = case p of + ('-':_) -> p + _ -> "--" ++ p diff --git a/src/Propellor/Types/Chroot.hs b/src/Propellor/Types/Chroot.hs index d4dd6eae..b10e9817 100644 --- a/src/Propellor/Types/Chroot.hs +++ b/src/Propellor/Types/Chroot.hs @@ -3,13 +3,27 @@ module Propellor.Types.Chroot where import Data.Monoid import qualified Data.Map as M -data ChrootInfo h = ChrootInfo - { _chroots :: M.Map FilePath h +data ChrootInfo host = ChrootInfo + { _chroots :: M.Map FilePath host + , _chrootCfg :: ChrootCfg } deriving (Show) -instance Monoid (ChrootInfo h) where - mempty = ChrootInfo mempty +instance Monoid (ChrootInfo host) where + mempty = ChrootInfo mempty mempty mappend old new = ChrootInfo { _chroots = M.union (_chroots old) (_chroots new) + , _chrootCfg = _chrootCfg old <> _chrootCfg new } + +data ChrootCfg + = ChrootCfg + | SystemdNspawnCfg [String] + deriving (Show) + +instance Monoid ChrootCfg where + mempty = ChrootCfg + mappend _ ChrootCfg = ChrootCfg + mappend ChrootCfg r = r + mappend (SystemdNspawnCfg l1) (SystemdNspawnCfg l2) = + SystemdNspawnCfg (l1 <> l2) -- cgit v1.2.3 From 96c4890d8974018bf56444a96981995342356ac0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 21 Nov 2014 20:19:20 -0400 Subject: propellor spin --- src/Propellor/Property/Systemd.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 0b34a3b4..6cb40e84 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -135,7 +135,7 @@ nspawnService (Container name _ _) cfg = RevertableProperty setup teardown servicefile = "/etc/systemd/system/multi-user.target.wants" service servicefilecontent = do - ls <- lines <$> readFile "/lib/systemd/system/ssh.service" + ls <- lines <$> readFile "/lib/systemd/system/systemd-nspawn@.service" return $ unlines $ "# deployed by propellor" : map addparams ls addparams l -- cgit v1.2.3 From b373ffb761a16b26ce38ea90049216fc94d43479 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 21 Nov 2014 20:32:32 -0400 Subject: allow disabling nspawn params, and default to bind mounting /etc/resolv.conf --- src/Propellor/Property/Systemd.hs | 20 ++++++++++++++++---- src/Propellor/Types/Chroot.hs | 2 +- 2 files changed, 17 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 6cb40e84..554e6b20 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -23,6 +23,7 @@ import Utility.FileMode import Data.List import Data.List.Utils +import qualified Data.Map as M type ServiceName = String @@ -81,6 +82,7 @@ daemonReloaded = trivial $ cmdProperty "systemctl" ["daemon-reload"] container :: MachineName -> (FilePath -> Chroot.Chroot) -> Container container name mkchroot = Container name c h & os system + & resolvConfed where c@(Chroot.Chroot _ system _ _) = mkchroot (containerDir name) h = Host name [] mempty @@ -165,7 +167,8 @@ nspawnService (Container name _ _) cfg = RevertableProperty setup teardown nspawnServiceParams :: ChrootCfg -> [String] nspawnServiceParams ChrootCfg = [] -nspawnServiceParams (SystemdNspawnCfg ps) = ps +nspawnServiceParams (SystemdNspawnCfg ps) = + M.keys $ M.filter id $ M.fromList ps -- | Installs a "enter-machinename" script that root can use to run a -- command inside the container. @@ -212,10 +215,19 @@ mungename = replace "/" "_" -- "--link-journal=guest" -- -- When there is no leading dash, "--" is prepended to the parameter. -containerCfg :: String -> Property -containerCfg p = pureInfoProperty ("container configured with " ++ p') $ - mempty { _chrootinfo = mempty { _chrootCfg = SystemdNspawnCfg [p'] } } +-- +-- Reverting the property will remove a parameter, if it's present. +containerCfg :: String -> RevertableProperty +containerCfg p = RevertableProperty (mk True) (mk False) where + mk b = pureInfoProperty ("container configured " ++ if b then "with " else "without " ++ p') $ + mempty { _chrootinfo = mempty { _chrootCfg = SystemdNspawnCfg [(p', b)] } } p' = case p of ('-':_) -> p _ -> "--" ++ p + +-- | Bind mounts /etc/resolv.conf from the host into the container. +-- +-- This property is enabled by default. Revert it to disable it. +resolvConfed :: RevertableProperty +resolvConfed = containerCfg "bind=/etc/resolv.conf" diff --git a/src/Propellor/Types/Chroot.hs b/src/Propellor/Types/Chroot.hs index b10e9817..7e7c3630 100644 --- a/src/Propellor/Types/Chroot.hs +++ b/src/Propellor/Types/Chroot.hs @@ -18,7 +18,7 @@ instance Monoid (ChrootInfo host) where data ChrootCfg = ChrootCfg - | SystemdNspawnCfg [String] + | SystemdNspawnCfg [(String, Bool)] deriving (Show) instance Monoid ChrootCfg where -- cgit v1.2.3 From 6cdd37d9ff3ff3e3b8439445c1363b9bdc77a5da Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 21 Nov 2014 20:53:38 -0400 Subject: propellor spin --- config-joey.hs | 1 - src/Propellor/Property/Systemd.hs | 6 ++++-- src/Propellor/Types/Chroot.hs | 8 ++++---- 3 files changed, 8 insertions(+), 7 deletions(-) (limited to 'src') diff --git a/config-joey.hs b/config-joey.hs index b66a1183..2971c1a2 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -89,7 +89,6 @@ meow :: Systemd.Container meow = Systemd.container "meow" (Chroot.debootstrapped (System (Debian Unstable) "amd64") mempty) & Apt.serviceInstalledRunning "uptimed" & alias "meow.kitenet.net" - -- & Systemd.containerCfg "private-network" testChroot :: Chroot.Chroot testChroot = Chroot.debootstrapped (System (Debian Unstable) "amd64") mempty "/tmp/chroot" diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 554e6b20..a2130a21 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -10,6 +10,7 @@ module Propellor.Property.Systemd ( container, nspawned, containerCfg, + resolvConfed, ) where import Propellor @@ -30,6 +31,7 @@ type ServiceName = String type MachineName = String data Container = Container MachineName Chroot.Chroot Host + deriving (Show) instance Hostlike Container where (Container n c h) & p = Container n c (h & p) @@ -166,7 +168,7 @@ nspawnService (Container name _ _) cfg = RevertableProperty setup teardown disabled service `requires` stopped service nspawnServiceParams :: ChrootCfg -> [String] -nspawnServiceParams ChrootCfg = [] +nspawnServiceParams NoChrootCfg = [] nspawnServiceParams (SystemdNspawnCfg ps) = M.keys $ M.filter id $ M.fromList ps @@ -220,7 +222,7 @@ mungename = replace "/" "_" containerCfg :: String -> RevertableProperty containerCfg p = RevertableProperty (mk True) (mk False) where - mk b = pureInfoProperty ("container configured " ++ if b then "with " else "without " ++ p') $ + mk b = pureInfoProperty ("container configuration " ++ (if b then "" else "without ") ++ p') $ mempty { _chrootinfo = mempty { _chrootCfg = SystemdNspawnCfg [(p', b)] } } p' = case p of ('-':_) -> p diff --git a/src/Propellor/Types/Chroot.hs b/src/Propellor/Types/Chroot.hs index 7e7c3630..b7ed7807 100644 --- a/src/Propellor/Types/Chroot.hs +++ b/src/Propellor/Types/Chroot.hs @@ -17,13 +17,13 @@ instance Monoid (ChrootInfo host) where } data ChrootCfg - = ChrootCfg + = NoChrootCfg | SystemdNspawnCfg [(String, Bool)] deriving (Show) instance Monoid ChrootCfg where - mempty = ChrootCfg - mappend _ ChrootCfg = ChrootCfg - mappend ChrootCfg r = r + mempty = NoChrootCfg + mappend v NoChrootCfg = v + mappend NoChrootCfg v = v mappend (SystemdNspawnCfg l1) (SystemdNspawnCfg l2) = SystemdNspawnCfg (l1 <> l2) -- cgit v1.2.3