diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-06-21 11:08:24 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-06-21 11:08:24 -0400 |
commit | 4db15a017a5defb2721803eae258a425ca74f8e9 (patch) | |
tree | b402311e32dec9156b4990d0beeaf3cf2072e8ef | |
parent | 11f046f41a3f717b52e1f3a9d404427dd06a403e (diff) | |
parent | 632c2bb3639d043d7d9101b6fd2f198e6ac8cd8f (diff) |
Merge remote-tracking branch 'spwhitton/reboot'
-rw-r--r-- | src/Propellor/Property/Ccache.hs | 30 | ||||
-rw-r--r-- | src/Propellor/Property/Reboot.hs | 9 | ||||
-rw-r--r-- | src/Propellor/Property/Sbuild.hs | 70 | ||||
-rw-r--r-- | src/Propellor/Property/Schroot.hs | 65 |
4 files changed, 123 insertions, 51 deletions
diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs index 34ed6761..54d84279 100644 --- a/src/Propellor/Property/Ccache.hs +++ b/src/Propellor/Property/Ccache.hs @@ -95,14 +95,40 @@ group@(Group g) `hasCache` limit = (make `requires` installed) <!> delete & File.dirExists path & File.ownerGroup path (User "root") group & File.mode path (combineModes $ - readModes ++ executeModes - ++ [ownerWriteMode, groupWriteMode]) + readModes ++ executeModes ++ + [ ownerWriteMode + , groupWriteMode + , setGroupIDMode + ]) `onChange` fixSetgidBit + -- ^ we use onChange to catch upgrades from + -- 3.0.5 where the setGroupIDMode line was not + -- present & hasLimits path limit delete = check (doesDirectoryExist path) $ cmdProperty "rm" ["-r", path] `assume` MadeChange `describe` ("ccache for " ++ g ++ " does not exist") + -- Here we deal with a bug in Propellor 3.0.5. If the ccache was + -- created with that version, it will not have the setgid bit set. That + -- means its subdirectories won't have inherited the setgid bit, and + -- then the files in those directories won't be owned by group sbuild. + -- This breaks ccache. + fixSetgidBit :: Property UnixLike + fixSetgidBit = + (cmdProperty "find" + [ path + , "-type", "d" + , "-exec", "chmod", "g+s" + , "{}", "+" + ] `assume` MadeChange) + `before` + (cmdProperty "chown" + [ "-R" + , "root:" ++ g + , path + ] `assume` MadeChange) + path = "/var/cache/ccache-" ++ g installed :: Property DebianLike diff --git a/src/Propellor/Property/Reboot.hs b/src/Propellor/Property/Reboot.hs index 6a0626a2..31731dc2 100644 --- a/src/Propellor/Property/Reboot.hs +++ b/src/Propellor/Property/Reboot.hs @@ -64,7 +64,7 @@ toDistroKernel = check (not <$> runningInstalledKernel) now -- | Given a kernel version string @v@, reboots immediately if the running -- kernel version is strictly less than @v@ and there is an installed kernel --- version is greater than or equal to @v@. Dies if the requested kernel +-- version is greater than or equal to @v@. Fails if the requested kernel -- version is not installed. -- -- For this to be useful, you need to have ensured that the installed kernel @@ -83,12 +83,7 @@ toKernelNewerThan ver = if runningV >= wantV then noChange else if installedV >= wantV then ensureProperty w now - -- Stop propellor here because other - -- properties may be incorrectly ensured - -- under a kernel version that's too old. - -- E.g. Sbuild.built can fail - -- to add the config line `union-type=overlay` - else stopPropellorMessage $ + else errorMessage $ "kernel newer than " ++ ver ++ " not installed" diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 50825a0c..5d58a84a 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -8,7 +8,7 @@ Build and maintain schroots for use with sbuild. Suggested usage in @config.hs@: -> & Apt.installed ["piuparts"] +> & Apt.installed ["piuparts", "autopkgtest"] > & Sbuild.builtFor (System (Debian Unstable) X86_32) > & Sbuild.piupartsConfFor (System (Debian Unstable) X86_32) > & Sbuild.updatedFor (System (Debian Unstable) X86_32) `period` Weekly 1 @@ -56,12 +56,12 @@ sbuild environment as standard as possible. module Propellor.Property.Sbuild ( -- * Creating and updating sbuild schroots SbuildSchroot(..), - builtFor, built, updated, + piupartsConf, + builtFor, updatedFor, piupartsConfFor, - piupartsConf, -- * Global sbuild configuration -- blockNetwork, installed, @@ -79,6 +79,8 @@ import qualified Propellor.Property.Ccache as Ccache import qualified Propellor.Property.ConfFile as ConfFile import qualified Propellor.Property.File as File -- import qualified Propellor.Property.Firewall as Firewall +import qualified Propellor.Property.Schroot as Schroot +import qualified Propellor.Property.Reboot as Reboot import qualified Propellor.Property.User as User import Utility.FileMode @@ -99,8 +101,8 @@ instance Show SbuildSchroot where -- | Build and configure a schroot for use with sbuild using a distribution's -- standard mirror -- --- This function is a convenience wrapper around 'Sbuild.builtFor', allowing the --- user to identify the schroot and distribution using the 'System' type +-- This function is a convenience wrapper around 'built', allowing the user to +-- identify the schroot and distribution using the 'System' type builtFor :: System -> RevertableProperty DebianLike UnixLike builtFor sys = go <!> deleted where @@ -122,7 +124,8 @@ built s@(SbuildSchroot suite arch) mirror = (go `requires` keypairGenerated `requires` ccachePrepared - `requires` installed) + `requires` installed + `requires` overlaysKernel) <!> deleted where go :: Property DebianLike @@ -154,15 +157,38 @@ built s@(SbuildSchroot suite arch) mirror = makeChange $ nukeFile (schrootConf s) -- if we're building a sid chroot, add useful aliases + -- In order to avoid more than one schroot getting the same aliases, we + -- only do this if the arch of the chroot equals the host arch. aliasesLine :: Property UnixLike - aliasesLine = if suite == "unstable" - then File.containsLine (schrootConf s) - "aliases=UNRELEASED,sid,rc-buggy,experimental" - else doNothing + aliasesLine = property' "maybe set aliases line" $ \w -> do + maybeOS <- getOS + case maybeOS of + Nothing -> return NoChange + Just (System _ hostArch) -> + if suite == "unstable" && hostArch == arch + then ensureProperty w $ + schrootConf s `File.containsLine` aliases + else return NoChange + -- enable ccache and eatmydata for speed commandPrefix = File.containsLine (schrootConf s) "command-prefix=/var/cache/ccache-sbuild/sbuild-setup,eatmydata" + -- If the user has indicated that this host should use + -- union-type=overlay schroots, we need to ensure that we have rebooted + -- to a kernel supporting OverlayFS before we execute + -- sbuild-setupchroot(1). Otherwise, sbuild-setupchroot(1) will fail to + -- add the union-type=overlay line to the schroot config. + -- (We could just add that line ourselves, but then sbuild wouldn't work + -- for the user, so we might as well do the reboot for them.) + overlaysKernel :: Property DebianLike + overlaysKernel = property' "reboot for union-type=overlay" $ \w -> + Schroot.usesOverlays >>= \usesOverlays -> + if usesOverlays + then ensureProperty w $ + Reboot.toKernelNewerThan "3.18" + else noChange + -- A failed debootstrap run will leave a debootstrap directory; -- recover by deleting it and trying again. ispartial = ifM (doesDirectoryExist (schrootRoot s </> "debootstrap")) @@ -172,10 +198,12 @@ built s@(SbuildSchroot suite arch) mirror = , return False ) + aliases = "aliases=UNRELEASED,sid,rc-buggy,experimental" + -- | Ensure that an sbuild schroot's packages and apt indexes are updated -- --- This function is a convenience wrapper around 'Sbuild.updated', allowing the --- user to identify the schroot using the 'System' type +-- This function is a convenience wrapper around 'updated', allowing the user to +-- identify the schroot using the 'System' type updatedFor :: System -> Property DebianLike updatedFor system = property' ("updated sbuild schroot for " ++ show system) $ \w -> case schrootFromSystem system of @@ -225,10 +253,9 @@ fixConfFile s@(SbuildSchroot suite arch) = -- | Create a corresponding schroot config file for use with piuparts -- --- This function is a convenience wrapper around 'Sbuild.piupartsConf', allowing --- the user to identify the schroot using the 'System' type. See that --- function's documentation for why you might want to use this property, and --- sample config. +-- This function is a convenience wrapper around 'piupartsConf', allowing the +-- user to identify the schroot using the 'System' type. See that function's +-- documentation for why you might want to use this property, and sample config. piupartsConfFor :: System -> Property DebianLike piupartsConfFor sys = property' ("piuparts schroot conf for " ++ show sys) $ \w -> case (schrootFromSystem sys, stdMirror sys) of @@ -241,11 +268,11 @@ piupartsConfFor sys = property' ("piuparts schroot conf for " ++ show sys) $ -- -- This is useful because: -- --- - piuparts will clear out the apt cache which makes 'Sbuild.shareAptCache' --- much less useful +-- - piuparts will clear out the apt cache which makes 'shareAptCache' much less +-- useful -- -- - piuparts itself invokes eatmydata, so the command-prefix setting in our --- regular schroot config would force the user to pass --no-eatmydata to +-- regular schroot config would force the user to pass @--no-eatmydata@ to -- piuparts in their @~/.sbuildrc@, which is inconvenient. -- -- To make use of this new schroot config, you can put something like this in @@ -291,7 +318,7 @@ piupartsConf s u = go f = schrootPiupartsConf s munge = replace "-sbuild]" "-piuparts]" --- | Bind-mount @/var/cache/apt/archives@ in all sbuild chroots so that the host +-- | Bind-mount /var/cache/apt/archives in all sbuild chroots so that the host -- system and the chroot share the apt cache -- -- This speeds up builds by avoiding unnecessary downloads of build @@ -316,6 +343,9 @@ usableBy u = User.hasGroup u (Group "sbuild") `requires` installed keypairGenerated :: Property DebianLike keypairGenerated = check (not <$> doesFileExist secKeyFile) $ go `requires` installed + -- Work around Debian bug #792100 which is present in Jessie. + -- Since this is a harmless mkdir, don't actually check the OS + `requires` File.dirExists "/root/.gnupg" where go :: Property DebianLike go = tightenTargets $ diff --git a/src/Propellor/Property/Schroot.hs b/src/Propellor/Property/Schroot.hs index c53ce4f1..bb20f6e6 100644 --- a/src/Propellor/Property/Schroot.hs +++ b/src/Propellor/Property/Schroot.hs @@ -1,42 +1,63 @@ -- | Maintainer: Sean Whitton <spwhitton@spwhitton.name> +{-# LANGUAGE DeriveDataTypeable #-} + module Propellor.Property.Schroot where import Propellor.Base +import Propellor.Types.Info import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import Utility.FileMode +data UseOverlays = UseOverlays deriving (Eq, Show, Typeable) + +-- | Indicate that a schroots on a host should use @union-type=overlay@ +-- +-- Setting this property does not actually ensure that the line +-- @union-type=overlay@ is present in any schroot config files. See +-- 'Propellor.Property.Sbuild.built' for example usage. +useOverlays :: Property (HasInfo + UnixLike) +useOverlays = pureInfoProperty "use schroot overlays" (InfoVal UseOverlays) + +-- | Gets whether a host uses overlays. +usesOverlays :: Propellor Bool +usesOverlays = isJust . fromInfoVal + <$> (askInfo :: Propellor (InfoVal UseOverlays)) + -- | Configure schroot such that all schroots with @union-type=overlay@ in their -- configuration will run their overlays in a tmpfs. -- +-- Implicitly sets 'useOverlays' info property. +-- -- Shell script from <https://wiki.debian.org/sbuild>. -overlaysInTmpfs :: Property DebianLike +overlaysInTmpfs :: Property (HasInfo + DebianLike) overlaysInTmpfs = go `requires` installed where f = "/etc/schroot/setup.d/04tmpfs" - go :: Property UnixLike - go = f `File.hasContent` - [ "#!/bin/sh" - , "" - , "set -e" - , "" - , ". \"$SETUP_DATA_DIR/common-data\"" - , ". \"$SETUP_DATA_DIR/common-functions\"" - , ". \"$SETUP_DATA_DIR/common-config\"" - , "" - , "" - , "if [ $STAGE = \"setup-start\" ]; then" - , " mount -t tmpfs overlay /var/lib/schroot/union/overlay" - , "elif [ $STAGE = \"setup-recover\" ]; then" - , " mount -t tmpfs overlay /var/lib/schroot/union/overlay" - , "elif [ $STAGE = \"setup-stop\" ]; then" - , " umount -f /var/lib/schroot/union/overlay" - , "fi" - ] - `onChange` (f `File.mode` (combineModes (readModes ++ executeModes))) - `describe` "schroot overlays in tmpfs" + go :: Property (HasInfo + UnixLike) + go = combineProperties "schroot overlays in tmpfs" $ props + & useOverlays + & f `File.hasContent` + [ "#!/bin/sh" + , "" + , "set -e" + , "" + , ". \"$SETUP_DATA_DIR/common-data\"" + , ". \"$SETUP_DATA_DIR/common-functions\"" + , ". \"$SETUP_DATA_DIR/common-config\"" + , "" + , "" + , "if [ $STAGE = \"setup-start\" ]; then" + , " mount -t tmpfs overlay /var/lib/schroot/union/overlay" + , "elif [ $STAGE = \"setup-recover\" ]; then" + , " mount -t tmpfs overlay /var/lib/schroot/union/overlay" + , "elif [ $STAGE = \"setup-stop\" ]; then" + , " umount -f /var/lib/schroot/union/overlay" + , "fi" + ] + `onChange` (f `File.mode` combineModes (readModes ++ executeModes)) installed :: Property DebianLike installed = Apt.installed ["schroot"] |