From 718c2bb387e83aa05169ff7c09f4600577941b20 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 16 May 2016 10:29:02 -0700 Subject: add Schroot.hs --- src/Propellor/Property/Schroot.hs | 41 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) create mode 100644 src/Propellor/Property/Schroot.hs (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Schroot.hs b/src/Propellor/Property/Schroot.hs new file mode 100644 index 00000000..8e6ce4e6 --- /dev/null +++ b/src/Propellor/Property/Schroot.hs @@ -0,0 +1,41 @@ +-- | Maintainer: Sean Whitton + +module Propellor.Property.Schroot where + +import Propellor.Base +import qualified Propellor.Property.File as File +import qualified Propellor.Property.Apt as Apt + +import Utility.FileMode + +-- | Configure schroot such that all schroots with @union-type=overlay@ in their +-- configuration will run their overlays in a tmpfs. +-- +-- Shell script from . +overlaysInTmpfs :: Property 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))) + +installed :: Property DebianLike +installed = Apt.installed ["schroot"] -- cgit v1.2.3 From 57b6b2c8b57fbc5cd6fc3ebb174c7a343870ea1e Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 16 May 2016 10:48:25 -0700 Subject: add Sbuild.hs --- src/Propellor/Property/Sbuild.hs | 55 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) create mode 100644 src/Propellor/Property/Sbuild.hs (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs new file mode 100644 index 00000000..7739a3bf --- /dev/null +++ b/src/Propellor/Property/Sbuild.hs @@ -0,0 +1,55 @@ +{-| +Maintainer: Sean Whitton + +Build and maintain schroots for use with sbuild. + +Suggested usage in @config.hs@: + +> & Sbuild.built (Debian Unstable) "i386" +> & Sbuild.updated (Debian Unstable) "i386" `period` Weekly +> & Sbuild.usableBy (User "spwhitton") +> & Sbuild.shareAptCache +> & Schroot.overlaysInTmpfs + +In @~/.sbuildrc@: + +> $run_piuparts = 1; +> $piuparts_opts = ['--schroot=unstable-i386-sbuild']; +> +> $external_commands = { +> 'post-build-commands' => [ +> [ +> 'adt-run', +> '--changes', '%c', +> '---', +> 'schroot', 'unstable-i386-sbuild', +> ], +> ], +> }; + +We use @sbuild-createchroot(1)@ to create a chroot to the specification of +@sbuild-setup(7)@. This differs from the approach taken by picca's Sbuild.hs, +which uses 'Propellor.Property.Debootstrap' to construct the chroot. This is to +ensure that the clean package build environment is standardised. +-} + +module Propellor.Property.Sbuild where + +import Propellor.Base +import qualified Propellor.Property.Apt as Apt + +-- | Update a schroot's installed packages and apt indexes. +updated :: System -> Architecture -> Property DebianLike +updated = undefined +-- TODO autoclean/clean only if shareAptCache property not present + +-- | 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 +-- dependencies. +shareAptCache :: Property DebianLike +shareAptCache = undefined + +installed :: Property DebianLike +installed = Apt.installed ["sbuild"] -- cgit v1.2.3 From bf6aac5462f22647bdc49a641cd86feeb4fe2f25 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 16 May 2016 11:15:51 -0700 Subject: comments & fix example --- src/Propellor/Property/Sbuild.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 7739a3bf..80687c7c 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -5,8 +5,8 @@ Build and maintain schroots for use with sbuild. Suggested usage in @config.hs@: -> & Sbuild.built (Debian Unstable) "i386" -> & Sbuild.updated (Debian Unstable) "i386" `period` Weekly +> & Sbuild.built ((Debian Unstable) "i386") +> & Sbuild.updated ((Debian Unstable) "i386") `period` Weekly > & Sbuild.usableBy (User "spwhitton") > & Sbuild.shareAptCache > & Schroot.overlaysInTmpfs @@ -29,10 +29,14 @@ In @~/.sbuildrc@: We use @sbuild-createchroot(1)@ to create a chroot to the specification of @sbuild-setup(7)@. This differs from the approach taken by picca's Sbuild.hs, -which uses 'Propellor.Property.Debootstrap' to construct the chroot. This is to -ensure that the clean package build environment is standardised. +which uses 'Propellor.Property.Debootstrap' to construct the chroot. This is +because we don't want to run propellor inside the chroot in order to keep the +sbuild environment as standardised as possible. -} +-- If you wanted to do it with Propellor.Property.Debootstrap, note that +-- sbuild-createchroot has a relevant option: --setup-only + module Propellor.Property.Sbuild where import Propellor.Base -- cgit v1.2.3 From adc5f3806eacc7a5e5fb409bd1e9da564d8cb5de Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 16 May 2016 14:58:58 -0700 Subject: export extractSuite from Debootstrap.hs --- src/Propellor/Property/Debootstrap.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs index e0c56966..87f30776 100644 --- a/src/Propellor/Property/Debootstrap.hs +++ b/src/Propellor/Property/Debootstrap.hs @@ -3,6 +3,7 @@ module Propellor.Property.Debootstrap ( DebootstrapConfig(..), built, built', + extractSuite, installed, sourceInstall, programPath, -- cgit v1.2.3 From f3379036df361e01b8aea50f26a628b921593d91 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 16 May 2016 14:59:13 -0700 Subject: write some sbuild props --- src/Propellor/Property/Sbuild.hs | 76 +++++++++++++++++++++++++++++++++++++--- 1 file changed, 72 insertions(+), 4 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 80687c7c..58e56239 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -35,25 +35,93 @@ sbuild environment as standardised as possible. -} -- If you wanted to do it with Propellor.Property.Debootstrap, note that --- sbuild-createchroot has a relevant option: --setup-only +-- sbuild-createchroot has a --setup-only option +-- TODO export useful properties only module Propellor.Property.Sbuild where import Propellor.Base +import Debootstrap (extractSuite) import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.File as File + +import System.Directory + +schrootChrootD :: FilePath +schrootChrootD = "/etc/schroot/chroot.d" + +-- | Build and configure a schroot for use with sbuild +built :: System -> Property DebianLike +built system@(System distro arch) = + property' ("built chroot for " ++ show system) $ liftIO $ do + suite <- case extractSuite system of + Just s -> return s + Nothing -> errorMessage $ + "don't know how to debootstrap " ++ show system + de <- standardPathEnv + let params = Param <$> + [ "--arch=" ++ arch + -- We pass --chroot-suffix in order that we can find the + -- config file despite the random suffix that + -- sbuild-createchroot gives it. We'll change this back + -- to 'sbuild' once debootstrap has finished. + , "--chroot-suffix=propellor" + , "/srv/chroot/" ++ suite ++ "-" ++ arch + , stdMirror distro + ] + ifM (boolSystemEnv "sbuild-createchroot" params (Just de)) + ( do + fixConfFile suite arch + return MadeChange + , return FailedChange + ) + +fixConfFile :: String -> Architecture -> IO () +fixConfFile suite arch = do + confs <- dirContents schrootChrootD + let conf = filter (schrootChrootD + suite ++ "-" ++ arch ++ "-propellor-" `isPrefixOf`) + confs + ensureProperty $ File.fileProperty "replace dummy suffix" (map munge) conf + moveFile conf $ + schrootChrootD suite ++ "-" ++ arch ++ "-sbuild-propellor" + where + munge = replace "-propellor]" "-sbuild]" + +stdMirror :: System -> Apt.Url +stdMirror (System (Debian s) _) = "http://httpredir.debian.org/debian" +stdMirror (System (Buntish r) _) = "TODO" -- | Update a schroot's installed packages and apt indexes. -updated :: System -> Architecture -> Property DebianLike +updated :: System -> Property DebianLike updated = undefined -- TODO autoclean/clean only if shareAptCache property not present -- | Bind-mount @/var/cache/apt/archives@ in all sbuild chroots so that the host --- system and the chroot share the apt cache. +-- system and the chroot share the apt cache -- -- This speeds up builds by avoiding unnecessary downloads of build -- dependencies. shareAptCache :: Property DebianLike -shareAptCache = undefined +shareAptCache = File.containsLine "/etc/schroot/sbuild/fstab" + "/var/cache/apt/archives /var/cache/apt/archives none rw,bind 0 0" + `requires` installed +-- | Ensure that sbuild is installed installed :: Property DebianLike installed = Apt.installed ["sbuild"] + +-- | Add an user to the sbuild group in order to use sbuild +usableBy :: User -> Property DebianLike +usableBy u = User.hasGroup u (Group "sbuild") `requires` installed + +-- | Generate the apt keys needed by sbuild +keypairGenerated :: Property DebianLike +keypairGenerated = + check (not <$> doesFileExist secKeyFile) $ go + `requires` installed + where + go :: Property DebianLike + go = tightenTargets $ + cmdProperty "sbuild-update" ["--keygen"] `assume` MadeChange + secKeyFile = "/var/lib/sbuild/apt-keys/sbuild-key.sec" -- cgit v1.2.3 From 3f2854885a1f7618b6e697fa461d9e31eec1697f Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 16 May 2016 15:03:37 -0700 Subject: Sbuild.updated --- src/Propellor/Property/Sbuild.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 58e56239..0f4ebf25 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -94,7 +94,12 @@ stdMirror (System (Buntish r) _) = "TODO" -- | Update a schroot's installed packages and apt indexes. updated :: System -> Property DebianLike -updated = undefined +updated system@(System distro arch) = go `requires` installed + where + go :: Property DebianLike + go = tightenTargets $ cmdProperty + "sbuild-update" ["-udr", suite ++ "-" ++ "arch"] + suite = fromJust $ extractSuite system -- TODO autoclean/clean only if shareAptCache property not present -- | Bind-mount @/var/cache/apt/archives@ in all sbuild chroots so that the host -- cgit v1.2.3 From 30d8ed1558e19d08e18d617633cf0f7878a74078 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 16 May 2016 15:06:37 -0700 Subject: Sbuild.built requires key pair generated --- src/Propellor/Property/Sbuild.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 0f4ebf25..f76aba3c 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -53,7 +53,10 @@ schrootChrootD = "/etc/schroot/chroot.d" -- | Build and configure a schroot for use with sbuild built :: System -> Property DebianLike built system@(System distro arch) = - property' ("built chroot for " ++ show system) $ liftIO $ do + property' ("built chroot for " ++ show system) (liftIO go) + `requires` keypairGenerated + where + go = do suite <- case extractSuite system of Just s -> return s Nothing -> errorMessage $ -- cgit v1.2.3 From 6aea6f7c7c2d9439811e6e5f20b7069fcc05f425 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 16 May 2016 18:15:27 -0700 Subject: install eatmydata and ccache --- src/Propellor/Property/Sbuild.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index f76aba3c..d938f5ce 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -69,6 +69,7 @@ built system@(System distro arch) = -- sbuild-createchroot gives it. We'll change this back -- to 'sbuild' once debootstrap has finished. , "--chroot-suffix=propellor" + , "--include=eatmydata,ccache" , "/srv/chroot/" ++ suite ++ "-" ++ arch , stdMirror distro ] -- cgit v1.2.3 From 363d23e9b84d7411f19a6dd7a77b14ea60b16007 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 16 May 2016 18:35:37 -0700 Subject: tidy up, and Sbuild.built only happens once --- src/Propellor/Property/Sbuild.hs | 38 +++++++++++++++++++++++++------------- 1 file changed, 25 insertions(+), 13 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index d938f5ce..bd43073d 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -47,12 +47,14 @@ import qualified Propellor.Property.File as File import System.Directory -schrootChrootD :: FilePath -schrootChrootD = "/etc/schroot/chroot.d" - -- | Build and configure a schroot for use with sbuild built :: System -> Property DebianLike -built system@(System distro arch) = +built system@(System _ arch) = case extractSuite system of + Just s -> check (not <$> doesDirectoryExist (schrootLoc s arch)) (built' system) + Nothing -> errorMessage "don't know how to debootstrap " ++ show system + +built' :: System -> Property DebianLike +built' system@(System distro arch) = property' ("built chroot for " ++ show system) (liftIO go) `requires` keypairGenerated where @@ -70,7 +72,7 @@ built system@(System distro arch) = -- to 'sbuild' once debootstrap has finished. , "--chroot-suffix=propellor" , "--include=eatmydata,ccache" - , "/srv/chroot/" ++ suite ++ "-" ++ arch + , schrootLocation suite arch , stdMirror distro ] ifM (boolSystemEnv "sbuild-createchroot" params (Just de)) @@ -80,6 +82,11 @@ built system@(System distro arch) = , return FailedChange ) +-- Here we undo our --chroot-suffix=propellor by editing and renaming the config +-- file so that it is as if we had passed --chroot-suffix=sbuild (the default). +-- We replace the random suffix with 'propellor'. The properties in this module +-- only permit the creation of one chroot for a given suite and architecture, so +-- we don't need the random suffix. fixConfFile :: String -> Architecture -> IO () fixConfFile suite arch = do confs <- dirContents schrootChrootD @@ -87,24 +94,18 @@ fixConfFile suite arch = do suite ++ "-" ++ arch ++ "-propellor-" `isPrefixOf`) confs ensureProperty $ File.fileProperty "replace dummy suffix" (map munge) conf - moveFile conf $ - schrootChrootD suite ++ "-" ++ arch ++ "-sbuild-propellor" + moveFile conf (schrootConfLoc suite arch) where munge = replace "-propellor]" "-sbuild]" -stdMirror :: System -> Apt.Url -stdMirror (System (Debian s) _) = "http://httpredir.debian.org/debian" -stdMirror (System (Buntish r) _) = "TODO" - -- | Update a schroot's installed packages and apt indexes. updated :: System -> Property DebianLike updated system@(System distro arch) = go `requires` installed where go :: Property DebianLike go = tightenTargets $ cmdProperty - "sbuild-update" ["-udr", suite ++ "-" ++ "arch"] + "sbuild-update" ["-udr", suite ++ "-" ++ arch] suite = fromJust $ extractSuite system --- TODO autoclean/clean only if shareAptCache property not present -- | Bind-mount @/var/cache/apt/archives@ in all sbuild chroots so that the host -- system and the chroot share the apt cache @@ -134,3 +135,14 @@ keypairGenerated = go = tightenTargets $ cmdProperty "sbuild-update" ["--keygen"] `assume` MadeChange secKeyFile = "/var/lib/sbuild/apt-keys/sbuild-key.sec" + + +schrootLoc :: Suite -> Architecture -> FilePath +schrootLoc s a = "/srv/chroot" s ++ "-" ++ a + +schrootConfLoc :: Suite -> Architecture -> FilePath +schrootConfLoc s a = "/etc/schroot/chroot.d" s ++ "-" ++ a ++ "-sbuild-propellor" + +stdMirror :: System -> Apt.Url +stdMirror (System (Debian s) _) = "http://httpredir.debian.org/debian" +stdMirror (System (Buntish r) _) = "TODO" -- cgit v1.2.3 From 0d8ad9f5bcf96fc713dc9029307169ce1473cd55 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 17 May 2016 11:21:36 -0700 Subject: export the correct properties --- src/Propellor/Property/Sbuild.hs | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index bd43073d..d2a55b7b 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -37,8 +37,17 @@ sbuild environment as standardised as possible. -- If you wanted to do it with Propellor.Property.Debootstrap, note that -- sbuild-createchroot has a --setup-only option --- TODO export useful properties only -module Propellor.Property.Sbuild where +module Propellor.Property.Sbuild ( + -- * Creating and updating sbuild schroots + SbuildSchroot(..), + builtFor, + built, + updated, + updatedFor, + -- * Global sbuild configuration + shareAptCache, + usableBy, +) where import Propellor.Base import Debootstrap (extractSuite) -- cgit v1.2.3 From 4a53c94f58b160bc05d3d9c034b9e187f4323ecd Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 17 May 2016 11:30:51 -0700 Subject: new props and docstrings --- src/Propellor/Property/Sbuild.hs | 28 ++++++++++++++++++++++++++-- 1 file changed, 26 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index d2a55b7b..8c538fa0 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -5,8 +5,8 @@ Build and maintain schroots for use with sbuild. Suggested usage in @config.hs@: -> & Sbuild.built ((Debian Unstable) "i386") -> & Sbuild.updated ((Debian Unstable) "i386") `period` Weekly +> & Sbuild.builtFor ((Debian Unstable) "i386") +> & Sbuild.updatedFor ((Debian Unstable) "i386") `period` Weekly > & Sbuild.usableBy (User "spwhitton") > & Sbuild.shareAptCache > & Schroot.overlaysInTmpfs @@ -56,7 +56,31 @@ import qualified Propellor.Property.File as File import System.Directory +-- | An sbuild schroot, such as would be listed by @schroot -l@ +-- +-- Parts of the sbuild toolchain cannot distinguish between schroots with both +-- the same suite and the same architecture, so neither do we. +data SbuildSchroot = SbuildSchroot Suite Architecture + +-- | 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 +builtFor :: System -> Property DebianLike + -- | Build and configure a schroot for use with sbuild +built :: SbuildSchroot -> Apt.Url -> Property DebianLike + +-- | 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 +updatedFor :: System -> Property DebianLike + +-- | Ensure that an sbuild schroot's packages and apt indexes are updated +updated :: SbuildSchroot -> Property DebianLike + built :: System -> Property DebianLike built system@(System _ arch) = case extractSuite system of Just s -> check (not <$> doesDirectoryExist (schrootLoc s arch)) (built' system) -- cgit v1.2.3 From 3a3975030ddbb4bf3660f25f7bbfde5670dc70f0 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 17 May 2016 11:33:02 -0700 Subject: haddock prune option --- src/Propellor/Property/Sbuild.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 8c538fa0..32df83e0 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_HADDOCK prune #-} + {-| Maintainer: Sean Whitton @@ -59,7 +61,7 @@ import System.Directory -- | An sbuild schroot, such as would be listed by @schroot -l@ -- -- Parts of the sbuild toolchain cannot distinguish between schroots with both --- the same suite and the same architecture, so neither do we. +-- the same suite and the same architecture, so neither do we data SbuildSchroot = SbuildSchroot Suite Architecture -- | Build and configure a schroot for use with sbuild using a distribution's -- cgit v1.2.3 From 2f2f82c5bca2d4246f02567c8f6cf6291f381ce5 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 17 May 2016 11:33:31 -0700 Subject: grammar --- src/Propellor/Property/Sbuild.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 32df83e0..48499ca5 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -33,7 +33,7 @@ We use @sbuild-createchroot(1)@ to create a chroot to the specification of @sbuild-setup(7)@. This differs from the approach taken by picca's Sbuild.hs, which uses 'Propellor.Property.Debootstrap' to construct the chroot. This is because we don't want to run propellor inside the chroot in order to keep the -sbuild environment as standardised as possible. +sbuild environment as standard as possible. -} -- If you wanted to do it with Propellor.Property.Debootstrap, note that -- cgit v1.2.3 From ccf2d4f42688197bf631f9fcca80fbd49d951a0c Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 17 May 2016 11:37:48 -0700 Subject: tidy up utility fns --- src/Propellor/Property/Sbuild.hs | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 48499ca5..f9b766a1 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -47,6 +47,8 @@ module Propellor.Property.Sbuild ( updated, updatedFor, -- * Global sbuild configuration + installed, + keypairGenerated, shareAptCache, usableBy, ) where @@ -171,13 +173,20 @@ keypairGenerated = cmdProperty "sbuild-update" ["--keygen"] `assume` MadeChange secKeyFile = "/var/lib/sbuild/apt-keys/sbuild-key.sec" +-- ==== utility function ==== -schrootLoc :: Suite -> Architecture -> FilePath -schrootLoc s a = "/srv/chroot" s ++ "-" ++ a - -schrootConfLoc :: Suite -> Architecture -> FilePath -schrootConfLoc s a = "/etc/schroot/chroot.d" s ++ "-" ++ a ++ "-sbuild-propellor" +schrootFromSystem :: System -> Maybe SbuildSchroot +schrootFromSystem system@(System _ arch) = + extractSuite system + >>= \suite -> return $ SbuildSchroot suite arch stdMirror :: System -> Apt.Url stdMirror (System (Debian s) _) = "http://httpredir.debian.org/debian" stdMirror (System (Buntish r) _) = "TODO" + +schrootRoot :: SbuildSchroot -> FilePath +schrootRoot (SbuildSchroot s a) = "/srv/chroot" s ++ "-" ++ a + +schrootConf :: SbuildSchroot -> FilePath +schrootConf (SbuildSchroot s a) = + "/etc/schroot/chroot.d" s ++ "-" ++ a ++ "-sbuild-propellor" -- cgit v1.2.3 From b054cee3e0feaf15de1f14e50d9b3d129efddd00 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 17 May 2016 11:43:38 -0700 Subject: fill out wrapper functions --- src/Propellor/Property/Sbuild.hs | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index f9b766a1..a56a1242 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -72,6 +72,10 @@ data SbuildSchroot = SbuildSchroot Suite Architecture -- This function is a convenience wrapper around 'Sbuild.builtFor', allowing the -- user to identify the schroot and distribution using the 'System' type builtFor :: System -> Property DebianLike +builtFor system = case schrootFromSystem system of + Just s -> check (not <$> doesDirectoryExist (schrootRoot s)) $ + built s (stdMirror system) + Nothing -> errorMessage "don't know how to debootstrap " ++ show system -- | Build and configure a schroot for use with sbuild built :: SbuildSchroot -> Apt.Url -> Property DebianLike @@ -81,6 +85,9 @@ built :: SbuildSchroot -> Apt.Url -> Property DebianLike -- This function is a convenience wrapper around 'Sbuild.updated', allowing the -- user to identify the schroot using the 'System' type updatedFor :: System -> Property DebianLike +updatedFor system = case schrootFromSystem system of + Just s -> updated s (stdMirror system) + Nothing -> errorMessage "don't know how to debootstrap " ++ show system -- | Ensure that an sbuild schroot's packages and apt indexes are updated updated :: SbuildSchroot -> Property DebianLike @@ -164,16 +171,16 @@ usableBy u = User.hasGroup u (Group "sbuild") `requires` installed -- | Generate the apt keys needed by sbuild keypairGenerated :: Property DebianLike -keypairGenerated = - check (not <$> doesFileExist secKeyFile) $ go +keypairGenerated = check (not <$> doesFileExist secKeyFile) $ go `requires` installed where go :: Property DebianLike go = tightenTargets $ - cmdProperty "sbuild-update" ["--keygen"] `assume` MadeChange + cmdProperty "sbuild-update" ["--keygen"] + `assume` MadeChange secKeyFile = "/var/lib/sbuild/apt-keys/sbuild-key.sec" --- ==== utility function ==== +-- ==== utility functions ==== schrootFromSystem :: System -> Maybe SbuildSchroot schrootFromSystem system@(System _ arch) = -- cgit v1.2.3 From 03a0ca368e5aafd33b9ab6f04c465079462aeaf6 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 17 May 2016 11:43:44 -0700 Subject: comment out code that needs to be reworked with new types --- src/Propellor/Property/Sbuild.hs | 111 +++++++++++++++++++-------------------- 1 file changed, 53 insertions(+), 58 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index a56a1242..0dcf1bc6 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -92,64 +92,59 @@ updatedFor system = case schrootFromSystem system of -- | Ensure that an sbuild schroot's packages and apt indexes are updated updated :: SbuildSchroot -> Property DebianLike -built :: System -> Property DebianLike -built system@(System _ arch) = case extractSuite system of - Just s -> check (not <$> doesDirectoryExist (schrootLoc s arch)) (built' system) - Nothing -> errorMessage "don't know how to debootstrap " ++ show system - -built' :: System -> Property DebianLike -built' system@(System distro arch) = - property' ("built chroot for " ++ show system) (liftIO go) - `requires` keypairGenerated - where - go = do - suite <- case extractSuite system of - Just s -> return s - Nothing -> errorMessage $ - "don't know how to debootstrap " ++ show system - de <- standardPathEnv - let params = Param <$> - [ "--arch=" ++ arch - -- We pass --chroot-suffix in order that we can find the - -- config file despite the random suffix that - -- sbuild-createchroot gives it. We'll change this back - -- to 'sbuild' once debootstrap has finished. - , "--chroot-suffix=propellor" - , "--include=eatmydata,ccache" - , schrootLocation suite arch - , stdMirror distro - ] - ifM (boolSystemEnv "sbuild-createchroot" params (Just de)) - ( do - fixConfFile suite arch - return MadeChange - , return FailedChange - ) - --- Here we undo our --chroot-suffix=propellor by editing and renaming the config --- file so that it is as if we had passed --chroot-suffix=sbuild (the default). --- We replace the random suffix with 'propellor'. The properties in this module --- only permit the creation of one chroot for a given suite and architecture, so --- we don't need the random suffix. -fixConfFile :: String -> Architecture -> IO () -fixConfFile suite arch = do - confs <- dirContents schrootChrootD - let conf = filter (schrootChrootD - suite ++ "-" ++ arch ++ "-propellor-" `isPrefixOf`) - confs - ensureProperty $ File.fileProperty "replace dummy suffix" (map munge) conf - moveFile conf (schrootConfLoc suite arch) - where - munge = replace "-propellor]" "-sbuild]" - --- | Update a schroot's installed packages and apt indexes. -updated :: System -> Property DebianLike -updated system@(System distro arch) = go `requires` installed - where - go :: Property DebianLike - go = tightenTargets $ cmdProperty - "sbuild-update" ["-udr", suite ++ "-" ++ arch] - suite = fromJust $ extractSuite system +-- built' :: System -> Property DebianLike +-- built' system@(System distro arch) = +-- property' ("built chroot for " ++ show system) (liftIO go) +-- `requires` keypairGenerated +-- where +-- go = do +-- suite <- case extractSuite system of +-- Just s -> return s +-- Nothing -> errorMessage $ +-- "don't know how to debootstrap " ++ show system +-- de <- standardPathEnv +-- let params = Param <$> +-- [ "--arch=" ++ arch +-- -- We pass --chroot-suffix in order that we can find the +-- -- config file despite the random suffix that +-- -- sbuild-createchroot gives it. We'll change this back +-- -- to 'sbuild' once debootstrap has finished. +-- , "--chroot-suffix=propellor" +-- , "--include=eatmydata,ccache" +-- , schrootLocation suite arch +-- , stdMirror distro +-- ] +-- ifM (boolSystemEnv "sbuild-createchroot" params (Just de)) +-- ( do +-- fixConfFile suite arch +-- return MadeChange +-- , return FailedChange +-- ) + +-- -- Here we undo our --chroot-suffix=propellor by editing and renaming the config +-- -- file so that it is as if we had passed --chroot-suffix=sbuild (the default). +-- -- We replace the random suffix with 'propellor'. The properties in this module +-- -- only permit the creation of one chroot for a given suite and architecture, so +-- -- we don't need the random suffix. +-- fixConfFile :: String -> Architecture -> IO () +-- fixConfFile suite arch = do +-- confs <- dirContents schrootChrootD +-- let conf = filter (schrootChrootD +-- suite ++ "-" ++ arch ++ "-propellor-" `isPrefixOf`) +-- confs +-- ensureProperty $ File.fileProperty "replace dummy suffix" (map munge) conf +-- moveFile conf (schrootConfLoc suite arch) +-- where +-- munge = replace "-propellor]" "-sbuild]" + +-- -- | Update a schroot's installed packages and apt indexes. +-- updated :: System -> Property DebianLike +-- updated system@(System distro arch) = go `requires` installed +-- where +-- go :: Property DebianLike +-- go = tightenTargets $ cmdProperty +-- "sbuild-update" ["-udr", suite ++ "-" ++ arch] +-- suite = fromJust $ extractSuite system -- | Bind-mount @/var/cache/apt/archives@ in all sbuild chroots so that the host -- system and the chroot share the apt cache -- cgit v1.2.3 From 7d39a7da893934348cad9462507c20f450ce0952 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 17 May 2016 11:48:22 -0700 Subject: tidy up wrapper fns --- src/Propellor/Property/Sbuild.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 0dcf1bc6..8cb85bf3 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -73,12 +73,14 @@ data SbuildSchroot = SbuildSchroot Suite Architecture -- user to identify the schroot and distribution using the 'System' type builtFor :: System -> Property DebianLike builtFor system = case schrootFromSystem system of - Just s -> check (not <$> doesDirectoryExist (schrootRoot s)) $ - built s (stdMirror system) + Just s -> built s (stdMirror system) Nothing -> errorMessage "don't know how to debootstrap " ++ show system -- | Build and configure a schroot for use with sbuild built :: SbuildSchroot -> Apt.Url -> Property DebianLike +built s mirror = check (not <$> doesDirectoryExist (schrootRoot s)) go + `requires` keypairGenerated + `requires` installed -- | Ensure that an sbuild schroot's packages and apt indexes are updated -- @@ -86,11 +88,14 @@ built :: SbuildSchroot -> Apt.Url -> Property DebianLike -- user to identify the schroot using the 'System' type updatedFor :: System -> Property DebianLike updatedFor system = case schrootFromSystem system of - Just s -> updated s (stdMirror system) + Just s -> updated s Nothing -> errorMessage "don't know how to debootstrap " ++ show system -- | Ensure that an sbuild schroot's packages and apt indexes are updated updated :: SbuildSchroot -> Property DebianLike +updated s = check (doesDirectoryExist (schrootRoot s)) go + `requires` keypairGenerated + `requires` installed -- built' :: System -> Property DebianLike -- built' system@(System distro arch) = -- cgit v1.2.3 From 6092d2dea35c0fdcb2ad95a51440603c4655cdab Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 17 May 2016 11:50:59 -0700 Subject: more underscores --- src/Propellor/Property/Sbuild.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 8cb85bf3..0b4b106a 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -188,8 +188,8 @@ schrootFromSystem system@(System _ arch) = >>= \suite -> return $ SbuildSchroot suite arch stdMirror :: System -> Apt.Url -stdMirror (System (Debian s) _) = "http://httpredir.debian.org/debian" -stdMirror (System (Buntish r) _) = "TODO" +stdMirror (System (Debian _) _) = "http://httpredir.debian.org/debian" +stdMirror (System (Buntish _) _) = "TODO" schrootRoot :: SbuildSchroot -> FilePath schrootRoot (SbuildSchroot s a) = "/srv/chroot" s ++ "-" ++ a -- cgit v1.2.3 From 8d43f56a42239468960623a5f12d770d3ae872ad Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 17 May 2016 12:04:32 -0700 Subject: rewrite fixConfFile --- src/Propellor/Property/Sbuild.hs | 41 +++++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 19 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 0b4b106a..6b023460 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -59,6 +59,7 @@ import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File import System.Directory +import System.FilePath (takeDirectory) -- | An sbuild schroot, such as would be listed by @schroot -l@ -- @@ -110,10 +111,6 @@ updated s = check (doesDirectoryExist (schrootRoot s)) go -- de <- standardPathEnv -- let params = Param <$> -- [ "--arch=" ++ arch --- -- We pass --chroot-suffix in order that we can find the --- -- config file despite the random suffix that --- -- sbuild-createchroot gives it. We'll change this back --- -- to 'sbuild' once debootstrap has finished. -- , "--chroot-suffix=propellor" -- , "--include=eatmydata,ccache" -- , schrootLocation suite arch @@ -126,21 +123,27 @@ updated s = check (doesDirectoryExist (schrootRoot s)) go -- , return FailedChange -- ) --- -- Here we undo our --chroot-suffix=propellor by editing and renaming the config --- -- file so that it is as if we had passed --chroot-suffix=sbuild (the default). --- -- We replace the random suffix with 'propellor'. The properties in this module --- -- only permit the creation of one chroot for a given suite and architecture, so --- -- we don't need the random suffix. --- fixConfFile :: String -> Architecture -> IO () --- fixConfFile suite arch = do --- confs <- dirContents schrootChrootD --- let conf = filter (schrootChrootD --- suite ++ "-" ++ arch ++ "-propellor-" `isPrefixOf`) --- confs --- ensureProperty $ File.fileProperty "replace dummy suffix" (map munge) conf --- moveFile conf (schrootConfLoc suite arch) --- where --- munge = replace "-propellor]" "-sbuild]" + +-- Find the conf file that sbuild-createchroot(1) made when we passed it +-- --chroot-suffix=propellor, and edit and rename such that it is as if we +-- passed --chroot-suffix=sbuild (the default). Replace the random suffix with +-- 'propellor'. +-- +-- We had to pass --chroot-suffix=propellor in order that we can find a unique +-- config file for the schroot we just built, despite the random suffix. +-- +-- The properties in this module only permit the creation of one chroot for a +-- given suite and architecture, so we don't need the suffix to be random. +fixConfFile :: SbuildSchroot -> IO () +fixConfFile s@(SbuildSchroot suite arch) = do + old <- take 1 . filter (tempPrefix `isPrefixOf`) <$> dirContents dir + ensureProperty $ File.fileProperty "replace dummy suffix" (map munge) old + moveFile old new + where + new = schrootConf s + dir = takeDirectory new + tempPrefix = dir suite ++ "-" ++ arch ++ "-propellor-" + munge = replace "-propellor]" "-sbuild]" -- -- | Update a schroot's installed packages and apt indexes. -- updated :: System -> Property DebianLike -- cgit v1.2.3 From 80ef1acd5e86e91c47b90345e24fa4a9701cf8a9 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 17 May 2016 12:07:39 -0700 Subject: property descs & rewrite updated --- src/Propellor/Property/Sbuild.hs | 25 +++++++++---------------- 1 file changed, 9 insertions(+), 16 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 6b023460..5f182881 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -79,7 +79,8 @@ builtFor system = case schrootFromSystem system of -- | Build and configure a schroot for use with sbuild built :: SbuildSchroot -> Apt.Url -> Property DebianLike -built s mirror = check (not <$> doesDirectoryExist (schrootRoot s)) go +built s mirror = check (not <$> doesDirectoryExist (schrootRoot s)) $ + property ("built schroot for " ++ show s) go `requires` keypairGenerated `requires` installed @@ -94,15 +95,16 @@ updatedFor system = case schrootFromSystem system of -- | Ensure that an sbuild schroot's packages and apt indexes are updated updated :: SbuildSchroot -> Property DebianLike -updated s = check (doesDirectoryExist (schrootRoot s)) go +updated s@(SbuildSchroot suite arch) = + check (doesDirectoryExist (schrootRoot s)) $ + property ("updated schroot for " ++ show s) go `requires` keypairGenerated `requires` installed + where + go :: Property DebianLike + go = tightenTargets $ cmdProperty + "sbuild-update" ["-udr", suite ++ "-" ++ arch] --- built' :: System -> Property DebianLike --- built' system@(System distro arch) = --- property' ("built chroot for " ++ show system) (liftIO go) --- `requires` keypairGenerated --- where -- go = do -- suite <- case extractSuite system of -- Just s -> return s @@ -145,15 +147,6 @@ fixConfFile s@(SbuildSchroot suite arch) = do tempPrefix = dir suite ++ "-" ++ arch ++ "-propellor-" munge = replace "-propellor]" "-sbuild]" --- -- | Update a schroot's installed packages and apt indexes. --- updated :: System -> Property DebianLike --- updated system@(System distro arch) = go `requires` installed --- where --- go :: Property DebianLike --- go = tightenTargets $ cmdProperty --- "sbuild-update" ["-udr", suite ++ "-" ++ arch] --- suite = fromJust $ extractSuite system - -- | Bind-mount @/var/cache/apt/archives@ in all sbuild chroots so that the host -- system and the chroot share the apt cache -- -- cgit v1.2.3 From db0245d9d96c4235563e4314102b114b028d72d0 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 17 May 2016 12:09:45 -0700 Subject: re-insert build code --- src/Propellor/Property/Sbuild.hs | 39 ++++++++++++++++++--------------------- 1 file changed, 18 insertions(+), 21 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 5f182881..8f6629fb 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -77,12 +77,30 @@ builtFor system = case schrootFromSystem system of Just s -> built s (stdMirror system) Nothing -> errorMessage "don't know how to debootstrap " ++ show system +-- TODO should be revertable (and that should carry through to builtFor) -- | Build and configure a schroot for use with sbuild built :: SbuildSchroot -> Apt.Url -> Property DebianLike built s mirror = check (not <$> doesDirectoryExist (schrootRoot s)) $ property ("built schroot for " ++ show s) go `requires` keypairGenerated `requires` installed + where + go :: Property DebianLike + go = do + de <- standardPathEnv + let params = Param <$> + [ "--arch=" ++ arch + , "--chroot-suffix=propellor" + , "--include=eatmydata,ccache" + , schrootRoot s + , mirror + ] + ifM (boolSystemEnv "sbuild-createchroot" params (Just de)) + ( do + fixConfFile s + return MadeChange + , return FailedChange + ) -- | Ensure that an sbuild schroot's packages and apt indexes are updated -- @@ -105,27 +123,6 @@ updated s@(SbuildSchroot suite arch) = go = tightenTargets $ cmdProperty "sbuild-update" ["-udr", suite ++ "-" ++ arch] --- go = do --- suite <- case extractSuite system of --- Just s -> return s --- Nothing -> errorMessage $ --- "don't know how to debootstrap " ++ show system --- de <- standardPathEnv --- let params = Param <$> --- [ "--arch=" ++ arch --- , "--chroot-suffix=propellor" --- , "--include=eatmydata,ccache" --- , schrootLocation suite arch --- , stdMirror distro --- ] --- ifM (boolSystemEnv "sbuild-createchroot" params (Just de)) --- ( do --- fixConfFile suite arch --- return MadeChange --- , return FailedChange --- ) - - -- Find the conf file that sbuild-createchroot(1) made when we passed it -- --chroot-suffix=propellor, and edit and rename such that it is as if we -- passed --chroot-suffix=sbuild (the default). Replace the random suffix with -- cgit v1.2.3 From 101fd0f882df8137c3d8ae1345b25801b180d2ac Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 19 May 2016 14:09:01 +0900 Subject: more lines into the schroot config --- src/Propellor/Property/Sbuild.hs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 8f6629fb..c5bf30c0 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -80,7 +80,7 @@ builtFor system = case schrootFromSystem system of -- TODO should be revertable (and that should carry through to builtFor) -- | Build and configure a schroot for use with sbuild built :: SbuildSchroot -> Apt.Url -> Property DebianLike -built s mirror = check (not <$> doesDirectoryExist (schrootRoot s)) $ +built s@(SbuildSchroot suite arch) mirror = check (not <$> doesDirectoryExist (schrootRoot s)) $ property ("built schroot for " ++ show s) go `requires` keypairGenerated `requires` installed @@ -98,6 +98,13 @@ built s mirror = check (not <$> doesDirectoryExist (schrootRoot s)) $ ifM (boolSystemEnv "sbuild-createchroot" params (Just de)) ( do fixConfFile s + -- if we just built a sid chroot, add useful aliases + when (suite == "unstable") $ ensureProperty $ + File.containsLine (schrootConf s) + "aliases=UNRELEASED,sid,rc-buggy,experimental" + -- enable ccache and eatmydata for speed + ensureProperty $ File.containsLine (schrootConf s) + "command-prefix=/var/cache/ccache-sbuild/sbuild-setup,eatmydata" return MadeChange , return FailedChange ) -- cgit v1.2.3 From 50a361209b218483f5162d41b90ce0045a852f37 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 19 May 2016 14:25:09 +0900 Subject: add GroupOwner and NotDestination iptables Rules --- src/Propellor/Property/Firewall.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs index ce0befcd..3ea19ffa 100644 --- a/src/Propellor/Property/Firewall.hs +++ b/src/Propellor/Property/Firewall.hs @@ -79,6 +79,12 @@ toIpTableArg (TCPFlags m c) = , intercalate "," (map show c) ] toIpTableArg TCPSyn = ["--syn"] +toIpTableArg (GroupOwner (Group g)) = + [ "-m" + , "owner" + , "--gid-owner" + , g + ] toIpTableArg (Source ipwm) = [ "-s" , intercalate "," (map fromIPWithMask ipwm) @@ -87,6 +93,11 @@ toIpTableArg (Destination ipwm) = [ "-d" , intercalate "," (map fromIPWithMask ipwm) ] +toIpTableArg (NotDestination ipwm) = + [ "!" + , "-d" + , intercalate "," (map fromIPWithMask ipwm) + ] toIpTableArg (NatDestination ip mport) = [ "--to-destination" , fromIPAddr ip ++ maybe "" (\p -> ":" ++ fromPort p) mport @@ -179,8 +190,10 @@ data Rules | RateLimit Frequency | TCPFlags TCPFlagMask TCPFlagComp | TCPSyn + | GroupOwner Group | Source [ IPWithMask ] | Destination [ IPWithMask ] + | NotDestination [ IPWithMask ] | NatDestination IPAddr (Maybe Port) | Rules :- Rules -- ^Combine two rules deriving (Eq, Show) -- cgit v1.2.3 From 52d0cad8f09576f50479bfaaad9a03e725f7c77c Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 19 May 2016 14:27:12 +0900 Subject: Sbuild.blockNetwork --- src/Propellor/Property/Sbuild.hs | 12 ++++++++++++ 1 file changed, 12 insertions(+) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index c5bf30c0..41f26f27 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -11,6 +11,7 @@ Suggested usage in @config.hs@: > & Sbuild.updatedFor ((Debian Unstable) "i386") `period` Weekly > & Sbuild.usableBy (User "spwhitton") > & Sbuild.shareAptCache +> & Sbuild.blockNetwork > & Schroot.overlaysInTmpfs In @~/.sbuildrc@: @@ -57,6 +58,7 @@ import Propellor.Base import Debootstrap (extractSuite) import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File +import qualified Propellor.Property.Firewall as Firewall import System.Directory import System.FilePath (takeDirectory) @@ -180,6 +182,16 @@ keypairGenerated = check (not <$> doesFileExist secKeyFile) $ go `assume` MadeChange secKeyFile = "/var/lib/sbuild/apt-keys/sbuild-key.sec" +-- | Block network access during builds +-- +-- This is a hack from until #802850 and +-- #802849 are resolved. +blockNetwork :: Property Linux +blockNetwork = Firewall.rule OUTPUT Filter DROP + ( GroupOwner (Group "sbuild") + ++ NotDestination [IPWithNumMask "127.0.0.1" "8"] + ) + -- ==== utility functions ==== schrootFromSystem :: System -> Maybe SbuildSchroot -- cgit v1.2.3 From 530d9f1b2bb1d740a4ca7404f0e885c64626a0e0 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 19 May 2016 15:00:08 +0900 Subject: add Ccache.hs --- src/Propellor/Property/Ccache.hs | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 src/Propellor/Property/Ccache.hs (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs new file mode 100644 index 00000000..6ee796f0 --- /dev/null +++ b/src/Propellor/Property/Ccache.hs @@ -0,0 +1,39 @@ +-- | Maintainer: Sean Whitton + +module Propellor.Property.Ccache where + +import Propellor.Base +import qualified Propellor.Property.File as File +import qualified Propellor.Property.Apt as Apt + +import Utility.FileMode +import System.Posix.Files + +-- | Configures a ccache in /var/cache for a group +-- +-- If you say +-- +-- > & (Group "foo") `Ccache.hasGroupCache` "4G" +-- +-- you instruct propellor to create a ccache in /var/cache/ccache-foo owned and +-- writeable by the foo group, with a maximum cache size of 4GB. See ccache(1) +-- for size specification. +hasGroupCache :: Group -> String -> RevertableProperty DebianLike UnixLike +group@(Group g) `hasGroupCache` size = (make `requires` installed) delete + where + path = "/var/cache/ccache-" ++ g + make = check (not <$> doesDirectoryExist path) $ + propertyList ("ccache for " ++ g ++ " exists") $ props + & File.dirExists path + & File.ownerGroup path (User "root") group + & File.mode path (combineModes $ + readModes ++ executeModes + ++ [ownerWriteMode, groupWriteMode]) + & cmdProperty "ccache" ["--max-size", size] + `assume` MadeChange + delete = check (doesDirectoryExist path) $ + cmdProperty "rm" ["-r", path] `assume` MadeChange + `describe` ("ccache for " ++ g ++ " does not exist") + +installed :: Property DebianLike +installed = Apt.installed ["ccache"] -- cgit v1.2.3 From 5856c13d338ada5354721b4141e788b7961ffacf Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 19 May 2016 15:05:10 +0900 Subject: Sbuild.ccachePrepared --- src/Propellor/Property/Sbuild.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 41f26f27..1d009f41 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -57,6 +57,7 @@ module Propellor.Property.Sbuild ( import Propellor.Base import Debootstrap (extractSuite) import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.Ccache as Ccache import qualified Propellor.Property.File as File import qualified Propellor.Property.Firewall as Firewall @@ -85,6 +86,7 @@ built :: SbuildSchroot -> Apt.Url -> Property DebianLike built s@(SbuildSchroot suite arch) mirror = check (not <$> doesDirectoryExist (schrootRoot s)) $ property ("built schroot for " ++ show s) go `requires` keypairGenerated + `requires` ccachePrepared `requires` installed where go :: Property DebianLike @@ -182,6 +184,22 @@ keypairGenerated = check (not <$> doesFileExist secKeyFile) $ go `assume` MadeChange secKeyFile = "/var/lib/sbuild/apt-keys/sbuild-key.sec" +ccachePrepared :: Property DebianLike +ccachePrepared = propertyList "sbuild group ccache configured" $ props + & (Group "sbuild") `Ccache.hasGroupCache` "2G" + & "/etc/schroot/sbuild/fstab" `File.containsLine` + "/var/cache/ccache-sbuild /var/cache/ccache-sbuild rw,bind 0 0" + & "/var/cache/ccache-sbuild/sbuild-setup" `File.hasContent` + [ "#!/bin/sh" + , "export CCACHE_DIR=/var/cache/ccache-sbuild" + , "export CCACHE_UMASK=002" + , "export CCACHE_COMPRESS=1" + , "unset CCACHE_HARDLINK" + , "export PATH=\"/usr/lib/ccache:$PATH\"" + , "" + , "exec \"$@\"" + ] + -- | Block network access during builds -- -- This is a hack from until #802850 and -- cgit v1.2.3 From daf5bd929143aec4ef5654eb50a1d99a6214672a Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 19 May 2016 15:05:38 +0900 Subject: wiki credit --- src/Propellor/Property/Sbuild.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 1d009f41..3a8f72a0 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -184,6 +184,7 @@ keypairGenerated = check (not <$> doesFileExist secKeyFile) $ go `assume` MadeChange secKeyFile = "/var/lib/sbuild/apt-keys/sbuild-key.sec" +-- another script from wiki.d.o/sbuild ccachePrepared :: Property DebianLike ccachePrepared = propertyList "sbuild group ccache configured" $ props & (Group "sbuild") `Ccache.hasGroupCache` "2G" -- cgit v1.2.3 From 5a01b810141e78791782d2abe2cf56d40dbc7099 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 19 May 2016 15:07:34 +0900 Subject: execute modes on ccache sbuild setup script --- src/Propellor/Property/Sbuild.hs | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 3a8f72a0..ac48041d 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -200,6 +200,8 @@ ccachePrepared = propertyList "sbuild group ccache configured" $ props , "" , "exec \"$@\"" ] + & File.mode "/var/cache/ccache-sbuild/sbuild-setup" + (combineModes (readModes ++ executeModes)) -- | Block network access during builds -- -- cgit v1.2.3 From a6d43c875a67b76e4e88f4957ebb23ffe4b48f9a Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 19 May 2016 15:10:47 +0900 Subject: Sbuild.built & Sbuild.builtFor now revertable --- src/Propellor/Property/Sbuild.hs | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index ac48041d..237fc815 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -75,20 +75,20 @@ data SbuildSchroot = SbuildSchroot Suite Architecture -- -- This function is a convenience wrapper around 'Sbuild.builtFor', allowing the -- user to identify the schroot and distribution using the 'System' type -builtFor :: System -> Property DebianLike +builtFor :: System -> RevertableProperty DebianLike UnixLike builtFor system = case schrootFromSystem system of Just s -> built s (stdMirror system) Nothing -> errorMessage "don't know how to debootstrap " ++ show system --- TODO should be revertable (and that should carry through to builtFor) -- | Build and configure a schroot for use with sbuild -built :: SbuildSchroot -> Apt.Url -> Property DebianLike -built s@(SbuildSchroot suite arch) mirror = check (not <$> doesDirectoryExist (schrootRoot s)) $ - property ("built schroot for " ++ show s) go - `requires` keypairGenerated - `requires` ccachePrepared - `requires` installed +built :: SbuildSchroot -> Apt.Url -> RevertableProperty DebianLike UnixLike +built s@(SbuildSchroot suite arch) mirror = built deleted where + built = check (not <$> doesDirectoryExist (schrootRoot s)) $ + property ("built sbuild schroot for " ++ show s) go + `requires` keypairGenerated + `requires` ccachePrepared + `requires` installed go :: Property DebianLike go = do de <- standardPathEnv @@ -112,6 +112,9 @@ built s@(SbuildSchroot suite arch) mirror = check (not <$> doesDirectoryExist (s return MadeChange , return FailedChange ) + deleted = check (doesDirectoryExist (schrootRoot s)) $ + cmdProperty "rm" ["-r", schrootRoot s] `assume` MadeChange + `describe` ("sbuild schroot for " ++ show s ++ " does not exist") -- | Ensure that an sbuild schroot's packages and apt indexes are updated -- -- cgit v1.2.3 From c546d201ca09c4718203fbc634f8d6ee58f9da1e Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 19 May 2016 15:11:45 +0900 Subject: fill in buntish standard mirror --- src/Propellor/Property/Sbuild.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 237fc815..755f75c4 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -225,7 +225,7 @@ schrootFromSystem system@(System _ arch) = stdMirror :: System -> Apt.Url stdMirror (System (Debian _) _) = "http://httpredir.debian.org/debian" -stdMirror (System (Buntish _) _) = "TODO" +stdMirror (System (Buntish _) _) = "mirror://mirrors.ubuntu.com/" schrootRoot :: SbuildSchroot -> FilePath schrootRoot (SbuildSchroot s a) = "/srv/chroot" s ++ "-" ++ a -- cgit v1.2.3 From ec585a860b477b5e289c7a3ea03fce57deb0aa72 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 19 May 2016 15:14:10 +0900 Subject: script spacing --- src/Propellor/Property/Sbuild.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 755f75c4..3967d0a1 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -195,6 +195,7 @@ ccachePrepared = propertyList "sbuild group ccache configured" $ props "/var/cache/ccache-sbuild /var/cache/ccache-sbuild rw,bind 0 0" & "/var/cache/ccache-sbuild/sbuild-setup" `File.hasContent` [ "#!/bin/sh" + , "" , "export CCACHE_DIR=/var/cache/ccache-sbuild" , "export CCACHE_UMASK=002" , "export CCACHE_COMPRESS=1" -- cgit v1.2.3 From 15083c8af59e369b520eb063682804caada32e22 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 19 May 2016 15:20:42 +0900 Subject: Sbuild.updated cleans a non-shared apt-cache --- src/Propellor/Property/Sbuild.hs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 3967d0a1..55fb29c0 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -134,8 +134,16 @@ updated s@(SbuildSchroot suite arch) = `requires` installed where go :: Property DebianLike - go = tightenTargets $ cmdProperty - "sbuild-update" ["-udr", suite ++ "-" ++ arch] + go = do + fstab <- lines <$> liftIO $ readFile "/etc/schroot/sbuild/fstab" + -- If this schroot shares its apt archives with the host + -- machine, don't run apt-get clean/autoclean + let args = if cacheLine `elem` fstab + then "-udr" + else "-udcar" + tightenTargets $ cmdProperty + "sbuild-update" [args, suite ++ "-" ++ arch] + cacheLine = "/var/cache/apt/archives /var/cache/apt/archives none rw,bind 0 0" -- Find the conf file that sbuild-createchroot(1) made when we passed it -- --chroot-suffix=propellor, and edit and rename such that it is as if we -- cgit v1.2.3 From de76b8b3f02c5101b7b6efeec6f2d99cf456d4dd Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 19 May 2016 15:21:23 +0900 Subject: Revert "Sbuild.updated cleans a non-shared apt-cache" With overlay mounts this is irrelevant; there's no reason ever to clean or autoclean. --- src/Propellor/Property/Sbuild.hs | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 55fb29c0..3967d0a1 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -134,16 +134,8 @@ updated s@(SbuildSchroot suite arch) = `requires` installed where go :: Property DebianLike - go = do - fstab <- lines <$> liftIO $ readFile "/etc/schroot/sbuild/fstab" - -- If this schroot shares its apt archives with the host - -- machine, don't run apt-get clean/autoclean - let args = if cacheLine `elem` fstab - then "-udr" - else "-udcar" - tightenTargets $ cmdProperty - "sbuild-update" [args, suite ++ "-" ++ arch] - cacheLine = "/var/cache/apt/archives /var/cache/apt/archives none rw,bind 0 0" + go = tightenTargets $ cmdProperty + "sbuild-update" ["-udr", suite ++ "-" ++ arch] -- Find the conf file that sbuild-createchroot(1) made when we passed it -- --chroot-suffix=propellor, and edit and rename such that it is as if we -- cgit v1.2.3 From 41cda202087be38cf776c234f9e531aaf283b18f Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 19 May 2016 15:36:03 +0900 Subject: add missing imports --- src/Propellor/Property/Sbuild.hs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 3967d0a1..a9c73816 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -55,14 +55,21 @@ module Propellor.Property.Sbuild ( ) where import Propellor.Base -import Debootstrap (extractSuite) +import Propellor.Property.Debootstrap (extractSuite) +import Propellor.Property.Chroot.Util import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Ccache as Ccache import qualified Propellor.Property.File as File import qualified Propellor.Property.Firewall as Firewall +import qualified Propellor.Property.User as User +import Utility.FileMode import System.Directory import System.FilePath (takeDirectory) +import Data.List +import Data.List.Utils + +type Suite = String -- | An sbuild schroot, such as would be listed by @schroot -l@ -- -- cgit v1.2.3 From 2a1f6a6d65771f045d1a56a0f698782122525284 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 19 May 2016 15:36:08 +0900 Subject: fix firewall monoid --- src/Propellor/Property/Sbuild.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index a9c73816..0890bc3f 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -219,10 +219,10 @@ ccachePrepared = propertyList "sbuild group ccache configured" $ props -- This is a hack from until #802850 and -- #802849 are resolved. blockNetwork :: Property Linux -blockNetwork = Firewall.rule OUTPUT Filter DROP - ( GroupOwner (Group "sbuild") - ++ NotDestination [IPWithNumMask "127.0.0.1" "8"] - ) +blockNetwork = Firewall.rule Firewall.OUTPUT Firewall.Filter Firewall.DROP $ + Firewall.GroupOwner (Group "sbuild") + `mappend` Firewall.NotDestination + [Firewall.IPWithNumMask (IPv4 "127.0.0.1") 8] -- ==== utility functions ==== -- cgit v1.2.3 From e603748f9752bbef2eb1a1bd82a36f3afda0986d Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 20 May 2016 05:53:54 +0900 Subject: fix bracketing and type errors --- src/Propellor/Property/Sbuild.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 0890bc3f..8c507bd8 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -85,7 +85,7 @@ data SbuildSchroot = SbuildSchroot Suite Architecture builtFor :: System -> RevertableProperty DebianLike UnixLike builtFor system = case schrootFromSystem system of Just s -> built s (stdMirror system) - Nothing -> errorMessage "don't know how to debootstrap " ++ show system + Nothing -> errorMessage ("don't know how to debootstrap " ++ show system) -- | Build and configure a schroot for use with sbuild built :: SbuildSchroot -> Apt.Url -> RevertableProperty DebianLike UnixLike @@ -130,19 +130,20 @@ built s@(SbuildSchroot suite arch) mirror = built deleted updatedFor :: System -> Property DebianLike updatedFor system = case schrootFromSystem system of Just s -> updated s - Nothing -> errorMessage "don't know how to debootstrap " ++ show system + Nothing -> errorMessage ("don't know how to debootstrap " ++ show system) -- | Ensure that an sbuild schroot's packages and apt indexes are updated updated :: SbuildSchroot -> Property DebianLike updated s@(SbuildSchroot suite arch) = - check (doesDirectoryExist (schrootRoot s)) $ - property ("updated schroot for " ++ show s) go + check (doesDirectoryExist (schrootRoot s)) $ go + `describe` ("updated schroot for " ++ show s) `requires` keypairGenerated `requires` installed where go :: Property DebianLike go = tightenTargets $ cmdProperty "sbuild-update" ["-udr", suite ++ "-" ++ arch] + `assume` MadeChange -- Find the conf file that sbuild-createchroot(1) made when we passed it -- --chroot-suffix=propellor, and edit and rename such that it is as if we @@ -156,7 +157,7 @@ updated s@(SbuildSchroot suite arch) = -- given suite and architecture, so we don't need the suffix to be random. fixConfFile :: SbuildSchroot -> IO () fixConfFile s@(SbuildSchroot suite arch) = do - old <- take 1 . filter (tempPrefix `isPrefixOf`) <$> dirContents dir + old <- concat . filter (tempPrefix `isPrefixOf`) <$> dirContents dir ensureProperty $ File.fileProperty "replace dummy suffix" (map munge) old moveFile old new where -- cgit v1.2.3 From 7bf451618e49e68bce7e9b6a75f09e3e5943df5e Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 20 May 2016 05:56:21 +0900 Subject: show instance for SbuildSchroot --- src/Propellor/Property/Sbuild.hs | 3 +++ 1 file changed, 3 insertions(+) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 8c507bd8..cb19d525 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -77,6 +77,9 @@ type Suite = String -- the same suite and the same architecture, so neither do we data SbuildSchroot = SbuildSchroot Suite Architecture +instance Show SbuildSchroot where + show (SbuildSchroot suite arch) = suite ++ "-" ++ arch + -- | Build and configure a schroot for use with sbuild using a distribution's -- standard mirror -- -- cgit v1.2.3 From 714cb4e3425b61b204589ceeb7eb63fcd2b7d4e4 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 20 May 2016 06:22:11 +0900 Subject: move fixConfFile into the propellor monad --- src/Propellor/Property/Sbuild.hs | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index cb19d525..8b0748e4 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -158,11 +158,15 @@ updated s@(SbuildSchroot suite arch) = -- -- The properties in this module only permit the creation of one chroot for a -- given suite and architecture, so we don't need the suffix to be random. -fixConfFile :: SbuildSchroot -> IO () -fixConfFile s@(SbuildSchroot suite arch) = do - old <- concat . filter (tempPrefix `isPrefixOf`) <$> dirContents dir - ensureProperty $ File.fileProperty "replace dummy suffix" (map munge) old - moveFile old new +fixConfFile :: SbuildSchroot -> Property UnixLike +fixConfFile s@(SbuildSchroot suite arch) = + property' ("schroot for " ++ show s ++ " config file fixed") $ \w -> do + confs <- liftIO $ dirContents dir + let old = concat $ filter (tempPrefix `isPrefixOf`) confs + ensureProperty w $ + File.fileProperty "replace dummy suffix" (map munge) old + liftIO $ moveFile old new + return MadeChange where new = schrootConf s dir = takeDirectory new -- cgit v1.2.3 From af45dd5862285da8b85b8ea8cef95391d1b2567a Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 20 May 2016 07:04:48 +0900 Subject: fix builtFor and updatedFor --- src/Propellor/Property/Sbuild.hs | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 8b0748e4..7bf13a64 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -86,9 +86,16 @@ instance Show SbuildSchroot where -- This function is a convenience wrapper around 'Sbuild.builtFor', allowing the -- user to identify the schroot and distribution using the 'System' type builtFor :: System -> RevertableProperty DebianLike UnixLike -builtFor system = case schrootFromSystem system of - Just s -> built s (stdMirror system) - Nothing -> errorMessage ("don't know how to debootstrap " ++ show system) +builtFor system = go deleted + where + go = property' ("sbuild schroot for " ++ show system) $ + \w -> case schrootFromSystem system of + Just s -> ensureProperty w $ setupRevertableProperty (built s (stdMirror system)) + Nothing -> errorMessage ("don't know how to debootstrap " ++ show system) + deleted = property' ("no sbuild schroot for " ++ show system) $ + \w -> case schrootFromSystem system of + Just s -> ensureProperty w $ undoRevertableProperty $ built s "dummy" + Nothing -> return NoChange -- | Build and configure a schroot for use with sbuild built :: SbuildSchroot -> Apt.Url -> RevertableProperty DebianLike UnixLike @@ -131,9 +138,10 @@ built s@(SbuildSchroot suite arch) mirror = built deleted -- This function is a convenience wrapper around 'Sbuild.updated', allowing the -- user to identify the schroot using the 'System' type updatedFor :: System -> Property DebianLike -updatedFor system = case schrootFromSystem system of - Just s -> updated s - Nothing -> errorMessage ("don't know how to debootstrap " ++ show system) +updatedFor system = property' ("updated sbuild schroot for " ++ show system) $ + \w -> case schrootFromSystem system of + Just s -> ensureProperty w $ updated s + Nothing -> errorMessage ("don't know how to debootstrap " ++ show system) -- | Ensure that an sbuild schroot's packages and apt indexes are updated updated :: SbuildSchroot -> Property DebianLike -- cgit v1.2.3 From b97bc4aa6d679cba670c1445eb5696e3d261a7c1 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 20 May 2016 07:11:28 +0900 Subject: use removeChroot to delete schroots --- src/Propellor/Property/Sbuild.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 7bf13a64..e0d8abea 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -95,7 +95,7 @@ builtFor system = go deleted deleted = property' ("no sbuild schroot for " ++ show system) $ \w -> case schrootFromSystem system of Just s -> ensureProperty w $ undoRevertableProperty $ built s "dummy" - Nothing -> return NoChange + Nothing -> noChange -- | Build and configure a schroot for use with sbuild built :: SbuildSchroot -> Apt.Url -> RevertableProperty DebianLike UnixLike @@ -130,8 +130,9 @@ built s@(SbuildSchroot suite arch) mirror = built deleted , return FailedChange ) deleted = check (doesDirectoryExist (schrootRoot s)) $ - cmdProperty "rm" ["-r", schrootRoot s] `assume` MadeChange - `describe` ("sbuild schroot for " ++ show s ++ " does not exist") + property' ("no sbuild schroot for " ++ show s) $ \w -> do + ensureProperty w $ File.notPresent (schrootConf s) + makeChange (removeChroot $ schrootRoot s) -- | Ensure that an sbuild schroot's packages and apt indexes are updated -- -- cgit v1.2.3 From af1be336d79c9dbf159aac0cc35078cf20156bfe Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 20 May 2016 07:20:17 +0900 Subject: fix types in Sbuild.built --- src/Propellor/Property/Sbuild.hs | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index e0d8abea..a674ea16 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -1,4 +1,5 @@ {-# OPTIONS_HADDOCK prune #-} +{-# LANGUAGE TypeFamilies #-} {-| Maintainer: Sean Whitton @@ -99,16 +100,15 @@ builtFor system = go deleted -- | Build and configure a schroot for use with sbuild built :: SbuildSchroot -> Apt.Url -> RevertableProperty DebianLike UnixLike -built s@(SbuildSchroot suite arch) mirror = built deleted +built s@(SbuildSchroot suite arch) mirror = + (built `requires` keypairGenerated `requires` ccachePrepared `requires` installed) + deleted where + built :: Property DebianLike built = check (not <$> doesDirectoryExist (schrootRoot s)) $ - property ("built sbuild schroot for " ++ show s) go - `requires` keypairGenerated - `requires` ccachePrepared - `requires` installed - go :: Property DebianLike - go = do - de <- standardPathEnv + property' ("built sbuild schroot for " ++ show s) go + go w = do + de <- liftIO standardPathEnv let params = Param <$> [ "--arch=" ++ arch , "--chroot-suffix=propellor" @@ -116,15 +116,17 @@ built s@(SbuildSchroot suite arch) mirror = built deleted , schrootRoot s , mirror ] - ifM (boolSystemEnv "sbuild-createchroot" params (Just de)) + ifM (liftIO $ boolSystemEnv "sbuild-createchroot" params (Just de)) ( do - fixConfFile s + ensureProperty w $ fixConfFile s -- if we just built a sid chroot, add useful aliases - when (suite == "unstable") $ ensureProperty $ - File.containsLine (schrootConf s) - "aliases=UNRELEASED,sid,rc-buggy,experimental" + if suite == "unstable" + then ensureProperty w $ + File.containsLine (schrootConf s) + "aliases=UNRELEASED,sid,rc-buggy,experimental" + else noChange -- enable ccache and eatmydata for speed - ensureProperty $ File.containsLine (schrootConf s) + ensureProperty w $ File.containsLine (schrootConf s) "command-prefix=/var/cache/ccache-sbuild/sbuild-setup,eatmydata" return MadeChange , return FailedChange -- cgit v1.2.3 From 37944fd4d3eea401b84334600c8097c90fb9123f Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 20 May 2016 07:27:23 +0900 Subject: refactor for line length --- src/Propellor/Property/Sbuild.hs | 37 ++++++++++++++++++++++--------------- 1 file changed, 22 insertions(+), 15 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index a674ea16..ade9a1f8 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -65,8 +65,6 @@ import qualified Propellor.Property.Firewall as Firewall import qualified Propellor.Property.User as User import Utility.FileMode -import System.Directory -import System.FilePath (takeDirectory) import Data.List import Data.List.Utils @@ -91,23 +89,30 @@ builtFor system = go deleted where go = property' ("sbuild schroot for " ++ show system) $ \w -> case schrootFromSystem system of - Just s -> ensureProperty w $ setupRevertableProperty (built s (stdMirror system)) - Nothing -> errorMessage ("don't know how to debootstrap " ++ show system) + Just s -> ensureProperty w $ + setupRevertableProperty $ + built s (stdMirror system) + Nothing -> errorMessage + ("don't know how to debootstrap " ++ show system) deleted = property' ("no sbuild schroot for " ++ show system) $ \w -> case schrootFromSystem system of - Just s -> ensureProperty w $ undoRevertableProperty $ built s "dummy" + Just s -> ensureProperty w $ + undoRevertableProperty $ built s "dummy" Nothing -> noChange -- | Build and configure a schroot for use with sbuild built :: SbuildSchroot -> Apt.Url -> RevertableProperty DebianLike UnixLike built s@(SbuildSchroot suite arch) mirror = - (built `requires` keypairGenerated `requires` ccachePrepared `requires` installed) + (go + `requires` keypairGenerated + `requires` ccachePrepared + `requires` installed) deleted where - built :: Property DebianLike - built = check (not <$> doesDirectoryExist (schrootRoot s)) $ - property' ("built sbuild schroot for " ++ show s) go - go w = do + go :: Property DebianLike + go = check (not <$> doesDirectoryExist (schrootRoot s)) $ + property' ("built sbuild schroot for " ++ show s) make + make w = do de <- liftIO standardPathEnv let params = Param <$> [ "--arch=" ++ arch @@ -121,13 +126,10 @@ built s@(SbuildSchroot suite arch) mirror = ensureProperty w $ fixConfFile s -- if we just built a sid chroot, add useful aliases if suite == "unstable" - then ensureProperty w $ - File.containsLine (schrootConf s) - "aliases=UNRELEASED,sid,rc-buggy,experimental" + then ensureProperty w aliasesLine else noChange -- enable ccache and eatmydata for speed - ensureProperty w $ File.containsLine (schrootConf s) - "command-prefix=/var/cache/ccache-sbuild/sbuild-setup,eatmydata" + ensureProperty w commandPrefix return MadeChange , return FailedChange ) @@ -136,6 +138,11 @@ built s@(SbuildSchroot suite arch) mirror = ensureProperty w $ File.notPresent (schrootConf s) makeChange (removeChroot $ schrootRoot s) + aliasesLine = File.containsLine (schrootConf s) + "aliases=UNRELEASED,sid,rc-buggy,experimental" + commandPrefix = File.containsLine (schrootConf s) + "command-prefix=/var/cache/ccache-sbuild/sbuild-setup,eatmydata" + -- | 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 a656f0f1b050e5787883172a750f32d0bd5a6545 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 20 May 2016 07:34:14 +0900 Subject: export Sbuild.blockNetwork --- src/Propellor/Property/Sbuild.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index ade9a1f8..49741ac1 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -49,6 +49,7 @@ module Propellor.Property.Sbuild ( updated, updatedFor, -- * Global sbuild configuration + blockNetwork, installed, keypairGenerated, shareAptCache, -- cgit v1.2.3 From c6e1829e4f5ff75a04300e2fe6fb5633a60348af Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 20 May 2016 07:38:39 +0900 Subject: use Maybe for stdMirror --- src/Propellor/Property/Sbuild.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 49741ac1..7f53d5b6 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -89,11 +89,10 @@ builtFor :: System -> RevertableProperty DebianLike UnixLike builtFor system = go deleted where go = property' ("sbuild schroot for " ++ show system) $ - \w -> case schrootFromSystem system of - Just s -> ensureProperty w $ - setupRevertableProperty $ - built s (stdMirror system) - Nothing -> errorMessage + \w -> case (schrootFromSystem system, stdMirror system) of + (Just s, Just u) -> ensureProperty w $ + setupRevertableProperty $ built s u + _ -> errorMessage ("don't know how to debootstrap " ++ show system) deleted = property' ("no sbuild schroot for " ++ show system) $ \w -> case schrootFromSystem system of @@ -258,9 +257,10 @@ schrootFromSystem system@(System _ arch) = extractSuite system >>= \suite -> return $ SbuildSchroot suite arch -stdMirror :: System -> Apt.Url -stdMirror (System (Debian _) _) = "http://httpredir.debian.org/debian" -stdMirror (System (Buntish _) _) = "mirror://mirrors.ubuntu.com/" +stdMirror :: System -> Maybe Apt.Url +stdMirror (System (Debian _) _) = Just "http://httpredir.debian.org/debian" +stdMirror (System (Buntish _) _) = Just "mirror://mirrors.ubuntu.com/" +stdMirror _ = Nothing schrootRoot :: SbuildSchroot -> FilePath schrootRoot (SbuildSchroot s a) = "/srv/chroot" s ++ "-" ++ a -- cgit v1.2.3 From 6eb8e9fedfa4a1b12f1f2a48791f10132b76d012 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 20 May 2016 07:42:00 +0900 Subject: redundant bracket --- src/Propellor/Property/Sbuild.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 7f53d5b6..72f224f0 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -223,7 +223,7 @@ keypairGenerated = check (not <$> doesFileExist secKeyFile) $ go -- another script from wiki.d.o/sbuild ccachePrepared :: Property DebianLike ccachePrepared = propertyList "sbuild group ccache configured" $ props - & (Group "sbuild") `Ccache.hasGroupCache` "2G" + & Group "sbuild" `Ccache.hasGroupCache` "2G" & "/etc/schroot/sbuild/fstab" `File.containsLine` "/var/cache/ccache-sbuild /var/cache/ccache-sbuild rw,bind 0 0" & "/var/cache/ccache-sbuild/sbuild-setup" `File.hasContent` -- cgit v1.2.3 From fb527146c7f48231dc6d430179d06d4b9ffa96fe Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 20 May 2016 07:54:49 +0900 Subject: fix warnings about throwing away do results --- src/Propellor/Property/Sbuild.hs | 37 ++++++++++++++++++------------------- 1 file changed, 18 insertions(+), 19 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 72f224f0..bd3c9056 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -104,8 +104,8 @@ builtFor system = go deleted built :: SbuildSchroot -> Apt.Url -> RevertableProperty DebianLike UnixLike built s@(SbuildSchroot suite arch) mirror = (go - `requires` keypairGenerated - `requires` ccachePrepared + `requires` keypairGenerated + `requires` ccachePrepared `requires` installed) deleted where @@ -122,24 +122,24 @@ built s@(SbuildSchroot suite arch) mirror = , mirror ] ifM (liftIO $ boolSystemEnv "sbuild-createchroot" params (Just de)) - ( do - ensureProperty w $ fixConfFile s - -- if we just built a sid chroot, add useful aliases - if suite == "unstable" - then ensureProperty w aliasesLine - else noChange - -- enable ccache and eatmydata for speed - ensureProperty w commandPrefix - return MadeChange + ( ensureProperty w $ + fixConfFile s + `before` aliasesLine + `before` commandPrefix , return FailedChange ) deleted = check (doesDirectoryExist (schrootRoot s)) $ - property' ("no sbuild schroot for " ++ show s) $ \w -> do - ensureProperty w $ File.notPresent (schrootConf s) - makeChange (removeChroot $ schrootRoot s) + property ("no sbuild schroot for " ++ show s) $ do + liftIO $ removeChroot $ schrootRoot s + makeChange $ nukeFile (schrootConf s) - aliasesLine = File.containsLine (schrootConf s) - "aliases=UNRELEASED,sid,rc-buggy,experimental" + -- if we're building a sid chroot, add useful aliases + aliasesLine :: Property UnixLike + aliasesLine = if suite == "unstable" + then File.containsLine (schrootConf s) + "aliases=UNRELEASED,sid,rc-buggy,experimental" + else doNothing + -- enable ccache and eatmydata for speed commandPrefix = File.containsLine (schrootConf s) "command-prefix=/var/cache/ccache-sbuild/sbuild-setup,eatmydata" @@ -181,10 +181,9 @@ fixConfFile s@(SbuildSchroot suite arch) = property' ("schroot for " ++ show s ++ " config file fixed") $ \w -> do confs <- liftIO $ dirContents dir let old = concat $ filter (tempPrefix `isPrefixOf`) confs - ensureProperty w $ - File.fileProperty "replace dummy suffix" (map munge) old liftIO $ moveFile old new - return MadeChange + ensureProperty w $ + File.fileProperty "replace dummy suffix" (map munge) new where new = schrootConf s dir = takeDirectory new -- cgit v1.2.3 From d96ad0a71c95066980fd65cb9d8cc0b662c669e3 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 20 May 2016 07:57:18 +0900 Subject: ispartial check from Debootstrap.hs --- src/Propellor/Property/Sbuild.hs | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index bd3c9056..92e76e08 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -110,7 +110,7 @@ built s@(SbuildSchroot suite arch) mirror = deleted where go :: Property DebianLike - go = check (not <$> doesDirectoryExist (schrootRoot s)) $ + go = check (unpopulated (schrootRoot s) <||> ispartial) $ property' ("built sbuild schroot for " ++ show s) make make w = do de <- liftIO standardPathEnv @@ -128,7 +128,7 @@ built s@(SbuildSchroot suite arch) mirror = `before` commandPrefix , return FailedChange ) - deleted = check (doesDirectoryExist (schrootRoot s)) $ + deleted = check (not <$> unpopulated (schrootRoot s)) $ property ("no sbuild schroot for " ++ show s) $ do liftIO $ removeChroot $ schrootRoot s makeChange $ nukeFile (schrootConf s) @@ -143,6 +143,15 @@ built s@(SbuildSchroot suite arch) mirror = commandPrefix = File.containsLine (schrootConf s) "command-prefix=/var/cache/ccache-sbuild/sbuild-setup,eatmydata" + -- A failed debootstrap run will leave a debootstrap directory; + -- recover by deleting it and trying again. + ispartial = ifM (doesDirectoryExist (schrootRoot s "debootstrap")) + ( do + removeChroot $ schrootRoot s + return True + , return False + ) + -- | 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 d4ad2ab2f10b5146d7ec26372b944e5eb79b5e54 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 20 May 2016 08:00:45 +0900 Subject: fix example sbuild config --- src/Propellor/Property/Sbuild.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 92e76e08..19949974 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -8,8 +8,8 @@ Build and maintain schroots for use with sbuild. Suggested usage in @config.hs@: -> & Sbuild.builtFor ((Debian Unstable) "i386") -> & Sbuild.updatedFor ((Debian Unstable) "i386") `period` Weekly +> & Sbuild.builtFor (System (Debian Unstable) "i386") +> & Sbuild.updatedFor (System (Debian Unstable) "i386") `period` Weekly 1 > & Sbuild.usableBy (User "spwhitton") > & Sbuild.shareAptCache > & Sbuild.blockNetwork -- cgit v1.2.3 From 79acb87c2c52d6ad071ad30bd2afb82fc4a2635a Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 09:15:29 +0900 Subject: need piuparts installed if using my .sbuildrc --- src/Propellor/Property/Sbuild.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 19949974..21fdbfe2 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -8,6 +8,7 @@ Build and maintain schroots for use with sbuild. Suggested usage in @config.hs@: +> & Apt.installed ["piuparts"] > & Sbuild.builtFor (System (Debian Unstable) "i386") > & Sbuild.updatedFor (System (Debian Unstable) "i386") `period` Weekly 1 > & Sbuild.usableBy (User "spwhitton") @@ -255,8 +256,9 @@ ccachePrepared = propertyList "sbuild group ccache configured" $ props blockNetwork :: Property Linux blockNetwork = Firewall.rule Firewall.OUTPUT Firewall.Filter Firewall.DROP $ Firewall.GroupOwner (Group "sbuild") - `mappend` Firewall.NotDestination + <> Firewall.NotDestination [Firewall.IPWithNumMask (IPv4 "127.0.0.1") 8] + `requires` installed -- sbuild group must exist -- ==== utility functions ==== -- cgit v1.2.3 From 04b11368f75c05f56f2ec5469c22e88f55ddf276 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 09:42:49 +0900 Subject: sbuild-createchroot needs the suite, whoops --- src/Propellor/Property/Sbuild.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 21fdbfe2..1d59fbec 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -119,6 +119,7 @@ built s@(SbuildSchroot suite arch) mirror = [ "--arch=" ++ arch , "--chroot-suffix=propellor" , "--include=eatmydata,ccache" + , suite , schrootRoot s , mirror ] -- cgit v1.2.3 From bc26ebc31bcb286a9e5991f65e0be49e0e7facf6 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 09:44:36 +0900 Subject: Sbuild.blockNetwork bracketing --- src/Propellor/Property/Sbuild.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 1d59fbec..1d18a6de 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -255,10 +255,10 @@ ccachePrepared = propertyList "sbuild group ccache configured" $ props -- This is a hack from until #802850 and -- #802849 are resolved. blockNetwork :: Property Linux -blockNetwork = Firewall.rule Firewall.OUTPUT Firewall.Filter Firewall.DROP $ - Firewall.GroupOwner (Group "sbuild") +blockNetwork = Firewall.rule Firewall.OUTPUT Firewall.Filter Firewall.DROP + (Firewall.GroupOwner (Group "sbuild") <> Firewall.NotDestination - [Firewall.IPWithNumMask (IPv4 "127.0.0.1") 8] + [Firewall.IPWithNumMask (IPv4 "127.0.0.1") 8]) `requires` installed -- sbuild group must exist -- ==== utility functions ==== -- cgit v1.2.3 From 71f54f79a044e5231d06c2b2d92ba579922d4f79 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 09:48:44 +0900 Subject: line length --- src/Propellor/Property/Sbuild.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 1d18a6de..bc9511e8 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -123,7 +123,8 @@ built s@(SbuildSchroot suite arch) mirror = , schrootRoot s , mirror ] - ifM (liftIO $ boolSystemEnv "sbuild-createchroot" params (Just de)) + ifM (liftIO $ + boolSystemEnv "sbuild-createchroot" params (Just de)) ( ensureProperty w $ fixConfFile s `before` aliasesLine @@ -162,7 +163,8 @@ updatedFor :: System -> Property DebianLike updatedFor system = property' ("updated sbuild schroot for " ++ show system) $ \w -> case schrootFromSystem system of Just s -> ensureProperty w $ updated s - Nothing -> errorMessage ("don't know how to debootstrap " ++ show system) + Nothing -> errorMessage + ("don't know how to debootstrap " ++ show system) -- | Ensure that an sbuild schroot's packages and apt indexes are updated updated :: SbuildSchroot -> Property DebianLike -- cgit v1.2.3 From 9c2a1ac8efed3ec3b8ef7b9aa776f6d72a7c3330 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 10:06:15 +0900 Subject: fix chroot suffix --- src/Propellor/Property/Sbuild.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index bc9511e8..3168ffed 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -117,7 +117,7 @@ built s@(SbuildSchroot suite arch) mirror = de <- liftIO standardPathEnv let params = Param <$> [ "--arch=" ++ arch - , "--chroot-suffix=propellor" + , "--chroot-suffix=-propellor" , "--include=eatmydata,ccache" , suite , schrootRoot s -- cgit v1.2.3 From 76cc003f421a30f2d380a4f619812466cfa1dc8a Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 11:32:36 +0900 Subject: fix ccache mount and line length --- src/Propellor/Property/Sbuild.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 3168ffed..202108a4 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -87,16 +87,16 @@ instance Show SbuildSchroot where -- This function is a convenience wrapper around 'Sbuild.builtFor', allowing the -- user to identify the schroot and distribution using the 'System' type builtFor :: System -> RevertableProperty DebianLike UnixLike -builtFor system = go deleted +builtFor sys = go deleted where - go = property' ("sbuild schroot for " ++ show system) $ - \w -> case (schrootFromSystem system, stdMirror system) of + go = property' ("sbuild schroot for " ++ show sys) $ + \w -> case (schrootFromSystem sys, stdMirror sys) of (Just s, Just u) -> ensureProperty w $ setupRevertableProperty $ built s u _ -> errorMessage - ("don't know how to debootstrap " ++ show system) - deleted = property' ("no sbuild schroot for " ++ show system) $ - \w -> case schrootFromSystem system of + ("don't know how to debootstrap " ++ show sys) + deleted = property' ("no sbuild schroot for " ++ show sys) $ + \w -> case schrootFromSystem sys of Just s -> ensureProperty w $ undoRevertableProperty $ built s "dummy" Nothing -> noChange @@ -237,7 +237,7 @@ ccachePrepared :: Property DebianLike ccachePrepared = propertyList "sbuild group ccache configured" $ props & Group "sbuild" `Ccache.hasGroupCache` "2G" & "/etc/schroot/sbuild/fstab" `File.containsLine` - "/var/cache/ccache-sbuild /var/cache/ccache-sbuild rw,bind 0 0" + "/var/cache/ccache-sbuild /var/cache/ccache-sbuild none rw,bind 0 0" & "/var/cache/ccache-sbuild/sbuild-setup" `File.hasContent` [ "#!/bin/sh" , "" -- cgit v1.2.3 From 60e7991181e6459e2a4f200072190e1cd98caa7d Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 14:01:25 +0900 Subject: also move link in /etc/sbuild/chroot --- src/Propellor/Property/Sbuild.hs | 3 +++ 1 file changed, 3 insertions(+) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 202108a4..64d4911c 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -195,6 +195,9 @@ fixConfFile s@(SbuildSchroot suite arch) = confs <- liftIO $ dirContents dir let old = concat $ filter (tempPrefix `isPrefixOf`) confs liftIO $ moveFile old new + liftIO $ moveFile + ("/etc/sbuild/chroot" show s ++ "-propellor") + ("/etc/sbuild/chroot" show s ++ "-sbuild") ensureProperty w $ File.fileProperty "replace dummy suffix" (map munge) new where -- cgit v1.2.3 From e01ff0ae7718fbddb5e81c3b4d967af90d9d64ba Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 14:35:40 +0900 Subject: and delete it when we nuke the chroot --- src/Propellor/Property/Sbuild.hs | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 64d4911c..996b5619 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -134,6 +134,8 @@ built s@(SbuildSchroot suite arch) mirror = deleted = check (not <$> unpopulated (schrootRoot s)) $ property ("no sbuild schroot for " ++ show s) $ do liftIO $ removeChroot $ schrootRoot s + liftIO $ nukeFile + ("/etc/sbuild/chroot" show s ++ "-sbuild") makeChange $ nukeFile (schrootConf s) -- if we're building a sid chroot, add useful aliases -- cgit v1.2.3 From 10f3c2db21a4b5c53d2575977cc1228fb71c9bc8 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 20:04:25 +0900 Subject: generalise setting limit on ccache --- src/Propellor/Property/Ccache.hs | 43 ++++++++++++++++++++++++++++++---------- 1 file changed, 32 insertions(+), 11 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs index 6ee796f0..d9b2e458 100644 --- a/src/Propellor/Property/Ccache.hs +++ b/src/Propellor/Property/Ccache.hs @@ -9,31 +9,52 @@ import qualified Propellor.Property.Apt as Apt import Utility.FileMode import System.Posix.Files +-- | Limits on the size of a ccache +data CcacheLimit + -- | The maximum size of the cache, as a string such as "4G" + -- + -- See ccache(1) for more on the size specification. + = MaxSize String + -- | The maximum number of files in the cache + | MaxFiles Int + -- | A cache with no limit specified + | NoLimit + -- | Configures a ccache in /var/cache for a group -- -- If you say -- --- > & (Group "foo") `Ccache.hasGroupCache` "4G" +-- > & (Group "foo") `Ccache.hasGroupCache` (Ccache.MaxSize "4g") -- -- you instruct propellor to create a ccache in /var/cache/ccache-foo owned and --- writeable by the foo group, with a maximum cache size of 4GB. See ccache(1) --- for size specification. -hasGroupCache :: Group -> String -> RevertableProperty DebianLike UnixLike -group@(Group g) `hasGroupCache` size = (make `requires` installed) delete +-- writeable by the foo group, with a maximum cache size of 4GB. +-- +-- It is safe to specify this property more than once for a given group if you +-- wish to limit both the maximum size of the cache and the maximum number of +-- files in the cache. However, setting only one of these two limits is +-- generally sufficient. +hasGroupCache :: Group -> CcacheLimit -> RevertableProperty DebianLike UnixLike +group@(Group g) `hasGroupCache` limit = (make `requires` installed) delete where - path = "/var/cache/ccache-" ++ g - make = check (not <$> doesDirectoryExist path) $ - propertyList ("ccache for " ++ g ++ " exists") $ props + make = propertyList ("ccache for " ++ g ++ " exists") $ props & File.dirExists path & File.ownerGroup path (User "root") group & File.mode path (combineModes $ readModes ++ executeModes - ++ [ownerWriteMode, groupWriteMode]) - & cmdProperty "ccache" ["--max-size", size] - `assume` MadeChange + ++ [ownerWriteMode, groupWriteMode]) + & case limit of + NoLimit -> doNothing + MaxSize s -> setSizeLimit s + MaxFiles f -> setFileLimit (show f) + delete = check (doesDirectoryExist path) $ cmdProperty "rm" ["-r", path] `assume` MadeChange `describe` ("ccache for " ++ g ++ " does not exist") + setSizeLimit s = conf `File.containsLine` ("max_size = " ++ s) + setFileLimit f = conf `File.containsLine` ("max_files = " ++ f) + path = "/var/cache/ccache-" ++ g + conf = path "ccache.conf" + installed :: Property DebianLike installed = Apt.installed ["ccache"] -- cgit v1.2.3 From 4a53b158a2b6ca5e64f45058b2e26fe0a0c579e9 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 20:09:31 +0900 Subject: update Sbuild.hs for new Ccache.hs --- src/Propellor/Property/Ccache.hs | 4 ++-- src/Propellor/Property/Sbuild.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs index d9b2e458..45208508 100644 --- a/src/Propellor/Property/Ccache.hs +++ b/src/Propellor/Property/Ccache.hs @@ -10,7 +10,7 @@ import Utility.FileMode import System.Posix.Files -- | Limits on the size of a ccache -data CcacheLimit +data Limit -- | The maximum size of the cache, as a string such as "4G" -- -- See ccache(1) for more on the size specification. @@ -33,7 +33,7 @@ data CcacheLimit -- wish to limit both the maximum size of the cache and the maximum number of -- files in the cache. However, setting only one of these two limits is -- generally sufficient. -hasGroupCache :: Group -> CcacheLimit -> RevertableProperty DebianLike UnixLike +hasGroupCache :: Group -> Limit -> RevertableProperty DebianLike UnixLike group@(Group g) `hasGroupCache` limit = (make `requires` installed) delete where make = propertyList ("ccache for " ++ g ++ " exists") $ props diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 996b5619..ecf33712 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -240,7 +240,7 @@ keypairGenerated = check (not <$> doesFileExist secKeyFile) $ go -- another script from wiki.d.o/sbuild ccachePrepared :: Property DebianLike ccachePrepared = propertyList "sbuild group ccache configured" $ props - & Group "sbuild" `Ccache.hasGroupCache` "2G" + & Group "sbuild" `Ccache.hasGroupCache` (Ccache.MaxSize "2G") & "/etc/schroot/sbuild/fstab" `File.containsLine` "/var/cache/ccache-sbuild /var/cache/ccache-sbuild none rw,bind 0 0" & "/var/cache/ccache-sbuild/sbuild-setup" `File.hasContent` -- cgit v1.2.3 From b62279a911eabaa7f2b5223f3736d90004ab7f74 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 20:30:18 +0900 Subject: disable Sbuild.blockNetwork Doesn't seem to have the desired effect at present. --- src/Propellor/Property/Sbuild.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index ecf33712..5c592238 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -13,7 +13,6 @@ Suggested usage in @config.hs@: > & Sbuild.updatedFor (System (Debian Unstable) "i386") `period` Weekly 1 > & Sbuild.usableBy (User "spwhitton") > & Sbuild.shareAptCache -> & Sbuild.blockNetwork > & Schroot.overlaysInTmpfs In @~/.sbuildrc@: @@ -50,7 +49,7 @@ module Propellor.Property.Sbuild ( updated, updatedFor, -- * Global sbuild configuration - blockNetwork, + -- blockNetwork, installed, keypairGenerated, shareAptCache, @@ -257,16 +256,17 @@ ccachePrepared = propertyList "sbuild group ccache configured" $ props & File.mode "/var/cache/ccache-sbuild/sbuild-setup" (combineModes (readModes ++ executeModes)) --- | Block network access during builds --- --- This is a hack from until #802850 and --- #802849 are resolved. -blockNetwork :: Property Linux -blockNetwork = Firewall.rule Firewall.OUTPUT Firewall.Filter Firewall.DROP - (Firewall.GroupOwner (Group "sbuild") - <> Firewall.NotDestination - [Firewall.IPWithNumMask (IPv4 "127.0.0.1") 8]) - `requires` installed -- sbuild group must exist +-- This doesn't seem to work with the current version of sbuild +-- -- | Block network access during builds +-- -- +-- -- This is a hack from until #802850 and +-- -- #802849 are resolved. +-- blockNetwork :: Property Linux +-- blockNetwork = Firewall.rule Firewall.OUTPUT Firewall.Filter Firewall.DROP +-- (Firewall.GroupOwner (Group "sbuild") +-- <> Firewall.NotDestination +-- [Firewall.IPWithNumMask (IPv4 "127.0.0.1") 8]) +-- `requires` installed -- sbuild group must exist -- ==== utility functions ==== -- cgit v1.2.3 From 54983a63d90b18ae464e9014647130e0808f0be1 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 21:36:19 +0900 Subject: piuparts conf properties --- src/Propellor/Property/Sbuild.hs | 89 +++++++++++++++++++++++++++++++++++++--- 1 file changed, 84 insertions(+), 5 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 5c592238..ea12c576 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -10,6 +10,7 @@ Suggested usage in @config.hs@: > & Apt.installed ["piuparts"] > & Sbuild.builtFor (System (Debian Unstable) "i386") +> & Sbuild.piupartsConfFor (System (Debian Unstable) "i386") > & Sbuild.updatedFor (System (Debian Unstable) "i386") `period` Weekly 1 > & Sbuild.usableBy (User "spwhitton") > & Sbuild.shareAptCache @@ -18,7 +19,12 @@ Suggested usage in @config.hs@: In @~/.sbuildrc@: > $run_piuparts = 1; -> $piuparts_opts = ['--schroot=unstable-i386-sbuild']; +> $piuparts_opts = [ +> '--schroot', +> 'unstable-i386-piuparts', +> '--fail-if-inadequate', +> '--fail-on-broken-symlinks', +> ]; > > $external_commands = { > 'post-build-commands' => [ @@ -26,7 +32,13 @@ In @~/.sbuildrc@: > 'adt-run', > '--changes', '%c', > '---', -> 'schroot', 'unstable-i386-sbuild', +> 'schroot', 'unstable-i386-sbuild;', +> +> # if adt-run's exit code is 8 then the package had no tests but +> # this isn't a failure, so catch it +> 'adtexit=$?;', +> 'if', 'test', '$adtexit', '=', '8;', 'then', +> 'exit', '0;', 'else', 'exit', '$adtexit;', 'fi' > ], > ], > }; @@ -48,6 +60,8 @@ module Propellor.Property.Sbuild ( built, updated, updatedFor, + piupartsConfFor, + piupartsConf, -- * Global sbuild configuration -- blockNetwork, installed, @@ -61,8 +75,9 @@ import Propellor.Property.Debootstrap (extractSuite) import Propellor.Property.Chroot.Util import qualified Propellor.Property.Apt as Apt 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.Firewall as Firewall import qualified Propellor.Property.User as User import Utility.FileMode @@ -207,16 +222,76 @@ fixConfFile s@(SbuildSchroot suite arch) = tempPrefix = dir suite ++ "-" ++ arch ++ "-propellor-" munge = replace "-propellor]" "-sbuild]" +-- | 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 +piupartsConfFor :: System -> Property DebianLike +piupartsConfFor sys = property' ("piuparts schroot conf for " ++ show sys) $ + \w -> case (schrootFromSystem sys, stdMirror sys) of + (Just s, Just u) -> ensureProperty w $ + piupartsConf s u + _ -> errorMessage + ("don't know how to debootstrap " ++ show sys) + +-- | Create a corresponding schroot config file for use with piuparts +-- +-- This is useful because: +-- +-- - piuparts will clear out the apt cache which makes '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 +-- piuparts in their @~/.sbuildrc@, which is inconvenient.p +piupartsConf :: SbuildSchroot -> Apt.Url -> Property DebianLike +piupartsConf s u = go + `requires` (setupRevertableProperty $ built s u) + `describe` ("piuparts schroot conf for " ++ show s) + where + go :: Property DebianLike + go = tightenTargets $ + check (not <$> doesFileExist f) create + `before` + ConfFile.containsIniSetting f (sec, "profile", "piuparts") + `before` + ConfFile.containsIniSetting f (sec, "aliases", "") + `before` + ConfFile.containsIniSetting f (sec, "command-prefix", "") + `before` + File.dirExists dir + `before` + File.isSymlinkedTo (dir "copyfiles") + (File.LinkTarget $ orig "copyfiles") + `before` + File.isSymlinkedTo (dir "nssdatabases") + (File.LinkTarget $ orig "nssdatabases") + `before` + File.basedOn (dir "fstab") + (orig "fstab", filter (/= aptCacheLine)) + + create = File.isCopyOf f (schrootConf s) + `before` File.fileProperty "replace suffix" (map munge) f + + orig = "/etc/schroot/chroot.d/sbuild" + dir = "/etc/schroot/chroot.d/piuparts" + sec = show s ++ "-piuparts" + f = schrootPiupartsConf s + munge = replace "-sbuild]" "-piuparts]" + -- | 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 -- dependencies. shareAptCache :: Property DebianLike -shareAptCache = File.containsLine "/etc/schroot/sbuild/fstab" - "/var/cache/apt/archives /var/cache/apt/archives none rw,bind 0 0" +shareAptCache = File.containsLine "/etc/schroot/sbuild/fstab" aptCacheLine `requires` installed +aptCacheLine :: String +aptCacheLine = "/var/cache/apt/archives /var/cache/apt/archives none rw,bind 0 0" + -- | Ensure that sbuild is installed installed :: Property DebianLike installed = Apt.installed ["sbuild"] @@ -286,3 +361,7 @@ schrootRoot (SbuildSchroot s a) = "/srv/chroot" s ++ "-" ++ a schrootConf :: SbuildSchroot -> FilePath schrootConf (SbuildSchroot s a) = "/etc/schroot/chroot.d" s ++ "-" ++ a ++ "-sbuild-propellor" + +schrootPiupartsConf :: SbuildSchroot -> FilePath +schrootPiupartsConf (SbuildSchroot s a) = + "/etc/schroot/chroot.d" s ++ "-" ++ a ++ "-piuparts-propellor" -- cgit v1.2.3 From 405999ff5981bb06f886466a7ec47fc90fa1c4b6 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 21:44:27 +0900 Subject: typo --- src/Propellor/Property/Sbuild.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index ea12c576..ea688f7a 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -244,7 +244,7 @@ piupartsConfFor sys = property' ("piuparts schroot conf for " ++ show sys) $ -- -- - piuparts itself invokes eatmydata, so the command-prefix setting in our -- regular schroot config would force the user to pass --no-eatmydata to --- piuparts in their @~/.sbuildrc@, which is inconvenient.p +-- piuparts in their @~/.sbuildrc@, which is inconvenient. piupartsConf :: SbuildSchroot -> Apt.Url -> Property DebianLike piupartsConf s u = go `requires` (setupRevertableProperty $ built s u) -- cgit v1.2.3 From 0126f29fd30a01f5122b83cd4f6d98c9b7f9d632 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 21:49:10 +0900 Subject: File.isCopyOf usage replaced with cmdProperty File.isCopyOf doesn't work when the first argument doesn't exist yet --- src/Propellor/Property/Sbuild.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index ea688f7a..0449425c 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -271,7 +271,7 @@ piupartsConf s u = go File.basedOn (dir "fstab") (orig "fstab", filter (/= aptCacheLine)) - create = File.isCopyOf f (schrootConf s) + create = cmdProperty "cp" [f, schrootConf s] `assume` MadeChange `before` File.fileProperty "replace suffix" (map munge) f orig = "/etc/schroot/chroot.d/sbuild" -- cgit v1.2.3 From 8a23d2a3aeceb824fb71df4e88010fa6cbd20c0a Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 21:53:33 +0900 Subject: describe Sbuild.shareAptCache --- src/Propellor/Property/Sbuild.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 0449425c..01e106be 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -288,6 +288,7 @@ piupartsConf s u = go shareAptCache :: Property DebianLike shareAptCache = File.containsLine "/etc/schroot/sbuild/fstab" aptCacheLine `requires` installed + `describe` "sbuild schroots share host apt cache" aptCacheLine :: String aptCacheLine = "/var/cache/apt/archives /var/cache/apt/archives none rw,bind 0 0" -- cgit v1.2.3 From 53cda0948dba7a4bf1661c9a27b864b741e39654 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 21:53:43 +0900 Subject: fix cp command --- src/Propellor/Property/Sbuild.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 01e106be..87c93315 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -271,7 +271,7 @@ piupartsConf s u = go File.basedOn (dir "fstab") (orig "fstab", filter (/= aptCacheLine)) - create = cmdProperty "cp" [f, schrootConf s] `assume` MadeChange + create = cmdProperty "cp" [schrootConf s, f] `assume` MadeChange `before` File.fileProperty "replace suffix" (map munge) f orig = "/etc/schroot/chroot.d/sbuild" -- cgit v1.2.3 From 36d005c1bb298d4cf8cf274680d41b90c2425f87 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 22:07:18 +0900 Subject: descs --- src/Propellor/Property/Ccache.hs | 2 +- src/Propellor/Property/Sbuild.hs | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs index 45208508..f511def7 100644 --- a/src/Propellor/Property/Ccache.hs +++ b/src/Propellor/Property/Ccache.hs @@ -36,7 +36,7 @@ data Limit hasGroupCache :: Group -> Limit -> RevertableProperty DebianLike UnixLike group@(Group g) `hasGroupCache` limit = (make `requires` installed) delete where - make = propertyList ("ccache for " ++ g ++ " exists") $ props + make = propertyList ("ccache for " ++ g ++ " group exists") $ props & File.dirExists path & File.ownerGroup path (User "root") group & File.mode path (combineModes $ diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 87c93315..21a1fc8d 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -318,6 +318,7 @@ ccachePrepared = propertyList "sbuild group ccache configured" $ props & Group "sbuild" `Ccache.hasGroupCache` (Ccache.MaxSize "2G") & "/etc/schroot/sbuild/fstab" `File.containsLine` "/var/cache/ccache-sbuild /var/cache/ccache-sbuild none rw,bind 0 0" + `describe` "ccache mounted in sbuild schroots" & "/var/cache/ccache-sbuild/sbuild-setup" `File.hasContent` [ "#!/bin/sh" , "" -- cgit v1.2.3 From efeb73055e557a9fe594323a54d6c959506c3141 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 22:11:41 +0900 Subject: refactor --- src/Propellor/Property/Sbuild.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 21a1fc8d..2fa46216 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -252,7 +252,8 @@ piupartsConf s u = go where go :: Property DebianLike go = tightenTargets $ - check (not <$> doesFileExist f) create + check (not <$> doesFileExist f) + (File.basedOn f (schrootConf s, map munge)) `before` ConfFile.containsIniSetting f (sec, "profile", "piuparts") `before` @@ -271,9 +272,6 @@ piupartsConf s u = go File.basedOn (dir "fstab") (orig "fstab", filter (/= aptCacheLine)) - create = cmdProperty "cp" [schrootConf s, f] `assume` MadeChange - `before` File.fileProperty "replace suffix" (map munge) f - orig = "/etc/schroot/chroot.d/sbuild" dir = "/etc/schroot/chroot.d/piuparts" sec = show s ++ "-piuparts" -- cgit v1.2.3 From e97a0e5fc687753a1b4e5c3c325f3b4994de57aa Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 22:13:12 +0900 Subject: fix paths to schroot profiles --- src/Propellor/Property/Sbuild.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 2fa46216..fe22c038 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -272,8 +272,8 @@ piupartsConf s u = go File.basedOn (dir "fstab") (orig "fstab", filter (/= aptCacheLine)) - orig = "/etc/schroot/chroot.d/sbuild" - dir = "/etc/schroot/chroot.d/piuparts" + orig = "/etc/schroot/sbuild" + dir = "/etc/schroot/piuparts" sec = show s ++ "-piuparts" f = schrootPiupartsConf s munge = replace "-sbuild]" "-piuparts]" -- cgit v1.2.3 From 238881d0686e1e49754a45f780a6100239fa8876 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 21 May 2016 22:25:54 +0900 Subject: desc --- src/Propellor/Property/Schroot.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Schroot.hs b/src/Propellor/Property/Schroot.hs index 8e6ce4e6..c53ce4f1 100644 --- a/src/Propellor/Property/Schroot.hs +++ b/src/Propellor/Property/Schroot.hs @@ -36,6 +36,7 @@ overlaysInTmpfs = go `requires` installed , "fi" ] `onChange` (f `File.mode` (combineModes (readModes ++ executeModes))) + `describe` "schroot overlays in tmpfs" installed :: Property DebianLike installed = Apt.installed ["schroot"] -- cgit v1.2.3 From 0a5bd1b3ff4f211db9d29ce2a1b9271e836268f6 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 22 May 2016 08:35:58 +0900 Subject: hasGroupCache -> hasCache I was originally thinking that the name `Ccache.hasCache` might be for a property `User -> Property DebianLike`. However, someone wanted to write a property configuring a user cache, it would probably have the standard location `~/.ccache`. This cache would be implicitly created when required, so the name `Ccache.hasCache` would be needed. --- src/Propellor/Property/Ccache.hs | 4 ++-- src/Propellor/Property/Sbuild.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs index f511def7..b721e684 100644 --- a/src/Propellor/Property/Ccache.hs +++ b/src/Propellor/Property/Ccache.hs @@ -33,8 +33,8 @@ data Limit -- wish to limit both the maximum size of the cache and the maximum number of -- files in the cache. However, setting only one of these two limits is -- generally sufficient. -hasGroupCache :: Group -> Limit -> RevertableProperty DebianLike UnixLike -group@(Group g) `hasGroupCache` limit = (make `requires` installed) delete +hasCache :: Group -> Limit -> RevertableProperty DebianLike UnixLike +group@(Group g) `hasCache` limit = (make `requires` installed) delete where make = propertyList ("ccache for " ++ g ++ " group exists") $ props & File.dirExists path diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index fe22c038..df9c5a37 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -313,7 +313,7 @@ keypairGenerated = check (not <$> doesFileExist secKeyFile) $ go -- another script from wiki.d.o/sbuild ccachePrepared :: Property DebianLike ccachePrepared = propertyList "sbuild group ccache configured" $ props - & Group "sbuild" `Ccache.hasGroupCache` (Ccache.MaxSize "2G") + & Group "sbuild" `Ccache.hasCache` (Ccache.MaxSize "2G") & "/etc/schroot/sbuild/fstab" `File.containsLine` "/var/cache/ccache-sbuild /var/cache/ccache-sbuild none rw,bind 0 0" `describe` "ccache mounted in sbuild schroots" -- cgit v1.2.3 From 8ed862f8239d5a5ec4cfa1e5dea24add38038ab1 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 22 May 2016 09:11:07 +0900 Subject: start reworking Ccache.Limit to Utility.DataSize --- src/Propellor/Property/Ccache.hs | 71 +++++++++++++++++++++++++++++----------- 1 file changed, 52 insertions(+), 19 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs index b721e684..692fea0f 100644 --- a/src/Propellor/Property/Ccache.hs +++ b/src/Propellor/Property/Ccache.hs @@ -1,38 +1,77 @@ -- | Maintainer: Sean Whitton -module Propellor.Property.Ccache where +module Propellor.Property.Ccache ( + hasCache, + hasLimits, + Limit(..), + DataSize, +) where import Propellor.Base import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import Utility.FileMode +import Utility.DataUnits import System.Posix.Files -- | Limits on the size of a ccache data Limit -- | The maximum size of the cache, as a string such as "4G" - -- - -- See ccache(1) for more on the size specification. - = MaxSize String + = MaxSize DataSize -- | The maximum number of files in the cache - | MaxFiles Int + | MaxFiles Integer -- | A cache with no limit specified | NoLimit + | Limit :+ Limit + +instance Monoid Limit where + mempty = NoLimit + mappend = (:+) + +-- | A string that will be parsed to get a data size. +-- +-- Examples: "100 megabytes" or "0.5tb" +type DataSize = String + +maxSizeParam :: DataSize -> Maybe String +maxSizeParam s = readSize dataUnits s + >>= \sz -> Just $ "--max-size=" ++ ccacheSizeUnits sz + +-- Generates size units as used in ccache.conf. The smallest unit we can +-- specify in a ccache config files is a kilobyte +ccacheSizeUnits :: Integer -> String +ccacheSizeUnits sz = filter (/= ' ') (roughSize cfgfileunits True sz) + where + cfgfileunits :: [Unit] + cfgfileunits = + [ Unit (p 4) "Ti" "terabyte" + , Unit (p 3) "Gi" "gigabyte" + , Unit (p 2) "Mi" "megabyte" + , Unit (p 1) "Ki" "kilobyte" + ] + p :: Integer -> Integer + p n = 1024^n + +-- | Set limits on a given ccache. +hasLimits :: FilePath -> Limit -> Property UnixLike +hasLimits = undefined + +-- limitToParams :: Limit -> [String] +-- limitToParams NoLimit = [] +-- limitToParams (MaxSize s) = +-- limitToParams (MaxFiles f) = +-- limitToParams (l1 :+ l2) = limitToParams l1 <> limitToParams l2 -- | Configures a ccache in /var/cache for a group -- -- If you say -- --- > & (Group "foo") `Ccache.hasGroupCache` (Ccache.MaxSize "4g") +-- > & (Group "foo") `Ccache.hasGroupCache` (Ccache.MaxSize "4G" +-- <> Ccache.MaxFiles 10000) -- -- you instruct propellor to create a ccache in /var/cache/ccache-foo owned and --- writeable by the foo group, with a maximum cache size of 4GB. --- --- It is safe to specify this property more than once for a given group if you --- wish to limit both the maximum size of the cache and the maximum number of --- files in the cache. However, setting only one of these two limits is --- generally sufficient. +-- writeable by the foo group, with a maximum cache size of 4GB or 10000 files. hasCache :: Group -> Limit -> RevertableProperty DebianLike UnixLike group@(Group g) `hasCache` limit = (make `requires` installed) delete where @@ -42,19 +81,13 @@ group@(Group g) `hasCache` limit = (make `requires` installed) delete & File.mode path (combineModes $ readModes ++ executeModes ++ [ownerWriteMode, groupWriteMode]) - & case limit of - NoLimit -> doNothing - MaxSize s -> setSizeLimit s - MaxFiles f -> setFileLimit (show f) + & hasLimits path limit delete = check (doesDirectoryExist path) $ cmdProperty "rm" ["-r", path] `assume` MadeChange `describe` ("ccache for " ++ g ++ " does not exist") - setSizeLimit s = conf `File.containsLine` ("max_size = " ++ s) - setFileLimit f = conf `File.containsLine` ("max_files = " ++ f) path = "/var/cache/ccache-" ++ g - conf = path "ccache.conf" installed :: Property DebianLike installed = Apt.installed ["ccache"] -- cgit v1.2.3 From 52505a7d9f85e82fc2c50565f6646b441e0faf53 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 22 May 2016 09:32:05 +0900 Subject: property to set the limits filled out --- src/Propellor/Property/Ccache.hs | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs index 692fea0f..8b6ddb5a 100644 --- a/src/Propellor/Property/Ccache.hs +++ b/src/Propellor/Property/Ccache.hs @@ -14,6 +14,7 @@ import qualified Propellor.Property.Apt as Apt import Utility.FileMode import Utility.DataUnits import System.Posix.Files +import Data.Either -- | Limits on the size of a ccache data Limit @@ -55,20 +56,33 @@ ccacheSizeUnits sz = filter (/= ' ') (roughSize cfgfileunits True sz) -- | Set limits on a given ccache. hasLimits :: FilePath -> Limit -> Property UnixLike -hasLimits = undefined +path `hasLimits` limit = property' ("limits set on ccache " ++ path) $ + \w -> if null errors + -- We invoke ccache itself to set the limits, so that it can handle + -- replacing old limits in the config file, duplicates etc. + then ensureProperty w $ + cmdPropertyEnv "ccache" params' [("CCACHE_DIR", path)] + `changesFile` (path "ccache.conf") + else sequence_ (errorMessage <$> errors) + >> return FailedChange + where + params = limitToParams limit + (errors, params') = partitionEithers params --- limitToParams :: Limit -> [String] --- limitToParams NoLimit = [] --- limitToParams (MaxSize s) = --- limitToParams (MaxFiles f) = --- limitToParams (l1 :+ l2) = limitToParams l1 <> limitToParams l2 +limitToParams :: Limit -> [Either String String] +limitToParams NoLimit = [] +limitToParams (MaxSize s) = case maxSizeParam s of + Just param -> [Right param] + Nothing -> [Left $ "unable to parse data size " ++ s] +limitToParams (MaxFiles f) = [Right $ "--max-files=" ++ show f] +limitToParams (l1 :+ l2) = limitToParams l1 <> limitToParams l2 -- | Configures a ccache in /var/cache for a group -- -- If you say -- -- > & (Group "foo") `Ccache.hasGroupCache` (Ccache.MaxSize "4G" --- <> Ccache.MaxFiles 10000) +-- > <> Ccache.MaxFiles 10000) -- -- you instruct propellor to create a ccache in /var/cache/ccache-foo owned and -- writeable by the foo group, with a maximum cache size of 4GB or 10000 files. -- cgit v1.2.3 From 4d6e5dcab821bc618dedc515b817db3a79e5bc84 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 22 May 2016 09:51:53 +0900 Subject: consistency --- src/Propellor/Property/Ccache.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs index 8b6ddb5a..1b0f8332 100644 --- a/src/Propellor/Property/Ccache.hs +++ b/src/Propellor/Property/Ccache.hs @@ -54,7 +54,7 @@ ccacheSizeUnits sz = filter (/= ' ') (roughSize cfgfileunits True sz) p :: Integer -> Integer p n = 1024^n --- | Set limits on a given ccache. +-- | Set limits on a given ccache hasLimits :: FilePath -> Limit -> Property UnixLike path `hasLimits` limit = property' ("limits set on ccache " ++ path) $ \w -> if null errors -- cgit v1.2.3 From 47fbeac70e53e97d0ea42fafad8078c0d9d4d9f7 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 22 May 2016 09:59:10 +0900 Subject: hasLimits requires installed --- src/Propellor/Property/Ccache.hs | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs index 1b0f8332..89fcd54c 100644 --- a/src/Propellor/Property/Ccache.hs +++ b/src/Propellor/Property/Ccache.hs @@ -55,17 +55,21 @@ ccacheSizeUnits sz = filter (/= ' ') (roughSize cfgfileunits True sz) p n = 1024^n -- | Set limits on a given ccache -hasLimits :: FilePath -> Limit -> Property UnixLike -path `hasLimits` limit = property' ("limits set on ccache " ++ path) $ - \w -> if null errors - -- We invoke ccache itself to set the limits, so that it can handle - -- replacing old limits in the config file, duplicates etc. - then ensureProperty w $ - cmdPropertyEnv "ccache" params' [("CCACHE_DIR", path)] - `changesFile` (path "ccache.conf") - else sequence_ (errorMessage <$> errors) - >> return FailedChange +hasLimits :: FilePath -> Limit -> Property DebianLike +path `hasLimits` limit = go `requires` installed where + go :: Property DebianLike + go = property' ("limits set on ccache " ++ path) $ + \w -> if null errors + -- We invoke ccache itself to set the limits, so that it can + -- handle replacing old limits in the config file, duplicates + -- etc. + then ensureProperty w $ + cmdPropertyEnv "ccache" params' [("CCACHE_DIR", path)] + `changesFile` (path "ccache.conf") + else sequence_ (errorMessage <$> errors) + >> return FailedChange + params = limitToParams limit (errors, params') = partitionEithers params -- cgit v1.2.3 From 185a53d48b58c089eb9de3a8a1b47347841a65e8 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 22 May 2016 10:21:52 +0900 Subject: be more careful setting sbuild ccache limits --- src/Propellor/Property/Sbuild.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index df9c5a37..2cbe532a 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -313,7 +313,11 @@ keypairGenerated = check (not <$> doesFileExist secKeyFile) $ go -- another script from wiki.d.o/sbuild ccachePrepared :: Property DebianLike ccachePrepared = propertyList "sbuild group ccache configured" $ props - & Group "sbuild" `Ccache.hasCache` (Ccache.MaxSize "2G") + -- We only set a limit on the cache if it doesn't already exist, so the + -- user can override our default limit + & check (not <$> doesDirectoryExist "/var/cache/ccache-sbuild") + (Ccache.hasLimits "/var/cache/ccache-sbuild" (Ccache.MaxSize "2G")) + `before` Ccache.hasCache (Group "sbuild") Ccache.NoLimit & "/etc/schroot/sbuild/fstab" `File.containsLine` "/var/cache/ccache-sbuild /var/cache/ccache-sbuild none rw,bind 0 0" `describe` "ccache mounted in sbuild schroots" -- cgit v1.2.3 From b6f3970c83e943770e2d6afdb12591dae5a567fd Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 22 May 2016 10:33:16 +0900 Subject: don't invoke ccache with no params --- src/Propellor/Property/Ccache.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs index 89fcd54c..a8cc36f1 100644 --- a/src/Propellor/Property/Ccache.hs +++ b/src/Propellor/Property/Ccache.hs @@ -14,7 +14,6 @@ import qualified Propellor.Property.Apt as Apt import Utility.FileMode import Utility.DataUnits import System.Posix.Files -import Data.Either -- | Limits on the size of a ccache data Limit @@ -58,16 +57,17 @@ ccacheSizeUnits sz = filter (/= ' ') (roughSize cfgfileunits True sz) hasLimits :: FilePath -> Limit -> Property DebianLike path `hasLimits` limit = go `requires` installed where - go :: Property DebianLike - go = property' ("limits set on ccache " ++ path) $ - \w -> if null errors + go + | null params' = doNothing -- We invoke ccache itself to set the limits, so that it can -- handle replacing old limits in the config file, duplicates -- etc. - then ensureProperty w $ + | null errors = cmdPropertyEnv "ccache" params' [("CCACHE_DIR", path)] `changesFile` (path "ccache.conf") - else sequence_ (errorMessage <$> errors) + `describe` "h" + | otherwise = property "couldn't parse ccache limits" $ + sequence_ (errorMessage <$> errors) >> return FailedChange params = limitToParams limit -- cgit v1.2.3 From 71c40ba6d6bc7a74813f7fdef5964e85fe251ea1 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 22 May 2016 10:35:18 +0900 Subject: rm dummy desc --- src/Propellor/Property/Ccache.hs | 1 - 1 file changed, 1 deletion(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs index a8cc36f1..b8fa0d85 100644 --- a/src/Propellor/Property/Ccache.hs +++ b/src/Propellor/Property/Ccache.hs @@ -65,7 +65,6 @@ path `hasLimits` limit = go `requires` installed | null errors = cmdPropertyEnv "ccache" params' [("CCACHE_DIR", path)] `changesFile` (path "ccache.conf") - `describe` "h" | otherwise = property "couldn't parse ccache limits" $ sequence_ (errorMessage <$> errors) >> return FailedChange -- cgit v1.2.3 From 0b17dee7b9ea38e7d0342189cd16b19731fa2f61 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 22 May 2016 10:42:21 +0900 Subject: changesFile -> changesFileContent --- src/Propellor/Property/Ccache.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs index b8fa0d85..ce5e836c 100644 --- a/src/Propellor/Property/Ccache.hs +++ b/src/Propellor/Property/Ccache.hs @@ -64,7 +64,7 @@ path `hasLimits` limit = go `requires` installed -- etc. | null errors = cmdPropertyEnv "ccache" params' [("CCACHE_DIR", path)] - `changesFile` (path "ccache.conf") + `changesFileContent` (path "ccache.conf") | otherwise = property "couldn't parse ccache limits" $ sequence_ (errorMessage <$> errors) >> return FailedChange -- cgit v1.2.3 From 97dab8b3136f3fb9c77b25f180ecb7b89e876e44 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 23 May 2016 07:24:54 +0900 Subject: copy sample piuparts conf doc --- src/Propellor/Property/Sbuild.hs | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 2cbe532a..2647e69e 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -226,7 +226,8 @@ fixConfFile s@(SbuildSchroot suite arch) = -- -- 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 +-- 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 @@ -239,12 +240,23 @@ 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 '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 -- piuparts in their @~/.sbuildrc@, which is inconvenient. +-- +-- To make use of this new schroot config, you can put something like this in +-- your ~/.sbuildrc: +-- +-- > $run_piuparts = 1; +-- > $piuparts_opts = [ +-- > '--schroot', +-- > 'unstable-i386-piuparts', +-- > '--fail-if-inadequate', +-- > '--fail-on-broken-symlinks', +-- > ]; piupartsConf :: SbuildSchroot -> Apt.Url -> Property DebianLike piupartsConf s u = go `requires` (setupRevertableProperty $ built s u) -- cgit v1.2.3