module Propellor.Property.Systemd (
ServiceName,
started,
stopped,
enabled,
disabled,
masked,
running,
restarted,
networkd,
journald,
installed,
Option,
configured,
daemonReloaded,
persistentJournal,
journaldConfigured,
machined,
MachineName,
Container,
container,
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.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.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) `addProp` p = Container n c (h `addProp` p)
(Container n c h) `addPropFront` p = Container n c (h `addPropFront` p)
getProperties (Container _ _ h) = hostProperties h
started :: ServiceName -> Property NoInfo
started n = cmdProperty "systemctl" ["start", n]
`assume` NoChange
`describe` ("service " ++ n ++ " started")
stopped :: ServiceName -> Property NoInfo
stopped n = cmdProperty "systemctl" ["stop", n]
`assume` NoChange
`describe` ("service " ++ n ++ " stopped")
enabled :: ServiceName -> Property NoInfo
enabled n = cmdProperty "systemctl" ["enable", n]
`assume` NoChange
`describe` ("service " ++ n ++ " enabled")
disabled :: ServiceName -> Property NoInfo
disabled n = cmdProperty "systemctl" ["disable", n]
`assume` NoChange
`describe` ("service " ++ n ++ " disabled")
masked :: ServiceName -> RevertableProperty NoInfo
masked n = systemdMask <!> systemdUnmask
where
systemdMask = cmdProperty "systemctl" ["mask", n]
`assume` NoChange
`describe` ("service " ++ n ++ " masked")
systemdUnmask = cmdProperty "systemctl" ["unmask", n]
`assume` NoChange
`describe` ("service " ++ n ++ " unmasked")
running :: ServiceName -> Property NoInfo
running n = started n `requires` enabled n
restarted :: ServiceName -> Property NoInfo
restarted n = cmdProperty "systemctl" ["restart", n]
`assume` NoChange
`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]
`assume` MadeChange
, cmdProperty "setfacl" ["-R", "-nm", "g:adm:rx,d:g:adm:rx", dir]
`assume` MadeChange
, 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 && l /= line = Nothing
| otherwise = Just l
daemonReloaded :: Property NoInfo
daemonReloaded = cmdProperty "systemctl" ["daemon-reload"]
`assume` NoChange
journaldConfigured :: Option -> String -> Property NoInfo
journaldConfigured option value =
configured "/etc/systemd/journald.conf" option value
`onChange` restarted journald
machined :: Property NoInfo
machined = go `describe` "machined installed"
where
go = withOS ("standard sources.list") $ \o ->
case o of
(Just (System (Debian suite) _))
| not (isStable suite) -> ensureProperty $
Apt.installed ["systemd-container"]
_ -> noChange
container :: MachineName -> System -> (FilePath -> Chroot.Chroot) -> Container
container name system mkchroot = Container name c h
& os system
& resolvConfed
& linkJournal
where
c = mkchroot (containerDir name)
& os system
h = Host name [] mempty
nspawned :: Container -> RevertableProperty HasInfo
nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
p `describe` ("nspawned " ++ name)
where
p = enterScript c
`before` chrootprovisioned
`before` nspawnService c (_chrootCfg $ getInfo $ hostInfo h)
`before` containerprovisioned
chrootprovisioned = Chroot.provisioned' (Chroot.propagateChrootInfo chroot) chroot True
containerprovisioned =
Chroot.propellChroot chroot (enterContainerProcess c) False
<!>
doNothing
chroot = Chroot.Chroot loc builder h
nspawnService :: Container -> ChrootCfg -> RevertableProperty NoInfo
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 $ do
c <- servicefilecontent
File.viaStableTmp (\t -> writeFile t c) servicefile
setupservicefile = check (not <$> goodservicefile) $
stopped service
`requires` daemonReloaded
`requires` writeservicefile
setup = started service `requires` setupservicefile `requires` machined
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 NoInfo
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 HasInfo
containerCfg p = RevertableProperty (mk True) (mk False)
where
mk b = pureInfoProperty ("container configuration " ++ (if b then "" else "without ") ++ p') $
mempty { _chrootCfg = SystemdNspawnCfg [(p', b)] }
p' = case p of
('-':_) -> p
_ -> "--" ++ p
resolvConfed :: RevertableProperty HasInfo
resolvConfed = containerCfg "bind=/etc/resolv.conf"
linkJournal :: RevertableProperty HasInfo
linkJournal = containerCfg "link-journal=try-guest"
privateNetwork :: RevertableProperty HasInfo
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 HasInfo
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
bind p = containerCfg $ "--bind=" ++ toBind p
bindRo :: Bindable p => p -> RevertableProperty HasInfo
bindRo p = containerCfg $ "--bind-ro=" ++ toBind p