summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Systemd.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property/Systemd.hs')
-rw-r--r--src/Propellor/Property/Systemd.hs164
1 files changed, 96 insertions, 68 deletions
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 2234ad5c..e5441817 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, TypeFamilies #-}
module Propellor.Property.Systemd (
-- * Services
@@ -25,6 +25,7 @@ module Propellor.Property.Systemd (
MachineName,
Container,
container,
+ debContainer,
nspawned,
-- * Container configuration
containerCfg,
@@ -43,6 +44,7 @@ module Propellor.Property.Systemd (
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
@@ -61,23 +63,23 @@ 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
+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)
-- | Starts a systemd service.
--
-- Note that this does not configure systemd to start the service on boot,
-- it only ensures that the service is currently running.
-started :: ServiceName -> Property NoInfo
-started n = cmdProperty "systemctl" ["start", n]
+started :: ServiceName -> Property Linux
+started n = tightenTargets $ cmdProperty "systemctl" ["start", n]
`assume` NoChange
`describe` ("service " ++ n ++ " started")
-- | Stops a systemd service.
-stopped :: ServiceName -> Property NoInfo
-stopped n = cmdProperty "systemctl" ["stop", n]
+stopped :: ServiceName -> Property Linux
+stopped n = tightenTargets $ cmdProperty "systemctl" ["stop", n]
`assume` NoChange
`describe` ("service " ++ n ++ " stopped")
@@ -85,35 +87,35 @@ stopped n = cmdProperty "systemctl" ["stop", n]
--
-- This does not ensure the service is started, it only configures systemd
-- to start it on boot.
-enabled :: ServiceName -> Property NoInfo
-enabled n = cmdProperty "systemctl" ["enable", n]
+enabled :: ServiceName -> Property Linux
+enabled n = tightenTargets $ cmdProperty "systemctl" ["enable", n]
`assume` NoChange
`describe` ("service " ++ n ++ " enabled")
-- | Disables a systemd service.
-disabled :: ServiceName -> Property NoInfo
-disabled n = cmdProperty "systemctl" ["disable", n]
+disabled :: ServiceName -> Property Linux
+disabled n = tightenTargets $ cmdProperty "systemctl" ["disable", n]
`assume` NoChange
`describe` ("service " ++ n ++ " disabled")
-- | Masks a systemd service.
-masked :: ServiceName -> RevertableProperty NoInfo
+masked :: ServiceName -> RevertableProperty Linux Linux
masked n = systemdMask <!> systemdUnmask
where
- systemdMask = cmdProperty "systemctl" ["mask", n]
+ systemdMask = tightenTargets $ cmdProperty "systemctl" ["mask", n]
`assume` NoChange
`describe` ("service " ++ n ++ " masked")
- systemdUnmask = cmdProperty "systemctl" ["unmask", n]
+ systemdUnmask = tightenTargets $ cmdProperty "systemctl" ["unmask", n]
`assume` NoChange
`describe` ("service " ++ n ++ " unmasked")
-- | Ensures that a service is both enabled and started
-running :: ServiceName -> Property NoInfo
+running :: ServiceName -> Property Linux
running n = started n `requires` enabled n
-- | Restarts a systemd service.
-restarted :: ServiceName -> Property NoInfo
-restarted n = cmdProperty "systemctl" ["restart", n]
+restarted :: ServiceName -> Property Linux
+restarted n = tightenTargets $ cmdProperty "systemctl" ["restart", n]
`assume` NoChange
`describe` ("service " ++ n ++ " restarted")
@@ -126,16 +128,15 @@ journald :: ServiceName
journald = "systemd-journald"
-- | Enables persistent storage of the journal.
-persistentJournal :: Property NoInfo
+persistentJournal :: Property DebianLike
persistentJournal = check (not <$> doesDirectoryExist dir) $
- combineProperties "persistent systemd journal"
- [ cmdProperty "install" ["-d", "-g", "systemd-journal", dir]
+ combineProperties "persistent systemd journal" $ props
+ & cmdProperty "install" ["-d", "-g", "systemd-journal", dir]
`assume` MadeChange
- , cmdProperty "setfacl" ["-R", "-nm", "g:adm:rx,d:g:adm:rx", dir]
+ & Apt.installed ["acl"]
+ & cmdProperty "setfacl" ["-R", "-nm", "g:adm:rx,d:g:adm:rx", dir]
`assume` MadeChange
- , started "systemd-journal-flush"
- ]
- `requires` Apt.installed ["acl"]
+ & started "systemd-journal-flush"
where
dir = "/var/log/journal"
@@ -148,11 +149,10 @@ type Option = String
-- currently the case for files like journald.conf and system.conf.
-- And it assumes the file already exists with
-- the right [Header], so new lines can just be appended to the end.
-configured :: FilePath -> Option -> String -> Property NoInfo
-configured cfgfile option value = combineProperties desc
- [ File.fileProperty desc (mapMaybe removeother) cfgfile
- , File.containsLine cfgfile line
- ]
+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
@@ -162,43 +162,60 @@ configured cfgfile option value = combineProperties desc
| otherwise = Just l
-- | Causes systemd to reload its configuration files.
-daemonReloaded :: Property NoInfo
-daemonReloaded = cmdProperty "systemctl" ["daemon-reload"]
+daemonReloaded :: Property Linux
+daemonReloaded = tightenTargets $ cmdProperty "systemctl" ["daemon-reload"]
`assume` NoChange
-- | Configures journald, restarting it so the changes take effect.
-journaldConfigured :: Option -> String -> Property NoInfo
+journaldConfigured :: Option -> String -> Property Linux
journaldConfigured option value =
configured "/etc/systemd/journald.conf" option value
`onChange` restarted journald
-- | Ensures machined and machinectl are installed
-machined :: Property NoInfo
-machined = withOS "machined installed" $ \o ->
+machined :: Property Linux
+machined = withOS "machined installed" $ \w o ->
case o of
-- Split into separate debian package since systemd 225.
(Just (System (Debian suite) _))
- | not (isStable suite) -> ensureProperty $
+ | not (isStable suite) -> ensureProperty w $
Apt.installed ["systemd-container"]
_ -> noChange
--- | Defines a container with a given machine name, and operating system,
+-- | Defines a container with a given machine name,
-- and how to create its chroot if not already present.
--
--- Properties can be added to configure the Container.
+-- Properties can be added to configure the Container. At a minimum,
+-- add a property such as `osDebian` to specify the operating system
+-- to bootstrap.
--
--- > container "webserver" (System (Debian Unstable) "amd64") (Chroot.debootstrapped mempty)
+-- > container "webserver" $ \d -> Chroot.debootstrapped mempty d $ props
+-- > & osDebian Unstable "amd64"
-- > & Apt.installedRunning "apache2"
-- > & ...
-container :: MachineName -> System -> (FilePath -> Chroot.Chroot) -> Container
-container name system mkchroot = Container name c h
- & os system
- & resolvConfed
- & linkJournal
+container :: MachineName -> (FilePath -> Chroot.Chroot) -> Container
+container name mkchroot =
+ let c = Container name chroot h
+ in setContainerProps c $ containerProps c
+ &^ resolvConfed
+ &^ linkJournal
where
- c = mkchroot (containerDir name)
- & os system
- h = Host name [] mempty
+ chroot = mkchroot (containerDir name)
+ h = Host name (containerProperties chroot) (containerInfo chroot)
+
+-- | Defines a container with a given machine name, with the chroot
+-- created using debootstrap.
+--
+-- Properties can be added to configure the Container. At a minimum,
+-- add a property such as `osDebian` to specify the operating system
+-- to bootstrap.
+--
+-- > debContainer "webserver" $ props
+-- > & osDebian Unstable "amd64"
+-- > & Apt.installedRunning "apache2"
+-- > & ...
+debContainer :: MachineName -> Props metatypes -> Container
+debContainer name ps = container name $ \d -> Chroot.debootstrapped mempty d ps
-- | Runs a container using systemd-nspawn.
--
@@ -214,13 +231,14 @@ container name system mkchroot = Container name c h
--
-- Reverting this property stops the container, removes the systemd unit,
-- and deletes the chroot and all its contents.
-nspawned :: Container -> RevertableProperty HasInfo
+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 $ getInfo $ hostInfo h)
+ `before` nspawnService c (_chrootCfg $ fromInfo $ hostInfo h)
`before` containerprovisioned
-- Chroot provisioning is run in systemd-only mode,
@@ -230,8 +248,9 @@ nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
-- Use nsenter to enter container and and run propellor to
-- finish provisioning.
+ containerprovisioned :: RevertableProperty Linux Linux
containerprovisioned =
- Chroot.propellChroot chroot (enterContainerProcess c) False
+ tightenTargets (Chroot.propellChroot chroot (enterContainerProcess c) False)
<!>
doNothing
@@ -239,7 +258,7 @@ nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
-- | Sets up the service file for the container, and then starts
-- it running.
-nspawnService :: Container -> ChrootCfg -> RevertableProperty NoInfo
+nspawnService :: Container -> ChrootCfg -> RevertableProperty Linux Linux
nspawnService (Container name _ _) cfg = setup <!> teardown
where
service = nspawnServiceName name
@@ -264,10 +283,12 @@ nspawnService (Container name _ _) cfg = setup <!> teardown
<$> servicefilecontent
<*> catchDefaultIO "" (readFile servicefile)
+ writeservicefile :: Property Linux
writeservicefile = property servicefile $ makeChange $ do
c <- servicefilecontent
File.viaStableTmp (\t -> writeFile t c) servicefile
+ setupservicefile :: Property Linux
setupservicefile = check (not <$> goodservicefile) $
-- if it's running, it has the wrong configuration,
-- so stop it
@@ -275,8 +296,12 @@ nspawnService (Container name _ _) cfg = setup <!> teardown
`requires` daemonReloaded
`requires` writeservicefile
- setup = started service `requires` setupservicefile `requires` machined
+ setup :: Property Linux
+ setup = started service
+ `requires` setupservicefile
+ `requires` machined
+ teardown :: Property Linux
teardown = check (doesFileExist servicefile) $
disabled service `requires` stopped service
@@ -290,11 +315,12 @@ nspawnServiceParams (SystemdNspawnCfg ps) =
--
-- This uses nsenter to enter the container, by looking up the pid of the
-- container's init process and using its namespace.
-enterScript :: Container -> RevertableProperty NoInfo
-enterScript c@(Container name _ _) = setup <!> teardown
+enterScript :: Container -> RevertableProperty Linux Linux
+enterScript c@(Container name _ _) =
+ tightenTargets setup <!> tightenTargets teardown
where
- setup = combineProperties ("generated " ++ enterScriptFile c)
- [ scriptfile `File.hasContent`
+ 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`;"
@@ -309,8 +335,7 @@ enterScript c@(Container name _ _) = setup <!> teardown
, "}"
, "exit(1);"
]
- , scriptfile `File.mode` combineModes (readModes ++ executeModes)
- ]
+ & scriptfile `File.mode` combineModes (readModes ++ executeModes)
teardown = File.notPresent scriptfile
scriptfile = enterScriptFile c
@@ -336,11 +361,14 @@ mungename = replace "/" "_"
-- When there is no leading dash, "--" is prepended to the parameter.
--
-- Reverting the property will remove a parameter, if it's present.
-containerCfg :: String -> RevertableProperty HasInfo
+containerCfg :: String -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
containerCfg p = RevertableProperty (mk True) (mk False)
where
- mk b = pureInfoProperty ("container configuration " ++ (if b then "" else "without ") ++ p') $
- mempty { _chrootCfg = SystemdNspawnCfg [(p', b)] }
+ 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
@@ -348,18 +376,18 @@ containerCfg p = RevertableProperty (mk True) (mk False)
-- | Bind mounts </etc/resolv.conf> from the host into the container.
--
-- This property is enabled by default. Revert it to disable it.
-resolvConfed :: RevertableProperty HasInfo
+resolvConfed :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
resolvConfed = containerCfg "bind=/etc/resolv.conf"
-- | Link the container's journal to the host's if possible.
-- (Only works if the host has persistent journal enabled.)
--
-- This property is enabled by default. Revert it to disable it.
-linkJournal :: RevertableProperty HasInfo
+linkJournal :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
linkJournal = containerCfg "link-journal=try-guest"
-- | Disconnect networking of the container from the host.
-privateNetwork :: RevertableProperty HasInfo
+privateNetwork :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
privateNetwork = containerCfg "private-network"
class Publishable a where
@@ -397,7 +425,7 @@ instance Publishable (Proto, Bound Port) where
-- > & Systemd.running Systemd.networkd
-- > & Systemd.publish (Port 80 ->- Port 8080)
-- > & Apt.installedRunning "apache2"
-publish :: Publishable p => p -> RevertableProperty HasInfo
+publish :: Publishable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
publish p = containerCfg $ "--port=" ++ toPublish p
class Bindable a where
@@ -410,9 +438,9 @@ instance Bindable (Bound FilePath) where
toBind v = hostSide v ++ ":" ++ containerSide v
-- | Bind mount a file or directory from the host into the container.
-bind :: Bindable p => p -> RevertableProperty HasInfo
+bind :: Bindable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
bind p = containerCfg $ "--bind=" ++ toBind p
-- | Read-only mind mount.
-bindRo :: Bindable p => p -> RevertableProperty HasInfo
+bindRo :: Bindable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux)
bindRo p = containerCfg $ "--bind-ro=" ++ toBind p
generated by cgit v1.3-2-g0d8e (git 2.53.0) at 2026-06-14 04:07:23 +0000