diff --git a/propellor.cabal b/propellor.cabal index e40b6e6..645e5fa 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -113,8 +113,10 @@ Library Propellor.Engine Propellor.Exception Propellor.Types - Propellor.Types.OS + Propellor.Types.Chroot + Propellor.Types.Docker Propellor.Types.Dns + Propellor.Types.OS Propellor.Types.PrivData Other-Modules: Propellor.Git diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 7246e7e..c3b14a8 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 5cf60ff..460bc3e 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/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index b50194f..a2130a2 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -5,12 +5,16 @@ module Propellor.Property.Systemd ( enabled, disabled, persistentJournal, + daemonReloaded, Container, container, nspawned, + containerCfg, + resolvConfed, ) 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,13 +22,16 @@ import Propellor.Property.Systemd.Core import Utility.SafeCommand import Utility.FileMode +import Data.List import Data.List.Utils +import qualified Data.Map as M 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) @@ -63,6 +70,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. @@ -73,6 +84,7 @@ persistentJournal = check (not <$> doesDirectoryExist dir) $ 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 @@ -102,7 +114,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 +130,47 @@ 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/systemd-nspawn@.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 NoChrootCfg = [] +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. @@ -171,3 +211,25 @@ 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. +-- +-- 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 configuration " ++ (if b then "" 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.hs b/src/Propellor/Types.hs index a6c5aaf..e7d6354 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 0000000..b7ed780 --- /dev/null +++ b/src/Propellor/Types/Chroot.hs @@ -0,0 +1,29 @@ +module Propellor.Types.Chroot where + +import Data.Monoid +import qualified Data.Map as M + +data ChrootInfo host = ChrootInfo + { _chroots :: M.Map FilePath host + , _chrootCfg :: ChrootCfg + } + deriving (Show) + +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 + = NoChrootCfg + | SystemdNspawnCfg [(String, Bool)] + deriving (Show) + +instance Monoid ChrootCfg where + mempty = NoChrootCfg + mappend v NoChrootCfg = v + mappend NoChrootCfg v = v + mappend (SystemdNspawnCfg l1) (SystemdNspawnCfg l2) = + SystemdNspawnCfg (l1 <> l2) diff --git a/src/Propellor/Types/Docker.hs b/src/Propellor/Types/Docker.hs new file mode 100644 index 0000000..42a6592 --- /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 ""