propellor

propellor config for hosts.
git clone git://git.ricketyspace.net/propellor.git
Log | Files | Refs | LICENSE

Systemd.hs (16128B)


      1 {-# LANGUAGE FlexibleInstances, TypeFamilies #-}
      2 
      3 module Propellor.Property.Systemd (
      4 	-- * Services
      5 	ServiceName,
      6 	started,
      7 	stopped,
      8 	enabled,
      9 	disabled,
     10 	masked,
     11 	running,
     12 	restarted,
     13 	networkd,
     14 	journald,
     15 	logind,
     16 	escapePath,
     17 	-- * Configuration
     18 	installed,
     19 	Option,
     20 	configured,
     21 	daemonReloaded,
     22 	-- * Journal
     23 	persistentJournal,
     24 	journaldConfigured,
     25 	-- * Logind
     26 	logindConfigured,
     27 	killUserProcesses,
     28 	-- * Containers and machined
     29 	machined,
     30 	MachineName,
     31 	Container,
     32 	container,
     33 	debContainer,
     34 	nspawned,
     35 	-- * Container configuration
     36 	containerCfg,
     37 	resolvConfed,
     38 	linkJournal,
     39 	privateNetwork,
     40 	module Propellor.Types.Container,
     41 	Proto(..),
     42 	Publishable,
     43 	publish,
     44 	Bindable,
     45 	bind,
     46 	bindRo,
     47 ) where
     48 
     49 import Propellor.Base
     50 import Propellor.Types.Chroot
     51 import Propellor.Types.Container
     52 import Propellor.Container
     53 import Propellor.Types.Info
     54 import qualified Propellor.Property.Chroot as Chroot
     55 import qualified Propellor.Property.Apt as Apt
     56 import qualified Propellor.Property.File as File
     57 import Propellor.Property.Systemd.Core
     58 import Utility.Split
     59 
     60 import Data.List
     61 import Data.Char
     62 import qualified Data.Map as M
     63 import Text.Printf
     64 
     65 type ServiceName = String
     66 
     67 type MachineName = String
     68 
     69 data Container = Container MachineName Chroot.Chroot Host
     70 	deriving (Show)
     71 
     72 instance IsContainer Container where
     73 	containerProperties (Container _ _ h) = containerProperties h
     74 	containerInfo (Container _ _ h) = containerInfo h
     75 	setContainerProperties (Container n c h) ps = Container n c (setContainerProperties h ps)
     76 
     77 -- | Starts a systemd service.
     78 --
     79 -- Note that this does not configure systemd to start the service on boot,
     80 -- it only ensures that the service is currently running.
     81 started :: ServiceName -> Property Linux
     82 started n = tightenTargets $ cmdProperty "systemctl" ["start", n]
     83 	`assume` NoChange
     84 	`describe` ("service " ++ n ++ " started")
     85 
     86 -- | Stops a systemd service.
     87 stopped :: ServiceName -> Property Linux
     88 stopped n = tightenTargets $ cmdProperty "systemctl" ["stop", n]
     89 	`assume` NoChange
     90 	`describe` ("service " ++ n ++ " stopped")
     91 
     92 -- | Enables a systemd service.
     93 --
     94 -- This does not ensure the service is started, it only configures systemd
     95 -- to start it on boot.
     96 enabled :: ServiceName -> Property Linux
     97 enabled n = tightenTargets $ cmdProperty "systemctl" ["enable", n]
     98 	`assume` NoChange
     99 	`describe` ("service " ++ n ++ " enabled")
    100 
    101 -- | Disables a systemd service.
    102 disabled :: ServiceName -> Property Linux
    103 disabled n = tightenTargets $ cmdProperty "systemctl" ["disable", n]
    104 	`assume` NoChange
    105 	`describe` ("service " ++ n ++ " disabled")
    106 
    107 -- | Masks a systemd service.
    108 masked :: ServiceName -> RevertableProperty Linux Linux
    109 masked n = systemdMask <!> systemdUnmask
    110   where
    111 	systemdMask = tightenTargets $ cmdProperty "systemctl" ["mask", n]
    112 		`assume` NoChange
    113 		`describe` ("service " ++ n ++ " masked")
    114 	systemdUnmask = tightenTargets $ cmdProperty "systemctl" ["unmask", n]
    115 		`assume` NoChange
    116 		`describe` ("service " ++ n ++ " unmasked")
    117 
    118 -- | Ensures that a service is both enabled and started
    119 running :: ServiceName -> Property Linux
    120 running n = started n `requires` enabled n
    121 
    122 -- | Restarts a systemd service.
    123 restarted :: ServiceName -> Property Linux
    124 restarted n = tightenTargets $ cmdProperty "systemctl" ["restart", n]
    125 	`assume` NoChange
    126 	`describe` ("service " ++ n ++ " restarted")
    127 
    128 -- | The systemd-networkd service.
    129 networkd :: ServiceName
    130 networkd = "systemd-networkd"
    131 
    132 -- | The systemd-journald service.
    133 journald :: ServiceName
    134 journald = "systemd-journald"
    135 
    136 -- | The systemd-logind service.
    137 logind :: ServiceName
    138 logind = "systemd-logind"
    139 
    140 -- | Enables persistent storage of the journal.
    141 persistentJournal :: Property DebianLike
    142 persistentJournal = check (not <$> doesDirectoryExist dir) $
    143 	combineProperties "persistent systemd journal" $ props
    144 		& cmdProperty "install" ["-d", "-g", "systemd-journal", dir]
    145 			`assume` MadeChange
    146 		& Apt.installed ["acl"]
    147 		& cmdProperty "setfacl" ["-R", "-nm", "g:adm:rx,d:g:adm:rx", dir]
    148 			`assume` MadeChange
    149 		& started "systemd-journal-flush"
    150   where
    151 	dir = "/var/log/journal"
    152 
    153 type Option = String
    154 
    155 -- | Ensures that an option is configured in one of systemd's config files.
    156 -- Does not ensure that the relevant daemon notices the change immediately.
    157 --
    158 -- This assumes that there is only one [Header] per file, which is
    159 -- currently the case for files like journald.conf and system.conf.
    160 -- And it assumes the file already exists with
    161 -- the right [Header], so new lines can just be appended to the end.
    162 configured :: FilePath -> Option -> String -> Property Linux
    163 configured cfgfile option value = tightenTargets $ combineProperties desc $ props
    164 	& File.fileProperty desc (mapMaybe removeother) cfgfile
    165 	& File.containsLine cfgfile line
    166   where
    167 	setting = option ++ "="
    168 	line = setting ++ value
    169 	desc = cfgfile ++ " " ++ line
    170 	removeother l
    171 		| setting `isPrefixOf` l && l /= line = Nothing
    172 		| otherwise = Just l
    173 
    174 -- | Causes systemd to reload its configuration files.
    175 daemonReloaded :: Property Linux
    176 daemonReloaded = tightenTargets $ cmdProperty "systemctl" ["daemon-reload"]
    177 	`assume` NoChange
    178 
    179 -- | Configures journald, restarting it so the changes take effect.
    180 journaldConfigured :: Option -> String -> Property Linux
    181 journaldConfigured option value =
    182 	configured "/etc/systemd/journald.conf" option value
    183 		`onChange` restarted journald
    184 
    185 -- | Configures logind, restarting it so the changes take effect.
    186 logindConfigured :: Option -> String -> Property Linux
    187 logindConfigured option value =
    188 	configured "/etc/systemd/logind.conf" option value
    189 		`onChange` restarted logind
    190 
    191 -- | Configures whether leftover processes started from the
    192 -- user's login session are killed after the user logs out.
    193 --
    194 -- The default configuration varies depending on the version of systemd.
    195 --
    196 -- Revert the property to ensure that screen sessions etc keep running:
    197 --
    198 -- >	! killUserProcesses
    199 killUserProcesses :: RevertableProperty Linux Linux
    200 killUserProcesses = set "yes" <!> set "no"
    201   where
    202 	set = logindConfigured "KillUserProcesses"
    203 
    204 -- | Ensures machined and machinectl are installed
    205 machined :: Property Linux
    206 machined = installeddebian `pickOS` assumeinstalled
    207   where
    208 	installeddebian :: Property DebianLike
    209 	installeddebian = withOS "machined installed" $ \w o ->
    210 		case o of
    211 			-- Split into separate debian package since systemd 225.
    212 			(Just (System (Debian _ suite) _))
    213 				| not (isStable suite) || suite /= (Stable "jessie") ->
    214 					ensureProperty w $ Apt.installed ["systemd-container"]
    215 			_ -> noChange
    216 	assumeinstalled :: Property Linux
    217 	assumeinstalled = doNothing
    218 
    219 -- | Defines a container with a given machine name,
    220 -- and how to create its chroot if not already present.
    221 --
    222 -- Properties can be added to configure the Container. At a minimum,
    223 -- add a property such as `osDebian` to specify the operating system
    224 -- to bootstrap.
    225 --
    226 -- > container "webserver" $ \d -> Chroot.debootstrapped mempty d $ props
    227 -- >    & osDebian Unstable X86_64
    228 -- >    & Apt.installedRunning "apache2"
    229 -- >    & ...
    230 container :: MachineName -> (FilePath -> Chroot.Chroot) -> Container
    231 container name mkchroot =
    232 	let c = Container name chroot h
    233 	in setContainerProps c $ containerProps c
    234 		&^ resolvConfed
    235 		&^ linkJournal
    236   where
    237 	chroot = mkchroot (containerDir name)
    238 	h = Host name (containerProperties chroot) (containerInfo chroot)
    239 
    240 -- | Defines a container with a given machine name, with the chroot
    241 -- created using debootstrap.
    242 --
    243 -- Properties can be added to configure the Container. At a minimum,
    244 -- add a property such as `osDebian` to specify the operating system
    245 -- to bootstrap.
    246 --
    247 -- > debContainer "webserver" $ props
    248 -- >    & osDebian Unstable X86_64
    249 -- >    & Apt.installedRunning "apache2"
    250 -- >    & ...
    251 debContainer :: MachineName -> Props metatypes -> Container
    252 debContainer name ps = container name $ \d -> Chroot.debootstrapped mempty d ps
    253 
    254 -- | Runs a container using systemd-nspawn.
    255 --
    256 -- A systemd unit is set up for the container, so it will automatically
    257 -- be started on boot.
    258 --
    259 -- Systemd is automatically installed inside the container, and will
    260 -- communicate with the host's systemd. This allows systemctl to be used to
    261 -- examine the status of services running inside the container.
    262 --
    263 -- When the host system has persistentJournal enabled, journactl can be
    264 -- used to examine logs forwarded from the container.
    265 --
    266 -- Reverting this property stops the container, removes the systemd unit,
    267 -- and deletes the chroot and all its contents.
    268 nspawned :: Container -> RevertableProperty (HasInfo + Linux) Linux
    269 nspawned c@(Container name (Chroot.Chroot loc builder _ _) h) =
    270 	p `describe` ("nspawned " ++ name)
    271   where
    272 	p :: RevertableProperty (HasInfo + Linux) Linux
    273 	p = enterScript c
    274 		`before` chrootprovisioned
    275 		`before` nspawnService c (_chrootCfg $ fromInfo $ hostInfo h)
    276 		`before` containerprovisioned
    277 
    278 	-- Chroot provisioning is run in systemd-only mode,
    279 	-- which sets up the chroot and ensures systemd and dbus are
    280 	-- installed, but does not handle the other properties.
    281 	chrootprovisioned = Chroot.provisioned' chroot True [FilesystemContained]
    282 
    283 	-- Use nsenter to enter container and and run propellor to
    284 	-- finish provisioning.
    285 	containerprovisioned :: RevertableProperty Linux Linux
    286 	containerprovisioned =
    287 		tightenTargets (Chroot.propellChroot chroot (enterContainerProcess c) False containercaps)
    288 			<!>
    289 		doNothing
    290 
    291 	containercaps = 
    292 		[ FilesystemContained
    293 		, HostnameContained
    294 		]
    295 
    296 	chroot = Chroot.Chroot loc builder Chroot.propagateChrootInfo h
    297 
    298 -- | Sets up the service files for the container, using the
    299 -- systemd-nspawn@.service template, and starts it running.
    300 nspawnService :: Container -> ChrootCfg -> RevertableProperty Linux Linux
    301 nspawnService (Container name _ _) cfg = setup <!> teardown
    302   where
    303 	service = nspawnServiceName name
    304 	overridedir = "/etc/systemd/system" </> nspawnServiceName name ++ ".d"
    305 	overridefile = overridedir </> "local.conf"
    306 	overridecontent = 
    307 		[ "[Service]"
    308 		, "# Reset ExecStart from the template"
    309 		, "ExecStart="
    310 		, "ExecStart=/usr/bin/systemd-nspawn " ++ unwords nspawnparams
    311 		]
    312 	nspawnparams = 
    313 		[ "--quiet"
    314 		, "--keep-unit"
    315 		, "--boot"
    316 		, "--directory=" ++ containerDir name
    317 		, "--machine=" ++ name
    318 		] ++ nspawnServiceParams cfg
    319 
    320 	overrideconfigured = File.hasContent overridefile overridecontent
    321 		`onChange` daemonReloaded
    322 		`requires` File.dirExists overridedir
    323 
    324 	setup :: Property Linux
    325 	setup = started service
    326 		`requires` enabled service
    327 		`requires` overrideconfigured
    328 		`requires` machined
    329 
    330 	teardown :: Property Linux
    331 	teardown = stopped service
    332 		`before` disabled service
    333 		`before` File.notPresent overridefile
    334 
    335 nspawnServiceParams :: ChrootCfg -> [String]
    336 nspawnServiceParams NoChrootCfg = []
    337 nspawnServiceParams (SystemdNspawnCfg ps) =
    338 	M.keys $ M.filter id $ M.fromList ps
    339 
    340 -- | Installs a "enter-machinename" script that root can use to run a
    341 -- command inside the container.
    342 --
    343 -- This uses nsenter to enter the container, by looking up the pid of the
    344 -- container's init process and using its namespace.
    345 enterScript :: Container -> RevertableProperty Linux Linux
    346 enterScript c@(Container name _ _) =
    347 	tightenTargets setup <!> tightenTargets teardown
    348   where
    349 	setup = combineProperties ("generated " ++ enterScriptFile c) $ props
    350 		& scriptfile `File.hasContent`
    351 			[ "#!/usr/bin/perl"
    352 			, "# Generated by propellor"
    353 			, "my $pid=`machinectl show " ++ shellEscape name ++ " -p Leader | cut -d= -f2`;"
    354 			, "chomp $pid;"
    355 			, "if (length $pid) {"
    356 			, "\tforeach my $var (keys %ENV) {"
    357 			, "\t\tdelete $ENV{$var} unless $var eq 'PATH' || $var eq 'TERM';"
    358 			, "\t}"
    359 			, "\texec('nsenter', '-p', '-u', '-n', '-i', '-m', '-t', $pid, @ARGV);"
    360 			, "} else {"
    361 			, "\tdie 'container not running';"
    362 			, "}"
    363 			, "exit(1);"
    364 			]
    365 		& scriptfile `File.mode` combineModes (readModes ++ executeModes)
    366 	teardown = File.notPresent scriptfile
    367 	scriptfile = enterScriptFile c
    368 
    369 enterScriptFile :: Container -> FilePath
    370 enterScriptFile (Container name _ _ ) = "/usr/local/bin/enter-" ++ mungename name
    371 
    372 enterContainerProcess :: Container -> [String] -> IO (CreateProcess, IO ())
    373 enterContainerProcess c ps = pure (proc (enterScriptFile c) ps, noop)
    374 
    375 nspawnServiceName :: MachineName -> ServiceName
    376 nspawnServiceName name = "systemd-nspawn@" ++ name ++ ".service"
    377 
    378 containerDir :: MachineName -> FilePath
    379 containerDir name = "/var/lib/container" </> mungename name
    380 
    381 mungename :: MachineName -> String
    382 mungename = replace "/" "_"
    383 
    384 -- | This configures how systemd-nspawn(1) starts the container,
    385 -- by specifying a parameter, such as "--private-network", or
    386 -- "--link-journal=guest"
    387 --
    388 -- When there is no leading dash, "--" is prepended to the parameter.
    389 --
    390 -- Reverting the property will remove a parameter, if it's present.
    391 containerCfg :: String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
    392 containerCfg p = RevertableProperty (mk True) (mk False)
    393   where
    394 	mk :: Bool -> Property (HasInfo + Linux)
    395 	mk b = tightenTargets $
    396 		pureInfoProperty desc $
    397 			mempty { _chrootCfg = SystemdNspawnCfg [(p', b)] }
    398 	  where
    399 		desc = "container configuration " ++ (if b then "" else "without ") ++ p'
    400 	p' = case p of
    401 		('-':_) -> p
    402 		_ -> "--" ++ p
    403 
    404 -- | Bind mounts </etc/resolv.conf> from the host into the container.
    405 --
    406 -- This property is enabled by default. Revert it to disable it.
    407 resolvConfed :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
    408 resolvConfed = containerCfg "bind=/etc/resolv.conf"
    409 
    410 -- | Link the container's journal to the host's if possible.
    411 -- (Only works if the host has persistent journal enabled.)
    412 --
    413 -- This property is enabled by default. Revert it to disable it.
    414 linkJournal :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
    415 linkJournal = containerCfg "link-journal=try-guest"
    416 
    417 -- | Disconnect networking of the container from the host.
    418 privateNetwork :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
    419 privateNetwork = containerCfg "private-network"
    420 
    421 class Publishable a where
    422 	toPublish :: a -> String
    423 
    424 instance Publishable Port where
    425 	toPublish port = val port
    426 
    427 instance Publishable (Bound Port) where
    428 	toPublish v = toPublish (hostSide v) ++ ":" ++ toPublish (containerSide v)
    429 
    430 data Proto = TCP | UDP
    431 
    432 instance Publishable (Proto, Bound Port) where
    433 	toPublish (TCP, fp) = "tcp:" ++ toPublish fp
    434 	toPublish (UDP, fp) = "udp:" ++ toPublish fp
    435 
    436 -- | Publish a port from the container to the host.
    437 --
    438 -- This feature was first added in systemd version 220.
    439 --
    440 -- This property is only needed (and will only work) if the container
    441 -- is configured to use private networking. Also, networkd should be enabled
    442 -- both inside the container, and on the host. For example:
    443 --
    444 -- > foo :: Host
    445 -- > foo = host "foo.example.com"
    446 -- >	& Systemd.nspawned webserver
    447 -- > 		`requires` Systemd.running Systemd.networkd
    448 -- >
    449 -- > webserver :: Systemd.container
    450 -- > webserver = Systemd.container "webserver" (Chroot.debootstrapped mempty)
    451 -- >	& os (System (Debian Testing) X86_64)
    452 -- >	& Systemd.privateNetwork
    453 -- >	& Systemd.running Systemd.networkd
    454 -- >	& Systemd.publish (Port 80 ->- Port 8080)
    455 -- >	& Apt.installedRunning "apache2"
    456 publish :: Publishable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
    457 publish p = containerCfg $ "--port=" ++ toPublish p
    458 
    459 class Bindable a where
    460 	toBind :: a -> String
    461 
    462 instance Bindable FilePath where
    463 	toBind f = f
    464 
    465 instance Bindable (Bound FilePath) where
    466 	toBind v = hostSide v ++ ":" ++ containerSide v
    467 
    468 -- | Bind mount a file or directory from the host into the container.
    469 bind :: Bindable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
    470 bind p = containerCfg $ "--bind=" ++ toBind p
    471 
    472 -- | Read-only mind mount.
    473 bindRo :: Bindable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
    474 bindRo p = containerCfg $ "--bind-ro=" ++ toBind p
    475 
    476 -- | Escapes a path for inclusion in a systemd unit name,
    477 -- the same as systemd-escape does.
    478 escapePath :: FilePath -> String
    479 escapePath = concatMap escape 
    480 	. dropWhile (== '/')
    481 	. reverse . dropWhile (== '/') . reverse
    482   where
    483 	escape '/' = "-"
    484 	escape c
    485 		| ((isAscii c && isAlphaNum c) || c == '_') = [c]
    486 		| otherwise = '\\' : 'x' : printf "%x" c