From 5a04a37a4239c99b7367f796acee0ba6f1216879 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 27 Mar 2016 16:36:05 -0400 Subject: ported Systemd added mising method in docker --- src/Propellor/Property/Systemd.hs | 121 +++++++++++++++++++++----------------- 1 file changed, 67 insertions(+), 54 deletions(-) (limited to 'src/Propellor/Property/Systemd.hs') diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 7dc1ccd8..eaf7df8b 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 @@ -43,6 +43,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 +62,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 Linux -started n = cmdProperty "systemctl" ["start", n] +started n = tightenTargets $ cmdProperty "systemctl" ["start", n] `assume` NoChange `describe` ("service " ++ n ++ " started") -- | Stops a systemd service. stopped :: ServiceName -> Property Linux -stopped n = cmdProperty "systemctl" ["stop", n] +stopped n = tightenTargets $ cmdProperty "systemctl" ["stop", n] `assume` NoChange `describe` ("service " ++ n ++ " stopped") @@ -86,24 +87,24 @@ 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 Linux -enabled n = cmdProperty "systemctl" ["enable", n] +enabled n = tightenTargets $ cmdProperty "systemctl" ["enable", n] `assume` NoChange `describe` ("service " ++ n ++ " enabled") -- | Disables a systemd service. disabled :: ServiceName -> Property Linux -disabled n = cmdProperty "systemctl" ["disable", n] +disabled n = tightenTargets $ cmdProperty "systemctl" ["disable", n] `assume` NoChange `describe` ("service " ++ n ++ " disabled") -- | Masks a systemd service. -masked :: ServiceName -> RevertableProperty Linux +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") @@ -113,7 +114,7 @@ running n = started n `requires` enabled n -- | Restarts a systemd service. restarted :: ServiceName -> Property Linux -restarted n = cmdProperty "systemctl" ["restart", n] +restarted n = tightenTargets $ cmdProperty "systemctl" ["restart", n] `assume` NoChange `describe` ("service " ++ n ++ " restarted") @@ -128,14 +129,13 @@ journald = "systemd-journald" -- | Enables persistent storage of the journal. 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" @@ -149,10 +149,9 @@ type Option = String -- 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 Linux -configured cfgfile option value = combineProperties desc - [ File.fileProperty desc (mapMaybe removeother) cfgfile - , File.containsLine cfgfile line - ] +configured cfgfile option value = tightenTargets $ combineProperties desc $ props + & File.fileProperty desc (mapMaybe removeother) cfgfile + & File.containsLine cfgfile line where setting = option ++ "=" line = setting ++ value @@ -163,7 +162,7 @@ configured cfgfile option value = combineProperties desc -- | Causes systemd to reload its configuration files. daemonReloaded :: Property Linux -daemonReloaded = cmdProperty "systemctl" ["daemon-reload"] +daemonReloaded = tightenTargets $ cmdProperty "systemctl" ["daemon-reload"] `assume` NoChange -- | Configures journald, restarting it so the changes take effect. @@ -174,30 +173,33 @@ journaldConfigured option value = -- | Ensures machined and machinectl are installed machined :: Property Linux -machined = withOS "machined installed" $ \o -> +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, -- 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" (Chroot.debootstrapped mempty) +-- > & 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 + chroot = mkchroot (containerDir name) h = Host name [] mempty -- | Runs a container using systemd-nspawn. @@ -214,10 +216,11 @@ 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 + UnixLike) UnixLike +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) @@ -230,8 +233,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 +243,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 Linux +nspawnService :: Container -> ChrootCfg -> RevertableProperty Linux Linux nspawnService (Container name _ _) cfg = setup teardown where service = nspawnServiceName name @@ -264,10 +268,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 +281,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 +300,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 Linux -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 +320,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 +346,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 + UnixLike) UnixLike +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 +361,18 @@ containerCfg p = RevertableProperty (mk True) (mk False) -- | Bind mounts from the host into the container. -- -- This property is enabled by default. Revert it to disable it. -resolvConfed :: RevertableProperty (HasInfo + UnixLike) UnixLike +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 + UnixLike) UnixLike +linkJournal :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux) linkJournal = containerCfg "link-journal=try-guest" -- | Disconnect networking of the container from the host. -privateNetwork :: RevertableProperty (HasInfo + UnixLike) UnixLike +privateNetwork :: RevertableProperty (HasInfo + Linux) (HasInfo + Linux) privateNetwork = containerCfg "private-network" class Publishable a where @@ -397,7 +410,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 + UnixLike) UnixLike +publish :: Publishable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux) publish p = containerCfg $ "--port=" ++ toPublish p class Bindable a where @@ -410,9 +423,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 + UnixLike) UnixLike +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 + UnixLike) UnixLike +bindRo :: Bindable p => p -> RevertableProperty (HasInfo + Linux) (HasInfo + Linux) bindRo p = containerCfg $ "--bind-ro=" ++ toBind p -- cgit v1.2.3