module Propellor.Property.Systemd (
ServiceName,
started,
stopped,
enabled,
disabled,
masked,
running,
restarted,
networkd,
journald,
installed,
Option,
configured,
daemonReloaded,
persistentJournal,
journaldConfigured,
MachineName,
Container,
container,
nspawned,
containerCfg,
resolvConfed,
linkJournal,
privateNetwork,
module Propellor.Types.Container,
Proto(..),
Publishable,
publish,
Bindable,
bind,
bindRo,
) where
import Propellor
import Propellor.Types.Chroot
import Propellor.Types.Container
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.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 PropAccum Container where
(Container n c h) & p = Container n c (h & p)
(Container n c h) &^ p = Container n c (h &^ p)
getProperties (Container _ _ h) = hostProperties h
started :: ServiceName -> Property NoInfo
started n = trivial $ cmdProperty "systemctl" ["start", n]
`describe` ("service " ++ n ++ " started")
stopped :: ServiceName -> Property NoInfo
stopped n = trivial $ cmdProperty "systemctl" ["stop", n]
`describe` ("service " ++ n ++ " stopped")
enabled :: ServiceName -> Property NoInfo
enabled n = trivial $ cmdProperty "systemctl" ["enable", n]
`describe` ("service " ++ n ++ " enabled")
disabled :: ServiceName -> Property NoInfo
disabled n = trivial $ cmdProperty "systemctl" ["disable", n]
`describe` ("service " ++ n ++ " disabled")
masked :: ServiceName -> RevertableProperty
masked n = systemdMask <!> systemdUnmask
where
systemdMask = trivial $ cmdProperty "systemctl" ["mask", n]
`describe` ("service " ++ n ++ " masked")
systemdUnmask = trivial $ cmdProperty "systemctl" ["unmask", n]
`describe` ("service " ++ n ++ " unmasked")
running :: ServiceName -> Property NoInfo
running n = trivial $ started n `requires` enabled n
restarted :: ServiceName -> Property NoInfo
restarted n = trivial $ cmdProperty "systemctl" ["restart", n]
`describe` ("service " ++ n ++ " restarted")
networkd :: ServiceName
networkd = "systemd-networkd"
journald :: ServiceName
journald = "systemd-journald"
persistentJournal :: Property NoInfo
persistentJournal = check (not <$> doesDirectoryExist dir) $
combineProperties "persistent systemd journal"
[ cmdProperty "install" ["-d", "-g", "systemd-journal", dir]
, cmdProperty "setfacl" ["-R", "-nm", "g:adm:rx,d:g:adm:rx", dir]
, started "systemd-journal-flush"
]
`requires` Apt.installed ["acl"]
where
dir = "/var/log/journal"
type Option = String
configured :: FilePath -> Option -> String -> Property NoInfo
configured cfgfile option value = combineProperties desc
[ File.fileProperty desc (mapMaybe removeother) cfgfile
, File.containsLine cfgfile line
]
where
setting = option ++ "="
line = setting ++ value
desc = cfgfile ++ " " ++ line
removeother l
| setting `isPrefixOf` l = Nothing
| otherwise = Just l
daemonReloaded :: Property NoInfo
daemonReloaded = trivial $ cmdProperty "systemctl" ["daemon-reload"]
journaldConfigured :: Option -> String -> Property NoInfo
journaldConfigured option value =
configured "/etc/systemd/journald.conf" option value
`onChange` restarted journald
container :: MachineName -> (FilePath -> Chroot.Chroot) -> Container
container name mkchroot = Container name c h
& os system
& resolvConfed
& linkJournal
where
c@(Chroot.Chroot _ system _ _) = mkchroot (containerDir name)
h = Host name [] mempty
nspawned :: Container -> RevertableProperty
nspawned c@(Container name (Chroot.Chroot loc system builderconf _) h) =
p `describe` ("nspawned " ++ name)
where
p = enterScript c
`before` chrootprovisioned
`before` nspawnService c (_chrootCfg $ _chrootinfo $ hostInfo h)
`before` containerprovisioned
chrootprovisioned = Chroot.provisioned' (Chroot.propigateChrootInfo chroot) chroot True
containerprovisioned =
Chroot.propellChroot chroot (enterContainerProcess c) False
<!>
doNothing
chroot = Chroot.Chroot loc system builderconf h
nspawnService :: Container -> ChrootCfg -> RevertableProperty
nspawnService (Container name _ _) cfg = setup <!> teardown
where
service = nspawnServiceName name
servicefile = "/etc/systemd/system/multi-user.target.wants" </> 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 = unwords $
[ "ExecStart = /usr/bin/systemd-nspawn"
, "--quiet"
, "--keep-unit"
, "--boot"
, "--directory=" ++ containerDir name
, "--machine=%i"
] ++ nspawnServiceParams cfg
| otherwise = l
goodservicefile = (==)
<$> servicefilecontent
<*> catchDefaultIO "" (readFile servicefile)
writeservicefile = property servicefile $ makeChange $
viaTmp writeFile servicefile =<< servicefilecontent
setupservicefile = check (not <$> goodservicefile) $
stopped service
`requires` daemonReloaded
`requires` writeservicefile
setup = started service `requires` setupservicefile
teardown = check (doesFileExist servicefile) $
disabled service `requires` stopped service
nspawnServiceParams :: ChrootCfg -> [String]
nspawnServiceParams NoChrootCfg = []
nspawnServiceParams (SystemdNspawnCfg ps) =
M.keys $ M.filter id $ M.fromList ps
enterScript :: Container -> RevertableProperty
enterScript c@(Container name _ _) = setup <!> teardown
where
setup = combineProperties ("generated " ++ enterScriptFile c)
[ 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
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
resolvConfed :: RevertableProperty
resolvConfed = containerCfg "bind=/etc/resolv.conf"
linkJournal :: RevertableProperty
linkJournal = containerCfg "link-journal=try-guest"
privateNetwork :: RevertableProperty
privateNetwork = containerCfg "private-network"
class Publishable a where
toPublish :: a -> String
instance Publishable Port where
toPublish (Port n) = show n
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
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
bind p = containerCfg $ "--bind=" ++ toBind p
bindRo :: Bindable p => p -> RevertableProperty
bindRo p = containerCfg $ "--bind-ro=" ++ toBind p