summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2016-05-23 11:19:21 -0400
committerJoey Hess2016-05-23 11:19:21 -0400
commit96b92edc63a6754f6574325a700b2f1ebea59c59 (patch)
tree92e394ee1862015e207f26413a87d77dd8225b24
parent7024be7db4021f059380afde9a0f48b99d456bf4 (diff)
parent83c65ad3b4dc3c3c54a0c2c99bf7566739a4a01a (diff)
Merge remote-tracking branch 'spwhitton/sbuild'
-rw-r--r--propellor.cabal3
-rw-r--r--src/Propellor/Property/Ccache.hs110
-rw-r--r--src/Propellor/Property/Debootstrap.hs1
-rw-r--r--src/Propellor/Property/Firewall.hs13
-rw-r--r--src/Propellor/Property/Sbuild.hs383
-rw-r--r--src/Propellor/Property/Schroot.hs42
6 files changed, 552 insertions, 0 deletions
diff --git a/propellor.cabal b/propellor.cabal
index e6279aef..670676df 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -82,6 +82,7 @@ Library
Propellor.Property.Apt.PPA
Propellor.Property.Attic
Propellor.Property.Borg
+ Propellor.Property.Ccache
Propellor.Property.Cmd
Propellor.Property.Concurrent
Propellor.Property.Conductor
@@ -127,7 +128,9 @@ Library
Propellor.Property.Prosody
Propellor.Property.Reboot
Propellor.Property.Rsync
+ Propellor.Property.Sbuild
Propellor.Property.Scheduled
+ Propellor.Property.Schroot
Propellor.Property.Service
Propellor.Property.Ssh
Propellor.Property.Sudo
diff --git a/src/Propellor/Property/Ccache.hs b/src/Propellor/Property/Ccache.hs
new file mode 100644
index 00000000..ce5e836c
--- /dev/null
+++ b/src/Propellor/Property/Ccache.hs
@@ -0,0 +1,110 @@
+-- | Maintainer: Sean Whitton <spwhitton@spwhitton.name>
+
+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"
+ = MaxSize DataSize
+ -- | The maximum number of files in the cache
+ | 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 DebianLike
+path `hasLimits` limit = go `requires` installed
+ where
+ 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.
+ | null errors =
+ cmdPropertyEnv "ccache" params' [("CCACHE_DIR", path)]
+ `changesFileContent` (path </> "ccache.conf")
+ | otherwise = property "couldn't parse ccache limits" $
+ sequence_ (errorMessage <$> errors)
+ >> return FailedChange
+
+ params = limitToParams limit
+ (errors, params') = partitionEithers params
+
+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)
+--
+-- 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.
+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
+ & File.ownerGroup path (User "root") group
+ & File.mode path (combineModes $
+ readModes ++ executeModes
+ ++ [ownerWriteMode, groupWriteMode])
+ & hasLimits path limit
+
+ delete = check (doesDirectoryExist path) $
+ cmdProperty "rm" ["-r", path] `assume` MadeChange
+ `describe` ("ccache for " ++ g ++ " does not exist")
+
+ path = "/var/cache/ccache-" ++ g
+
+installed :: Property DebianLike
+installed = Apt.installed ["ccache"]
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,
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)
diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs
new file mode 100644
index 00000000..2647e69e
--- /dev/null
+++ b/src/Propellor/Property/Sbuild.hs
@@ -0,0 +1,383 @@
+{-# OPTIONS_HADDOCK prune #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{-|
+Maintainer: Sean Whitton <spwhitton@spwhitton.name>
+
+Build and maintain schroots for use with sbuild.
+
+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
+> & Schroot.overlaysInTmpfs
+
+In @~/.sbuildrc@:
+
+> $run_piuparts = 1;
+> $piuparts_opts = [
+> '--schroot',
+> 'unstable-i386-piuparts',
+> '--fail-if-inadequate',
+> '--fail-on-broken-symlinks',
+> ];
+>
+> $external_commands = {
+> 'post-build-commands' => [
+> [
+> 'adt-run',
+> '--changes', '%c',
+> '---',
+> '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'
+> ],
+> ],
+> };
+
+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 standard as possible.
+-}
+
+-- If you wanted to do it with Propellor.Property.Debootstrap, note that
+-- sbuild-createchroot has a --setup-only option
+
+module Propellor.Property.Sbuild (
+ -- * Creating and updating sbuild schroots
+ SbuildSchroot(..),
+ builtFor,
+ built,
+ updated,
+ updatedFor,
+ piupartsConfFor,
+ piupartsConf,
+ -- * Global sbuild configuration
+ -- blockNetwork,
+ installed,
+ keypairGenerated,
+ shareAptCache,
+ usableBy,
+) where
+
+import Propellor.Base
+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.User as User
+
+import Utility.FileMode
+import Data.List
+import Data.List.Utils
+
+type Suite = String
+
+-- | 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
+
+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
+--
+-- 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 sys = go <!> deleted
+ where
+ 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 sys)
+ deleted = property' ("no sbuild schroot for " ++ show sys) $
+ \w -> case schrootFromSystem sys of
+ 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 =
+ (go
+ `requires` keypairGenerated
+ `requires` ccachePrepared
+ `requires` installed)
+ <!> deleted
+ where
+ go :: Property DebianLike
+ go = check (unpopulated (schrootRoot s) <||> ispartial) $
+ property' ("built sbuild schroot for " ++ show s) make
+ make w = do
+ de <- liftIO standardPathEnv
+ let params = Param <$>
+ [ "--arch=" ++ arch
+ , "--chroot-suffix=-propellor"
+ , "--include=eatmydata,ccache"
+ , suite
+ , schrootRoot s
+ , mirror
+ ]
+ ifM (liftIO $
+ boolSystemEnv "sbuild-createchroot" params (Just de))
+ ( ensureProperty w $
+ fixConfFile s
+ `before` aliasesLine
+ `before` commandPrefix
+ , return FailedChange
+ )
+ 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
+ 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"
+
+ -- 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
+-- user to identify the schroot using the 'System' type
+updatedFor :: System -> Property DebianLike
+updatedFor system = property' ("updated sbuild schroot for " ++ show system) $
+ \w -> case schrootFromSystem system of
+ 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
+updated s@(SbuildSchroot suite arch) =
+ 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
+-- 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 -> 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
+ 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
+ new = schrootConf s
+ dir = takeDirectory new
+ 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, and
+-- sample config.
+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.
+--
+-- 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)
+ `describe` ("piuparts schroot conf for " ++ show s)
+ where
+ go :: Property DebianLike
+ go = tightenTargets $
+ check (not <$> doesFileExist f)
+ (File.basedOn f (schrootConf s, map munge))
+ `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))
+
+ orig = "/etc/schroot/sbuild"
+ dir = "/etc/schroot/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" 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"
+
+-- | 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"
+
+-- another script from wiki.d.o/sbuild
+ccachePrepared :: Property DebianLike
+ccachePrepared = propertyList "sbuild group ccache configured" $ props
+ -- 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"
+ & "/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 \"$@\""
+ ]
+ & File.mode "/var/cache/ccache-sbuild/sbuild-setup"
+ (combineModes (readModes ++ executeModes))
+
+-- This doesn't seem to work with the current version of sbuild
+-- -- | Block network access during builds
+-- --
+-- -- This is a hack from <https://wiki.debian.org/sbuild> 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 ====
+
+schrootFromSystem :: System -> Maybe SbuildSchroot
+schrootFromSystem system@(System _ arch) =
+ extractSuite system
+ >>= \suite -> return $ SbuildSchroot suite arch
+
+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
+
+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"
diff --git a/src/Propellor/Property/Schroot.hs b/src/Propellor/Property/Schroot.hs
new file mode 100644
index 00000000..c53ce4f1
--- /dev/null
+++ b/src/Propellor/Property/Schroot.hs
@@ -0,0 +1,42 @@
+-- | Maintainer: Sean Whitton <spwhitton@spwhitton.name>
+
+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 <https://wiki.debian.org/sbuild>.
+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)))
+ `describe` "schroot overlays in tmpfs"
+
+installed :: Property DebianLike
+installed = Apt.installed ["schroot"]