From 0375288f012cf17b3f709f1e98bde24c3d1f97a7 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Jun 2016 16:14:59 +0900 Subject: Ccache.hasCache chmods cache root setgid This should fix . Thank you to Fred Picca for reporting and then also finding a fix for the problem. --- src/Propellor/Property/Ccache.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs index 34ed6761..a573cf63 100644 --- a/src/Propellor/Property/Ccache.hs +++ b/src/Propellor/Property/Ccache.hs @@ -95,8 +95,11 @@ 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 + ]) & hasLimits path limit delete = check (doesDirectoryExist path) $ -- cgit v1.2.3 From 45ad7a24d219794a093ccea8ed7914889d86183d Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Jun 2016 16:43:35 +0900 Subject: ensure that sbuild aliases line not duplicated --- src/Propellor/Property/Sbuild.hs | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 50825a0c..0ef85dcf 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -154,11 +154,19 @@ 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" @@ -172,6 +180,8 @@ 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 -- cgit v1.2.3 From 1db615375455598fb0fbe2b7db5c658769dad3b3 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Jun 2016 19:16:14 +0900 Subject: when on Jessie, work around #792100 --- src/Propellor/Property/Sbuild.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 0ef85dcf..7c98782a 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -326,12 +326,22 @@ usableBy u = User.hasGroup u (Group "sbuild") `requires` installed keypairGenerated :: Property DebianLike keypairGenerated = check (not <$> doesFileExist secKeyFile) $ go `requires` installed + `requires` workAround792100 where go :: Property DebianLike go = tightenTargets $ cmdProperty "sbuild-update" ["--keygen"] `assume` MadeChange + -- work around Debian bug #792100 which is present in Jessie + workAround792100 :: Property UnixLike + workAround792100 = property' "work around #792100" $ \w -> do + maybeOS <- getOS + case maybeOS of + Just (System (Debian _ (Stable "jessie")) _) -> + ensureProperty w $ File.dirExists "/root/.gnupg" + _ -> return NoChange + secKeyFile :: FilePath secKeyFile = "/var/lib/sbuild/apt-keys/sbuild-key.sec" -- cgit v1.2.3 From 874f2d0614639aaef6ac146f9878574ba855a90b Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Jun 2016 19:18:50 +0900 Subject: simplify #792100 workaround --- src/Propellor/Property/Sbuild.hs | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 7c98782a..2c01e419 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -334,13 +334,9 @@ keypairGenerated = check (not <$> doesFileExist secKeyFile) $ go `assume` MadeChange -- work around Debian bug #792100 which is present in Jessie + -- since this is a harmless mkdir, don't actually check the OS workAround792100 :: Property UnixLike - workAround792100 = property' "work around #792100" $ \w -> do - maybeOS <- getOS - case maybeOS of - Just (System (Debian _ (Stable "jessie")) _) -> - ensureProperty w $ File.dirExists "/root/.gnupg" - _ -> return NoChange + workAround792100 = File.dirExists "/root/.gnupg" secKeyFile :: FilePath secKeyFile = "/var/lib/sbuild/apt-keys/sbuild-key.sec" -- cgit v1.2.3 From a48c09f560ffa3eee0ef14bcc54190ee41c111c1 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Jun 2016 19:46:34 +0900 Subject: improve Sbuild.hs haddock - Suggest install autopkgtest to get adt-run(1) - Easier to understand ordering of functions - Fix hyperlinks to functions - Using @ around paths containing slashes gets interpreted wrongly --- src/Propellor/Property/Sbuild.hs | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 2c01e419..63b76bdf 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, @@ -99,8 +99,9 @@ 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 +-- 'Propellor.Property.Sbuild.built', allowing the user to identify the +-- schroot and distribution using the 'System' type builtFor :: System -> RevertableProperty DebianLike UnixLike builtFor sys = go deleted where @@ -184,8 +185,9 @@ built s@(SbuildSchroot suite arch) mirror = -- | 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 +-- 'Propellor.Property.Sbuild.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 @@ -235,10 +237,10 @@ 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 +-- 'Propellor.Property.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. piupartsConfFor :: System -> Property DebianLike piupartsConfFor sys = property' ("piuparts schroot conf for " ++ show sys) $ \w -> case (schrootFromSystem sys, stdMirror sys) of @@ -251,11 +253,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 +-- 'Propellor.Property.Sbuild.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 @@ -301,7 +303,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 -- cgit v1.2.3 From 9b50bf8f052c1fe48af1b48c023faa1c1f2fb273 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Jun 2016 19:51:24 +0900 Subject: further simplify #792100 workaround --- src/Propellor/Property/Sbuild.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 63b76bdf..1c1b45b3 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -328,18 +328,15 @@ usableBy u = User.hasGroup u (Group "sbuild") `requires` installed keypairGenerated :: Property DebianLike keypairGenerated = check (not <$> doesFileExist secKeyFile) $ go `requires` installed - `requires` workAround792100 + -- 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 $ cmdProperty "sbuild-update" ["--keygen"] `assume` MadeChange - -- work around Debian bug #792100 which is present in Jessie - -- since this is a harmless mkdir, don't actually check the OS - workAround792100 :: Property UnixLike - workAround792100 = File.dirExists "/root/.gnupg" - secKeyFile :: FilePath secKeyFile = "/var/lib/sbuild/apt-keys/sbuild-key.sec" -- cgit v1.2.3 From 19c3774b801ea3c33b6dde61dbea9072bbf03129 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Jun 2016 20:26:10 +0900 Subject: shorten haddock hyperlinks --- src/Propellor/Property/Sbuild.hs | 21 +++++++++------------ 1 file changed, 9 insertions(+), 12 deletions(-) diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 1c1b45b3..28450f5a 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -99,9 +99,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 --- 'Propellor.Property.Sbuild.built', 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 @@ -185,9 +184,8 @@ built s@(SbuildSchroot suite arch) mirror = -- | Ensure that an sbuild schroot's packages and apt indexes are updated -- --- This function is a convenience wrapper around --- 'Propellor.Property.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 @@ -237,10 +235,9 @@ fixConfFile s@(SbuildSchroot suite arch) = -- | Create a corresponding schroot config file for use with piuparts -- --- This function is a convenience wrapper around --- 'Propellor.Property.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 @@ -253,8 +250,8 @@ piupartsConfFor sys = property' ("piuparts schroot conf for " ++ show sys) $ -- -- This is useful because: -- --- - piuparts will clear out the apt cache which makes --- 'Propellor.Property.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 -- cgit v1.2.3 From cb6503bfa32365b96a6b676eb4d0074df2601554 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Jun 2016 20:27:15 +0900 Subject: Joey's Schroot.useOverlays info property --- src/Propellor/Property/Schroot.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/Propellor/Property/Schroot.hs b/src/Propellor/Property/Schroot.hs index c53ce4f1..0e683562 100644 --- a/src/Propellor/Property/Schroot.hs +++ b/src/Propellor/Property/Schroot.hs @@ -3,11 +3,27 @@ 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) + +-- | 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. -- -- cgit v1.2.3 From 1a84be997bd9bacc632b0965f965557f7c10e686 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Jun 2016 20:27:28 +0900 Subject: Schroot.overlaysInTmpfs sets Schroot.useOverlays --- src/Propellor/Property/Schroot.hs | 47 +++++++++++++++++++++------------------ 1 file changed, 25 insertions(+), 22 deletions(-) diff --git a/src/Propellor/Property/Schroot.hs b/src/Propellor/Property/Schroot.hs index 0e683562..0e52f1a4 100644 --- a/src/Propellor/Property/Schroot.hs +++ b/src/Propellor/Property/Schroot.hs @@ -27,32 +27,35 @@ usesOverlays = isJust . fromInfoVal -- | 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 . -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"] -- cgit v1.2.3 From 3543f151201fcf10906716dca4ad470bda818295 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Jun 2016 20:41:06 +0900 Subject: Reboot.toKernelNewerThan FailedChange not error See discussion: --- src/Propellor/Property/Reboot.hs | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) 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" -- cgit v1.2.3 From 4f7ff2b1bd6d5e491fa306d6e58db593d4b202c9 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Jun 2016 20:45:49 +0900 Subject: Sbuild.built conditionally reboots to new kernel --- src/Propellor/Property/Sbuild.hs | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 28450f5a..5d58a84a 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -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 @@ -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 @@ -171,6 +174,21 @@ built s@(SbuildSchroot suite arch) mirror = 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")) -- cgit v1.2.3 From d31650d667a35808051dab6db1daf3ae1f905b57 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Jun 2016 20:57:40 +0900 Subject: fix Propellor.Types.Exception for GHC 7.6.3 --- src/Propellor/Types/Exception.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Propellor/Types/Exception.hs b/src/Propellor/Types/Exception.hs index 3a810d55..acefc9ec 100644 --- a/src/Propellor/Types/Exception.hs +++ b/src/Propellor/Types/Exception.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveDataTypeable #-} + module Propellor.Types.Exception where import Data.Typeable -- cgit v1.2.3 From ffcf9ca8c438a7f3a5f12623859199b5b12b6255 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Jun 2016 20:59:03 +0900 Subject: fix Propellor/Exception.hs for GHC 7.6.3 --- src/Propellor/Exception.hs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/Propellor/Exception.hs b/src/Propellor/Exception.hs index 3ab783bf..c02fa61a 100644 --- a/src/Propellor/Exception.hs +++ b/src/Propellor/Exception.hs @@ -10,10 +10,15 @@ import Utility.Exception import Control.Exception (AsyncException) import Control.Monad.Catch import Control.Monad.IO.Class (MonadIO) +import Control.Applicative +import Prelude -- | Catches all exceptions (except for `StopPropellorException` and -- `AsyncException`) and returns FailedChange. -catchPropellor :: (MonadIO m, MonadCatch m) => m Result -> m Result +catchPropellor + :: (Applicative m, MonadIO m, MonadCatch m) + => m Result + -> m Result catchPropellor a = either err return =<< tryPropellor a where err e = warningMessage (show e) >> return FailedChange @@ -27,5 +32,8 @@ catchPropellor' a onerr = a `catches` -- | Catches all exceptions (except for `StopPropellorException` and -- `AsyncException`). -tryPropellor :: MonadCatch m => m a -> m (Either SomeException a) +tryPropellor + :: (Functor m, Applicative m, MonadCatch m) + => m a + -> m (Either SomeException a) tryPropellor a = (Right <$> a) `catchPropellor'` (pure . Left) -- cgit v1.2.3 From d436af8f42e05272e369af3f69a65bac157db725 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Jun 2016 21:06:19 +0900 Subject: Typeable in Schroot.hs --- src/Propellor/Property/Schroot.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Propellor/Property/Schroot.hs b/src/Propellor/Property/Schroot.hs index 0e52f1a4..bb20f6e6 100644 --- a/src/Propellor/Property/Schroot.hs +++ b/src/Propellor/Property/Schroot.hs @@ -1,5 +1,7 @@ -- | Maintainer: Sean Whitton +{-# LANGUAGE DeriveDataTypeable #-} + module Propellor.Property.Schroot where import Propellor.Base @@ -9,7 +11,7 @@ import qualified Propellor.Property.Apt as Apt import Utility.FileMode -data UseOverlays = UseOverlays deriving (Eq, Show) +data UseOverlays = UseOverlays deriving (Eq, Show, Typeable) -- | Indicate that a schroots on a host should use @union-type=overlay@ -- -- cgit v1.2.3 From cde491e5767caca7bf10bca16d625e713ba24a9b Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Jun 2016 22:04:31 +0900 Subject: docs on property ordering --- src/Propellor/Property/Sbuild.hs | 2 +- src/Propellor/Property/Schroot.hs | 15 ++++++++++++++- 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 5d58a84a..bb1a2a0a 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -9,12 +9,12 @@ Build and maintain schroots for use with sbuild. Suggested usage in @config.hs@: > & Apt.installed ["piuparts", "autopkgtest"] +> & Schroot.overlaysInTmpfs > & Sbuild.builtFor (System (Debian Unstable) X86_32) > & Sbuild.piupartsConfFor (System (Debian Unstable) X86_32) > & Sbuild.updatedFor (System (Debian Unstable) X86_32) `period` Weekly 1 > & Sbuild.usableBy (User "spwhitton") > & Sbuild.shareAptCache -> & Schroot.overlaysInTmpfs In @~/.sbuildrc@: diff --git a/src/Propellor/Property/Schroot.hs b/src/Propellor/Property/Schroot.hs index bb20f6e6..20c98e60 100644 --- a/src/Propellor/Property/Schroot.hs +++ b/src/Propellor/Property/Schroot.hs @@ -18,6 +18,17 @@ data UseOverlays = UseOverlays deriving (Eq, Show, Typeable) -- 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. +-- +-- You should apply this property to a host before any properties that can use +-- overlays. For example, use +-- +-- > & Schroot.useOverlays +-- > & Sbuild.builtFor (System (Debian Unstable) X86_32) +-- +-- rather than +-- +-- > & Sbuild.builtFor (System (Debian Unstable) X86_32) +-- > & Schroot.useOverlays useOverlays :: Property (HasInfo + UnixLike) useOverlays = pureInfoProperty "use schroot overlays" (InfoVal UseOverlays) @@ -29,7 +40,9 @@ usesOverlays = isJust . fromInfoVal -- | 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. +-- Implicitly sets 'useOverlays' info property. Like that property, you should +-- apply 'overlaysInTmpfs' to a host before applying any properties that can use +-- overlays (e.g. 'Propellor.Property.Sbuild.built'). -- -- Shell script from . overlaysInTmpfs :: Property (HasInfo + DebianLike) -- cgit v1.2.3 From e80e610443f10ce128e5d0e9e94cff83e267f3cc Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 21 Jun 2016 17:50:37 +0900 Subject: fix permissions of ccache on upgrade from 3.0.5 --- src/Propellor/Property/Ccache.hs | 33 ++++++++++++++++++++++++++++----- 1 file changed, 28 insertions(+), 5 deletions(-) diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs index a573cf63..54d84279 100644 --- a/src/Propellor/Property/Ccache.hs +++ b/src/Propellor/Property/Ccache.hs @@ -95,17 +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 - , setGroupIDMode - ]) + 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 -- cgit v1.2.3 From 9ae2b69b2a388fdb9d18f64f4a813089768c0d69 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 21 Jun 2016 18:01:57 +0900 Subject: Revert "docs on property ordering" This reverts commit cde491e5767caca7bf10bca16d625e713ba24a9b. --- src/Propellor/Property/Sbuild.hs | 2 +- src/Propellor/Property/Schroot.hs | 15 +-------------- 2 files changed, 2 insertions(+), 15 deletions(-) diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index bb1a2a0a..5d58a84a 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -9,12 +9,12 @@ Build and maintain schroots for use with sbuild. Suggested usage in @config.hs@: > & Apt.installed ["piuparts", "autopkgtest"] -> & Schroot.overlaysInTmpfs > & Sbuild.builtFor (System (Debian Unstable) X86_32) > & Sbuild.piupartsConfFor (System (Debian Unstable) X86_32) > & Sbuild.updatedFor (System (Debian Unstable) X86_32) `period` Weekly 1 > & Sbuild.usableBy (User "spwhitton") > & Sbuild.shareAptCache +> & Schroot.overlaysInTmpfs In @~/.sbuildrc@: diff --git a/src/Propellor/Property/Schroot.hs b/src/Propellor/Property/Schroot.hs index 20c98e60..bb20f6e6 100644 --- a/src/Propellor/Property/Schroot.hs +++ b/src/Propellor/Property/Schroot.hs @@ -18,17 +18,6 @@ data UseOverlays = UseOverlays deriving (Eq, Show, Typeable) -- 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. --- --- You should apply this property to a host before any properties that can use --- overlays. For example, use --- --- > & Schroot.useOverlays --- > & Sbuild.builtFor (System (Debian Unstable) X86_32) --- --- rather than --- --- > & Sbuild.builtFor (System (Debian Unstable) X86_32) --- > & Schroot.useOverlays useOverlays :: Property (HasInfo + UnixLike) useOverlays = pureInfoProperty "use schroot overlays" (InfoVal UseOverlays) @@ -40,9 +29,7 @@ usesOverlays = isJust . fromInfoVal -- | 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. Like that property, you should --- apply 'overlaysInTmpfs' to a host before applying any properties that can use --- overlays (e.g. 'Propellor.Property.Sbuild.built'). +-- Implicitly sets 'useOverlays' info property. -- -- Shell script from . overlaysInTmpfs :: Property (HasInfo + DebianLike) -- cgit v1.2.3 From 522751f8b297976932b6454bb6d974e1bb5c3049 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 21 Jun 2016 18:03:56 +0900 Subject: Revert "fix Propellor/Exception.hs for GHC 7.6.3" This reverts commit ffcf9ca8c438a7f3a5f12623859199b5b12b6255. Félix fixed this more comprehensively. --- src/Propellor/Exception.hs | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/src/Propellor/Exception.hs b/src/Propellor/Exception.hs index c02fa61a..3ab783bf 100644 --- a/src/Propellor/Exception.hs +++ b/src/Propellor/Exception.hs @@ -10,15 +10,10 @@ import Utility.Exception import Control.Exception (AsyncException) import Control.Monad.Catch import Control.Monad.IO.Class (MonadIO) -import Control.Applicative -import Prelude -- | Catches all exceptions (except for `StopPropellorException` and -- `AsyncException`) and returns FailedChange. -catchPropellor - :: (Applicative m, MonadIO m, MonadCatch m) - => m Result - -> m Result +catchPropellor :: (MonadIO m, MonadCatch m) => m Result -> m Result catchPropellor a = either err return =<< tryPropellor a where err e = warningMessage (show e) >> return FailedChange @@ -32,8 +27,5 @@ catchPropellor' a onerr = a `catches` -- | Catches all exceptions (except for `StopPropellorException` and -- `AsyncException`). -tryPropellor - :: (Functor m, Applicative m, MonadCatch m) - => m a - -> m (Either SomeException a) +tryPropellor :: MonadCatch m => m a -> m (Either SomeException a) tryPropellor a = (Right <$> a) `catchPropellor'` (pure . Left) -- cgit v1.2.3 From 632c2bb3639d043d7d9101b6fd2f198e6ac8cd8f Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 21 Jun 2016 18:04:15 +0900 Subject: Revert "fix Propellor.Types.Exception for GHC 7.6.3" This reverts commit d31650d667a35808051dab6db1daf3ae1f905b57. Félix fixed this more comprehensively. --- src/Propellor/Types/Exception.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/Propellor/Types/Exception.hs b/src/Propellor/Types/Exception.hs index acefc9ec..3a810d55 100644 --- a/src/Propellor/Types/Exception.hs +++ b/src/Propellor/Types/Exception.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} - module Propellor.Types.Exception where import Data.Typeable -- cgit v1.2.3