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 --- src/Propellor/Property/Systemd.hs | 64 ++++++++++++++++++++++++++++++++++----- src/Propellor/Types/Chroot.hs | 22 +++++++++++--- 2 files changed, 74 insertions(+), 12 deletions(-) (limited to 'src') 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