Merge remote-tracking branch 'spwhitton/sbuild'

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"]