{-# LANGUAGE FlexibleInstances, TypeFamilies #-}
module Propellor.Property.Systemd (
ServiceName,
started,
stopped,
enabled,
disabled,
masked,
running,
restarted,
networkd,
journald,
logind,
escapePath,
installed,
Option,
configured,
daemonReloaded,
persistentJournal,
journaldConfigured,
logindConfigured,
killUserProcesses,
machined,
MachineName,
Container,
container,
debContainer,
nspawned,
containerCfg,
resolvConfed,
linkJournal,
privateNetwork,
module Propellor.Types.Container,
Proto(..),
Publishable,
publish,
Bindable,
bind,
bindRo,
) where
import Propellor.Base
import Propellor.Types.Chroot
import Propellor.Types.Container
import Propellor.Container
import Propellor.Types.Info
import qualified Propellor.Property.Chroot as Chroot
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.File as File
import Propellor.Property.Systemd.Core
import Utility.Split
import Data.List
import Data.Char
import qualified Data.Map as M
import Text.Printf
type ServiceName = String
type MachineName = String
data Container = Container MachineName Chroot.Chroot Host
deriving (Show)
instance IsContainer Container where
containerProperties (Container _ _ h) = containerProperties h
containerInfo (Container _ _ h) = containerInfo h
setContainerProperties (Container n c h) ps = Container n c (setContainerProperties h ps)
started :: ServiceName -> Property Linux
started n = tightenTargets $ cmdProperty "systemctl" ["start", n]
`assume` NoChange
`describe` ("service " ++ n ++ " started")
stopped :: ServiceName -> Property Linux
stopped n = tightenTargets $ cmdProperty "systemctl" ["stop", n]
`assume` NoChange
`describe` ("service " ++ n ++ " stopped")
enabled :: ServiceName -> Property Linux
enabled n = tightenTargets $ cmdProperty "systemctl" ["enable", n]
`assume` NoChange
`describe` ("service " ++ n ++ " enabled")
disabled :: ServiceName -> Property Linux
disabled n = tightenTargets $ cmdProperty "systemctl" ["disable", n]
`assume` NoChange
`describe` ("service " ++ n ++ " disabled")
masked :: ServiceName -> RevertableProperty Linux Linux
masked n = systemdMask <!> systemdUnmask
where
systemdMask = tightenTargets $ cmdProperty "systemctl" ["mask", n]
`assume` NoChange
`describe` ("service " ++ n ++ " masked")
systemdUnmask = tightenTargets $ cmdProperty "systemctl" ["unmask", n]
`assume` NoChange
`describe` ("service " ++ n ++ " unmasked")
running :: ServiceName -> Property Linux
running n = started n `requires` enabled n
restarted :: ServiceName -> Property Linux
restarted n = tightenTargets $ cmdProperty "systemctl" ["restart", n]
`assume` NoChange
`describe` ("service " ++ n ++ " restarted")
networkd :: ServiceName
networkd = "systemd-networkd"
journald :: ServiceName
journald = "systemd-journald"
logind :: ServiceName
logind = "systemd-logind"
persistentJournal :: Property DebianLike
persistentJournal = check (not <$> doesDirectoryExist dir) $
combineProperties "persistent systemd journal" $ props
& cmdProperty "install" ["-d", "-g", "systemd-journal", dir]
`assume` MadeChange
& Apt.installed ["acl"]
& cmdProperty "setfacl" ["-R", "-nm", "g:adm:rx,d:g:adm:rx", dir]
`assume` MadeChange
& started "systemd-journal-flush"
where
dir = "/var/log/journal"
type Option = String
configured :: FilePath -> Option -> String -> Property Linux
configured cfgfile option value = tightenTargets $ combineProperties desc $ props
& File.fileProperty desc (mapMaybe removeother) cfgfile
& File.containsLine cfgfile line
where
setting = option ++ "="
line = setting ++ value
desc = cfgfile ++ " " ++ line
removeother l
| setting `isPrefixOf` l && l /= line = Nothing
| otherwise = Just l
daemonReloaded :: Property Linux
daemonReloaded = tightenTargets $ cmdProperty "systemctl" ["daemon-reload"]
`assume` NoChange
journaldConfigured :: Option -> String -> Property Linux
journaldConfigured option value =
configured "/etc/systemd/journald.conf" option value
`onChange` restarted journald
logindConfigured :: Option -> String -> Property Linux
logindConfigured option value =
configured "/etc/systemd/logind.conf" option value
`onChange` restarted logind
killUserProcesses :: RevertableProperty Linux Linux
killUserProcesses = set "yes" <!> set "no"
where
set = logindConfigured "KillUserProcesses"
machined :: Property Linux
machined = installeddebian `pickOS` assumeinstalled
where
installeddebian :: Property DebianLike
installeddebian = withOS "machined installed" $ \w o ->
case o of
(Just (System (Debian _ suite) _))
| not (isStable suite) || suite /= (Stable "jessie") ->
ensureProperty w $ Apt.installed ["systemd-container"]
_ -> noChange
assumeinstalled :: Property Linux
assumeinstalled = doNothing
container :: MachineName -> (FilePath -> Chroot.Chroot) -> Container
container name mkchroot =
let c = Container name chroot h
in setContainerProps c $ containerProps c
&^ resolvConfed
&^ linkJournal
where
chroot = mkchroot (containerDir name)
h = Host name (containerProperties chroot) (containerInfo chroot)
debContainer :: MachineName -> Props metatypes -> Container
debContainer name ps = container name $ \d -> Chroot.debootstrapped mempty d ps
nspawned :: Container -> RevertableProperty (HasInfo + Linux) Linux
nspawned c@(Container name (Chroot.Chroot loc builder _ _) h) =
p `describe` ("nspawned " ++ name)
where
p :: RevertableProperty (HasInfo + Linux) Linux
p = enterScript c
`before` chrootprovisioned
`before` nspawnService c (_chrootCfg $ fromInfo $ hostInfo h)
`before` containerprovisioned
chrootprovisioned = Chroot.provisioned' chroot True [FilesystemContained]
containerprovisioned :: RevertableProperty Linux Linux
containerprovisioned =
tightenTargets (Chroot.propellChroot chroot (enterContainerProcess c) False containercaps)
<!>
doNothing
containercaps =
[ FilesystemContained
, HostnameContained
]
chroot = Chroot.Chroot loc builder Chroot.propagateChrootInfo h
nspawnService :: Container -> ChrootCfg -> RevertableProperty Linux Linux
nspawnService (Container name _ _) cfg = setup <!> teardown
where
service = nspawnServiceName name
overridedir = "/etc/systemd/system" </> nspawnServiceName name ++ ".d"
overridefile = overridedir </> "local.conf"
overridecontent =
[ "[Service]"
, "# Reset ExecStart from the template"
, "ExecStart="
, "ExecStart=/usr/bin/systemd-nspawn " ++ unwords nspawnparams
]
nspawnparams =
[ "--quiet"
, "--keep-unit"
, "--boot"
, "--directory=" ++ containerDir name
, "--machine=" ++ name
] ++ nspawnServiceParams cfg
overrideconfigured = File.hasContent overridefile overridecontent
`onChange` daemonReloaded
`requires` File.dirExists overridedir
setup :: Property Linux
setup = started service
`requires` enabled service
`requires` overrideconfigured
`requires` machined
teardown :: Property Linux
teardown = stopped service
`before` disabled service
`before` File.notPresent overridefile
nspawnServiceParams :: ChrootCfg -> [String]
nspawnServiceParams NoChrootCfg = []
nspawnServiceParams (SystemdNspawnCfg ps) =
M.keys $ M.filter id $ M.fromList ps
enterScript :: Container -> RevertableProperty Linux Linux
enterScript c@(Container name _ _) =
tightenTargets setup <!> tightenTargets teardown
where
setup = combineProperties ("generated " ++ enterScriptFile c) $ props
& scriptfile `File.hasContent`
[ "#!/usr/bin/perl"
, "# Generated by propellor"
, "my $pid=`machinectl show " ++ shellEscape name ++ " -p Leader | cut -d= -f2`;"
, "chomp $pid;"
, "if (length $pid) {"
, "\tforeach my $var (keys %ENV) {"
, "\t\tdelete $ENV{$var} unless $var eq 'PATH' || $var eq 'TERM';"
, "\t}"
, "\texec('nsenter', '-p', '-u', '-n', '-i', '-m', '-t', $pid, @ARGV);"
, "} else {"
, "\tdie 'container not running';"
, "}"
, "exit(1);"
]
& scriptfile `File.mode` combineModes (readModes ++ executeModes)
teardown = File.notPresent scriptfile
scriptfile = enterScriptFile c
enterScriptFile :: Container -> FilePath
enterScriptFile (Container name _ _ ) = "/usr/local/bin/enter-" ++ mungename name
enterContainerProcess :: Container -> [String] -> IO (CreateProcess, IO ())
enterContainerProcess c ps = pure (proc (enterScriptFile c) ps, noop)
nspawnServiceName :: MachineName -> ServiceName
nspawnServiceName name = "systemd-nspawn@" ++ name ++ ".service"
containerDir :: MachineName -> FilePath
containerDir name = "/var/lib/container" </> mungename name
mungename :: MachineName -> String
mungename = replace "/" "_"
containerCfg :: String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
containerCfg p = RevertableProperty (mk True) (mk False)
where
mk :: Bool -> Property (HasInfo + Linux)
mk b = tightenTargets $
pureInfoProperty desc $
mempty { _chrootCfg = SystemdNspawnCfg [(p', b)] }
where
desc = "container configuration " ++ (if b then "" else "without ") ++ p'
p' = case p of
('-':_) -> p
_ -> "--" ++ p
resolvConfed :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
resolvConfed = containerCfg "bind=/etc/resolv.conf"
linkJournal :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
linkJournal = containerCfg "link-journal=try-guest"
privateNetwork :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
privateNetwork = containerCfg "private-network"
class Publishable a where
toPublish :: a -> String
instance Publishable Port where
toPublish port = val port
instance Publishable (Bound Port) where
toPublish v = toPublish (hostSide v) ++ ":" ++ toPublish (containerSide v)
data Proto = TCP | UDP
instance Publishable (Proto, Bound Port) where
toPublish (TCP, fp) = "tcp:" ++ toPublish fp
toPublish (UDP, fp) = "udp:" ++ toPublish fp
publish :: Publishable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
publish p = containerCfg $ "--port=" ++ toPublish p
class Bindable a where
toBind :: a -> String
instance Bindable FilePath where
toBind f = f
instance Bindable (Bound FilePath) where
toBind v = hostSide v ++ ":" ++ containerSide v
bind :: Bindable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
bind p = containerCfg $ "--bind=" ++ toBind p
bindRo :: Bindable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
bindRo p = containerCfg $ "--bind-ro=" ++ toBind p
escapePath :: FilePath -> String
escapePath = concatMap escape
. dropWhile (== '/')
. reverse . dropWhile (== '/') . reverse
where
escape '/' = "-"
escape c
| ((isAscii c && isAlphaNum c) || c == '_') = [c]
| otherwise = '\\' : 'x' : printf "%x" c