diff --git a/CHANGELOG b/CHANGELOG
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,24 @@
+propellor (2.12.0) unstable; urgency=medium
+
+  * The DiskImage module can now make bootable images using grub.
+  * Add a ChrootTarball chroot type, for using pre-built tarballs
+    as chroots. Thanks, Ben Boeckel.
+  * HostName: Improve domain extraction code.
+  * Added Mount.fstabbed property to generate /etc/fstab to replicate
+    current mounts.
+  * HostName: Improve domain extraction code.
+  * Add File.basedOn. Thanks, Per Olofsson.
+  * Changed how the operating system is provided to Chroot (API change).
+    Where before debootstrapped and bootstrapped took a System parameter,
+    the os property should now be added to the Chroot.
+  * Follow-on change to Systemd.container, which now takes a System parameter.
+  * Generalized Property.check so it can be used with Propellor actions as
+    well as IO actions.
+  * Hostname.sane and Hostname.setTo can now safely be used as a property
+    of a chroot, and won't affect the hostname of the host system.
+
+ -- Joey Hess <id@joeyh.name>  Fri, 23 Oct 2015 17:38:32 -0400
+
 propellor (2.11.0) unstable; urgency=medium
 
   * Rewrote Propellor.Property.ControlHeir one more time, renaming it to
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -53,6 +53,7 @@
    So, edit `~/.propellor/config.hs` to configure the host, add some
    properties to it, and re-run step 6.  
    Repeat until happy and move on to the next host. :)
-8. Optionally, set up a [centralized git repository](https://propellor.branchable.com/centralized_git_repository/)
-   so that multiple hosts can be updated with a simple `git commit -S; git push`
+8. Once you have a lot of hosts, and running `propellor --spin HOST` for
+   each host becomes tiresome, you can
+   [automate that](http://propellor.branchable.com/automated_spins/).
 9. Write some neat new properties and send patches!
diff --git a/config-joey.hs b/config-joey.hs
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -81,14 +81,19 @@
 	& JoeySites.postfixClientRelay (Context "darkstar.kitenet.net")
 	& JoeySites.dkimMilter
 
-	& imageBuilt "/tmp/img" c MSDOS
-		[ partition EXT2 `mountedAt` "/boot" `setFlag` BootFlag
-		, partition EXT4 `mountedAt` "/" `addFreeSpace` MegaBytes 100
-		-- , swapPartition (MegaBytes 256)
-		] noFinalization -- (grubBooted PC)
+	& imageBuilt "/tmp/img" c MSDOS (grubBooted PC)
+		[ partition EXT2 `mountedAt` "/boot"
+			`setFlag` BootFlag
+		, partition EXT4 `mountedAt` "/"
+			`mountOpt` errorReadonly
+		, swapPartition (MegaBytes 256)
+		]
   where
-	c d = Chroot.debootstrapped (System (Debian Unstable) "amd64") mempty d
+	c d = Chroot.debootstrapped mempty d
+		& os (System (Debian Unstable) "amd64")
+		& Hostname.setTo "demo"
 		& Apt.installed ["linux-image-amd64"]
+		& User "root" `User.hasInsecurePassword` "root"
 
 gnu :: Host
 gnu = host "gnu.kitenet.net"
@@ -492,14 +497,13 @@
 
 -- This is my standard container setup, Featuring automatic upgrades.
 standardContainer :: Systemd.MachineName -> DebianSuite -> Architecture -> Systemd.Container
-standardContainer name suite arch = Systemd.container name chroot
-	& os system
-	& Apt.stdSourcesList `onChange` Apt.upgrade
-	& Apt.unattendedUpgrades
-	& Apt.cacheCleaned
+standardContainer name suite arch =
+	Systemd.container name system (Chroot.debootstrapped mempty)
+		& Apt.stdSourcesList `onChange` Apt.upgrade
+		& Apt.unattendedUpgrades
+		& Apt.cacheCleaned
   where
 	system = System (Debian suite) arch
-	chroot = Chroot.debootstrapped system mempty
 
 standardStableContainer :: Systemd.MachineName -> Systemd.Container
 standardStableContainer name = standardContainer name (Stable "jessie") "amd64"
diff --git a/debian/changelog b/debian/changelog
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,24 @@
+propellor (2.12.0) unstable; urgency=medium
+
+  * The DiskImage module can now make bootable images using grub.
+  * Add a ChrootTarball chroot type, for using pre-built tarballs
+    as chroots. Thanks, Ben Boeckel.
+  * HostName: Improve domain extraction code.
+  * Added Mount.fstabbed property to generate /etc/fstab to replicate
+    current mounts.
+  * HostName: Improve domain extraction code.
+  * Add File.basedOn. Thanks, Per Olofsson.
+  * Changed how the operating system is provided to Chroot (API change).
+    Where before debootstrapped and bootstrapped took a System parameter,
+    the os property should now be added to the Chroot.
+  * Follow-on change to Systemd.container, which now takes a System parameter.
+  * Generalized Property.check so it can be used with Propellor actions as
+    well as IO actions.
+  * Hostname.sane and Hostname.setTo can now safely be used as a property
+    of a chroot, and won't affect the hostname of the host system.
+
+ -- Joey Hess <id@joeyh.name>  Fri, 23 Oct 2015 17:38:32 -0400
+
 propellor (2.11.0) unstable; urgency=medium
 
   * Rewrote Propellor.Property.ControlHeir one more time, renaming it to
diff --git a/doc/README.mdwn b/doc/README.mdwn
--- a/doc/README.mdwn
+++ b/doc/README.mdwn
@@ -53,6 +53,7 @@
    So, edit `~/.propellor/config.hs` to configure the host, add some
    properties to it, and re-run step 6.  
    Repeat until happy and move on to the next host. :)
-8. Optionally, set up a [centralized git repository](https://propellor.branchable.com/centralized_git_repository/)
-   so that multiple hosts can be updated with a simple `git commit -S; git push`
+8. Once you have a lot of hosts, and running `propellor --spin HOST` for
+   each host becomes tiresome, you can
+   [automate that](http://propellor.branchable.com/automated_spins/).
 9. Write some neat new properties and send patches!
diff --git a/propellor.cabal b/propellor.cabal
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -1,5 +1,5 @@
 Name: propellor
-Version: 2.11.0
+Version: 2.12.0
 Cabal-Version: >= 1.8
 License: BSD3
 Maintainer: Joey Hess <id@joeyh.name>
@@ -84,6 +84,7 @@
     Propellor.Property.DebianMirror
     Propellor.Property.Debootstrap
     Propellor.Property.DiskImage
+    Propellor.Property.DiskImage.PartSpec
     Propellor.Property.Dns
     Propellor.Property.DnsSec
     Propellor.Property.Docker
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -142,11 +142,12 @@
 ensureProperty = catchPropellor . propertySatisfy
 
 -- | Makes a Property only need to do anything when a test succeeds.
-check :: IO Bool -> Property i -> Property i
-check c p = adjustPropertySatisfy p $ \satisfy -> ifM (liftIO c)
-	( satisfy
-	, return NoChange
-	)
+check :: (LiftPropellor m) => m Bool -> Property i -> Property i
+check c p = adjustPropertySatisfy p $ \satisfy -> 
+	ifM (liftPropellor c)
+		( satisfy
+		, return NoChange
+		)
 
 -- | Tries the first property, but if it fails to work, instead uses
 -- the second.
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -1,12 +1,14 @@
-{-# LANGUAGE FlexibleContexts, GADTs #-}
+{-# LANGUAGE FlexibleContexts, GADTs, DeriveDataTypeable #-}
 
 module Propellor.Property.Chroot (
-	Chroot(..),
-	ChrootBootstrapper(..),
-	Debootstrapped(..),
 	debootstrapped,
 	bootstrapped,
 	provisioned,
+	Chroot(..),
+	ChrootBootstrapper(..),
+	Debootstrapped(..),
+	ChrootTarball(..),
+	inChroot,
 	-- * Internal use
 	provisioned',
 	propagateChrootInfo,
@@ -22,6 +24,7 @@
 import Propellor.Property.Chroot.Util
 import qualified Propellor.Property.Debootstrap as Debootstrap
 import qualified Propellor.Property.Systemd.Core as Systemd
+import qualified Propellor.Property.File as File
 import qualified Propellor.Shim as Shim
 import Propellor.Property.Mount
 
@@ -32,52 +35,78 @@
 -- | Specification of a chroot. Normally you'll use `debootstrapped` or
 -- `bootstrapped` to construct a Chroot value.
 data Chroot where
-	Chroot :: ChrootBootstrapper b => FilePath -> System -> b -> Host -> Chroot
+	Chroot :: ChrootBootstrapper b => FilePath -> b -> Host -> Chroot
 
-chrootSystem :: Chroot -> System
-chrootSystem (Chroot _ system _ _) = system
+chrootSystem :: Chroot -> Maybe System
+chrootSystem (Chroot _ _ h) = fromInfoVal (getInfo (hostInfo h))
 
 instance Show Chroot where
-	show (Chroot loc system _ _) = "Chroot " ++ loc ++ " " ++ show system
+	show c@(Chroot loc _ _) = "Chroot " ++ loc ++ " " ++ show (chrootSystem c)
 
 instance PropAccum Chroot where
-	(Chroot l s c h) `addProp` p = Chroot l s c (h & p)
-	(Chroot l s c h) `addPropFront` p = Chroot l s c (h `addPropFront` p)
-	getProperties (Chroot _ _ _ h) = hostProperties h
+	(Chroot l c h) `addProp` p = Chroot l c (h & p)
+	(Chroot l c h) `addPropFront` p = Chroot l c (h `addPropFront` p)
+	getProperties (Chroot _ _ h) = hostProperties h
 
 -- | Class of things that can do initial bootstrapping of an operating
 -- System in a chroot.
 class ChrootBootstrapper b where
 	-- | Do initial bootstrapping of an operating system in a chroot.
-	-- If the operating System is not supported, return Nothing.
-	buildchroot :: b -> System -> FilePath -> Maybe (Property HasInfo)
+	-- If the operating System is not supported, return 
+	-- Left error message.
+	buildchroot :: b -> Maybe System -> FilePath -> Either String (Property HasInfo)
 
--- | Use to bootstrap a chroot with debootstrap.
+-- | Use this to bootstrap a chroot by extracting a tarball.
+--
+-- The tarball is expected to contain a root directory (no top-level
+-- directory, also known as a "tarbomb").
+-- It may be optionally compressed with any format `tar` knows how to
+-- detect automatically.
+data ChrootTarball = ChrootTarball FilePath
+
+instance ChrootBootstrapper ChrootTarball where
+	buildchroot (ChrootTarball tb) _ loc = Right $ extractTarball loc tb
+
+extractTarball :: FilePath -> FilePath -> Property HasInfo
+extractTarball target src = toProp .
+	check (unpopulated target) $
+		cmdProperty "tar" params
+			`requires` File.dirExists target
+  where
+	params =
+		[ "-C"
+		, target
+		, "-xf"
+		, src
+		]
+
+-- | Use this to bootstrap a chroot with debootstrap.
 data Debootstrapped = Debootstrapped Debootstrap.DebootstrapConfig
 
 instance ChrootBootstrapper Debootstrapped where
 	buildchroot (Debootstrapped cf) system loc = case system of
-		(System (Debian _) _) -> Just debootstrap
-		(System (Ubuntu _) _) -> Just debootstrap
+		(Just s@(System (Debian _) _)) -> Right $ debootstrap s
+		(Just s@(System (Ubuntu _) _)) -> Right $ debootstrap s
+		Nothing -> Left "Cannot debootstrap; `os` property not specified"
 	  where
-		debootstrap = Debootstrap.built loc system cf
+		debootstrap s = Debootstrap.built loc s cf
 
 -- | Defines a Chroot at the given location, built with debootstrap.
 --
--- Properties can be added to configure the Chroot.
+-- Properties can be added to configure the Chroot. At a minimum,
+-- add the `os` property to specify the operating system to bootstrap.
 --
--- > debootstrapped (System (Debian Unstable) "amd64") Debootstrap.BuildD "/srv/chroot/ghc-dev"
+-- > debootstrapped Debootstrap.BuildD "/srv/chroot/ghc-dev"
+-- >	& os (System (Debian Unstable) "amd64")
 -- > 	& Apt.installed ["ghc", "haskell-platform"]
 -- > 	& ...
-debootstrapped :: System -> Debootstrap.DebootstrapConfig -> FilePath -> Chroot
-debootstrapped system conf = bootstrapped system (Debootstrapped conf)
+debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Chroot
+debootstrapped conf = bootstrapped (Debootstrapped conf)
 
 -- | Defines a Chroot at the given location, bootstrapped with the
 -- specified ChrootBootstrapper.
-bootstrapped :: ChrootBootstrapper b => System -> b -> FilePath -> Chroot
-bootstrapped system bootstrapper location =
-	Chroot location system bootstrapper h
-		& os system
+bootstrapped :: ChrootBootstrapper b => b -> FilePath -> Chroot
+bootstrapped bootstrapper location = Chroot location bootstrapper h
   where
 	h = Host location [] mempty
 
@@ -91,7 +120,7 @@
 provisioned c = provisioned' (propagateChrootInfo c) c False
 
 provisioned' :: (Property HasInfo -> Property HasInfo) -> Chroot -> Bool -> RevertableProperty
-provisioned' propigator c@(Chroot loc system bootstrapper _) systemdonly =
+provisioned' propigator c@(Chroot loc bootstrapper _) systemdonly =
 	(propigator $ propertyList (chrootDesc c "exists") [setup])
 		<!>
 	(propertyList (chrootDesc c "removed") [teardown])
@@ -99,18 +128,18 @@
 	setup = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly
 		`requires` toProp built
 	
-	built = case buildchroot bootstrapper system loc of
-		Just p -> p
-		Nothing -> cantbuild
+	built = case buildchroot bootstrapper (chrootSystem c) loc of
+		Right p -> p
+		Left e -> cantbuild e
 
-	cantbuild = infoProperty (chrootDesc c "built") (error $ "cannot bootstrap " ++ show system ++ " using supplied ChrootBootstrapper") mempty []
+	cantbuild e = infoProperty (chrootDesc c "built") (error e) mempty []
 
 	teardown = check (not <$> unpopulated loc) $
 		property ("removed " ++ loc) $
 			makeChange (removeChroot loc)
 
 propagateChrootInfo :: (IsProp (Property i)) => Chroot -> Property i -> Property HasInfo
-propagateChrootInfo c@(Chroot location _ _ _) p = propagateContainer location c p'
+propagateChrootInfo c@(Chroot location _ _) p = propagateContainer location c p'
   where
 	p' = infoProperty
 		(propertyDesc p)
@@ -119,12 +148,12 @@
 		(propertyChildren p)
 
 chrootInfo :: Chroot -> Info
-chrootInfo (Chroot loc _ _ h) = mempty `addInfo` 
+chrootInfo (Chroot loc _ h) = mempty `addInfo` 
 	mempty { _chroots = M.singleton loc h }
 
 -- | Propellor is run inside the chroot to provision it.
 propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property NoInfo
-propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do
+propellChroot c@(Chroot loc _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do
 	let d = localdir </> shimdir c
 	let me = localdir </> "propellor"
 	shim <- liftIO $ ifM (doesDirectoryExist d)
@@ -163,7 +192,7 @@
 		return r
 
 toChain :: HostName -> Chroot -> Bool -> IO CmdLine
-toChain parenthost (Chroot loc _ _ _) systemdonly = do
+toChain parenthost (Chroot loc _ _) systemdonly = do
 	onconsole <- isConsole <$> mkMessageHandle
 	return $ ChrootChain parenthost loc systemdonly onconsole
 
@@ -179,7 +208,7 @@
 		changeWorkingDirectory localdir
 		when onconsole forceConsole
 		onlyProcess (provisioningLock loc) $ do
-			r <- runPropellor h $ ensureProperties $
+			r <- runPropellor (setInChroot h) $ ensureProperties $
 				if systemdonly
 					then [Systemd.installed]
 					else map ignoreInfo $
@@ -188,14 +217,14 @@
 chain _ _ = errorMessage "bad chain command"
 
 inChrootProcess :: Bool -> Chroot -> [String] -> IO (CreateProcess, IO ())
-inChrootProcess keepprocmounted (Chroot loc _ _ _) cmd = do
+inChrootProcess keepprocmounted (Chroot loc _ _) cmd = do
 	mountproc
 	return (proc "chroot" (loc:cmd), cleanup)
   where
 	-- /proc needs to be mounted in the chroot for the linker to use
 	-- /proc/self/exe which is necessary for some commands to work
 	mountproc = unlessM (elem procloc <$> mountPointsBelow loc) $
-		void $ mount "proc" "proc" procloc
+		void $ mount "proc" "proc" procloc mempty
 	
 	procloc = loc </> "proc"
 
@@ -208,10 +237,25 @@
 provisioningLock containerloc = "chroot" </> mungeloc containerloc ++ ".lock"
 
 shimdir :: Chroot -> FilePath
-shimdir (Chroot loc _ _ _) = "chroot" </> mungeloc loc ++ ".shim"
+shimdir (Chroot loc _ _) = "chroot" </> mungeloc loc ++ ".shim"
 
 mungeloc :: FilePath -> String
 mungeloc = replace "/" "_"
 
 chrootDesc :: Chroot -> String -> String
-chrootDesc (Chroot loc _ _ _) desc = "chroot " ++ loc ++ " " ++ desc
+chrootDesc (Chroot loc _ _) desc = "chroot " ++ loc ++ " " ++ desc
+
+-- | Check if propellor is currently running within a chroot.
+--
+-- This allows properties to check and avoid performing actions that
+-- should not be done in a chroot.
+inChroot :: Propellor Bool
+inChroot = extract . fromMaybe (InChroot False) . fromInfoVal <$> askInfo
+  where
+	extract (InChroot b) = b
+
+setInChroot :: Host -> Host
+setInChroot h = h { hostInfo = hostInfo h `addInfo` InfoVal (InChroot True) }
+
+newtype InChroot = InChroot Bool
+	deriving (Typeable, Show)
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -2,33 +2,17 @@
 --
 -- This module is designed to be imported unqualified.
 --
--- TODO run final
--- 
 -- TODO avoid starting services while populating chroot and running final
 
 module Propellor.Property.DiskImage (
+	-- * Partition specification
+	module Propellor.Property.DiskImage.PartSpec,
 	-- * Properties
 	DiskImage,
 	imageBuilt,
 	imageRebuilt,
 	imageBuiltFrom,
 	imageExists,
-	-- * Partitioning
-	Partition,
-	PartSize(..),
-	Fs(..),
-	PartSpec,
-	MountPoint,
-	swapPartition,
-	partition,
-	mountedAt,
-	addFreeSpace,
-	setSize,
-	PartFlag(..),
-	setFlag,
-	TableType(..),
-	extended,
-	adjustp,
 	-- * Finalization
 	Finalization,
 	grubBooted,
@@ -37,6 +21,7 @@
 ) where
 
 import Propellor.Base
+import Propellor.Property.DiskImage.PartSpec
 import Propellor.Property.Chroot (Chroot)
 import Propellor.Property.Chroot.Util (removeChroot)
 import qualified Propellor.Property.Chroot as Chroot
@@ -49,7 +34,8 @@
 import Propellor.Property.Rsync
 import Utility.Path
 
-import Data.List (isPrefixOf)
+import Data.List (isPrefixOf, isInfixOf, sortBy)
+import Data.Function (on)
 import qualified Data.Map.Strict as M
 import qualified Data.ByteString.Lazy as L
 import System.Posix.Files
@@ -70,25 +56,31 @@
 -- > let chroot d = Chroot.debootstrapped (System (Debian Unstable) "amd64") mempty d
 -- > 		& Apt.installed ["linux-image-amd64"]
 -- >		& ...
--- > in imageBuilt "/srv/images/foo.img" chroot MSDOS 
+-- > in imageBuilt "/srv/images/foo.img" chroot
+-- >		MSDOS (grubBooted PC)
 -- >		[ partition EXT2 `mountedAt` "/boot"
 -- >			`setFlag` BootFlag
 -- >		, partition EXT4 `mountedAt` "/"
 -- >			`addFreeSpace` MegaBytes 100
+-- >			`mountOpt` errorReadonly
 -- >		, swapPartition (MegaBytes 256)
--- >		] (grubBooted PC)
-imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec] -> Finalization -> RevertableProperty
+-- >		]
+--
+-- Note that the disk image file is reused if it already exists,
+-- to avoid expensive IO to generate a new one. And, it's updated in-place,
+-- so its contents are undefined during the build process.
+imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty
 imageBuilt = imageBuilt' False
 
 -- | Like 'built', but the chroot is deleted and rebuilt from scratch each
 -- time. This is more expensive, but useful to ensure reproducible results
 -- when the properties of the chroot have been changed.
-imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec] -> Finalization -> RevertableProperty
+imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty
 imageRebuilt = imageBuilt' True
 
-imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec] -> Finalization -> RevertableProperty
-imageBuilt' rebuild img mkchroot tabletype partspec final = 
-	imageBuiltFrom img chrootdir tabletype partspec (snd final)
+imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty
+imageBuilt' rebuild img mkchroot tabletype final partspec = 
+	imageBuiltFrom img chrootdir tabletype final partspec
 		`requires` Chroot.provisioned chroot
 		`requires` (cleanrebuild <!> doNothing)
 		`describe` desc
@@ -107,10 +99,8 @@
 		& Apt.cacheCleaned
 
 -- | Builds a disk image from the contents of a chroot.
---
--- The passed property is run inside the mounted disk image.
-imageBuiltFrom :: DiskImage -> FilePath -> TableType -> [PartSpec] -> Property NoInfo -> RevertableProperty
-imageBuiltFrom img chrootdir tabletype partspec final = mkimg <!> rmimg
+imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty
+imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg
   where
 	desc = img ++ " built from " ++ chrootdir
 	mkimg = property desc $ do
@@ -121,25 +111,30 @@
 			<$> liftIO (dirSizes chrootdir)
 		let calcsz mnts = maybe defSz fudge . getMountSz szm mnts
 		-- tie the knot!
-		let (mnts, t) = fitChrootSize tabletype partspec (map (calcsz mnts) mnts)
+		let (mnts, mntopts, parttable) = fitChrootSize tabletype partspec $
+			map (calcsz mnts) mnts
 		ensureProperty $
-			imageExists img (partTableSize t)
+			imageExists img (partTableSize parttable)
 				`before`
-			partitioned YesReallyDeleteDiskContents img t
+			partitioned YesReallyDeleteDiskContents img parttable
 				`before`
-			kpartx img (partitionsPopulated chrootdir mnts)
+			kpartx img (mkimg' mnts mntopts parttable)
+	mkimg' mnts mntopts parttable devs =
+		partitionsPopulated chrootdir mnts mntopts devs
+			`before`
+		imageFinalized final mnts mntopts devs parttable
 	rmimg = File.notPresent img
 
-partitionsPopulated :: FilePath -> [MountPoint] -> [FilePath] -> Property NoInfo
-partitionsPopulated chrootdir mnts devs = property desc $ mconcat $ zipWith go mnts devs
+partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property NoInfo
+partitionsPopulated chrootdir mnts mntopts devs = property desc $ mconcat $ zipWith3 go mnts mntopts devs
   where
 	desc = "partitions populated from " ++ chrootdir
 
-	go Nothing _ = noChange
-	go (Just mnt) dev = withTmpDir "mnt" $ \tmpdir -> bracket
-		(liftIO $ mount "auto" dev tmpdir)
+	go Nothing _ _ = noChange
+	go (Just mnt) mntopt loopdev = withTmpDir "mnt" $ \tmpdir -> bracket
+		(liftIO $ mount "auto" (partitionLoopDev loopdev) tmpdir mntopt)
 		(const $ liftIO $ umountLazy tmpdir)
-		$ \mounted -> if mounted
+		$ \ismounted -> if ismounted
 			then ensureProperty $
 				syncDirFiltered (filtersfor mnt) (chrootdir ++ mnt) tmpdir
 			else return FailedChange
@@ -152,25 +147,17 @@
 			-- Include the child mount point, but exclude its contents.
 			[ Include (Pattern m)
 			, Exclude (filesUnder m)
+			-- Preserve any lost+found directory that mkfs made
+			, Protect (Pattern "lost+found")
 			]) childmnts
 
--- | Ensures that a disk image file of the specified size exists.
--- 
--- If the file doesn't exist, or is too small, creates a new one, full of 0's.
---
--- If the file is too large, truncates it down to the specified size.
-imageExists :: FilePath -> ByteSize -> Property NoInfo
-imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do
-	ms <- catchMaybeIO $ getFileStatus img
-	case ms of
-		Just s 
-			| toInteger (fileSize s) == toInteger sz -> return NoChange
-			| toInteger (fileSize s) > toInteger sz -> do
-				setFileSize img (fromInteger sz)
-				return MadeChange
-		_ -> do
-			L.writeFile img (L.replicate (fromIntegral sz) 0)
-			return MadeChange
+-- The constructor for each Partition is passed the size of the files
+-- from the chroot that will be put in that partition.
+fitChrootSize :: TableType -> [PartSpec] -> [PartSize] -> ([Maybe MountPoint], [MountOpts], PartTable)
+fitChrootSize tt l basesizes = (mounts, mountopts, parttable)
+  where
+	(mounts, mountopts, sizers) = unzip3 l
+	parttable = PartTable tt (zipWith id sizers basesizes)
 
 -- | Generates a map of the sizes of the contents of 
 -- every directory in a filesystem tree. 
@@ -194,105 +181,134 @@
 			else go (M.insertWith (+) dir sz m) dir is
 	subdirof parent i = not (i `equalFilePath` parent) && takeDirectory i `equalFilePath` parent
 
-getMountSz :: (M.Map FilePath PartSize) -> [MountPoint] -> MountPoint -> Maybe PartSize
+getMountSz :: (M.Map FilePath PartSize) -> [Maybe MountPoint] -> Maybe MountPoint -> Maybe PartSize
 getMountSz _ _ Nothing = Nothing
 getMountSz szm l (Just mntpt) = 
 	fmap (`reducePartSize` childsz) (M.lookup mntpt szm)
   where
 	childsz = mconcat $ mapMaybe (getMountSz szm l) (filter (isChild mntpt) l)
 
-isChild :: FilePath -> MountPoint -> Bool
-isChild mntpt (Just d)
-	| d `equalFilePath` mntpt = False
-	| otherwise = mntpt `dirContains` d
-isChild _ Nothing = False
-
--- | From a location in a chroot (eg, /tmp/chroot/usr) to
--- the corresponding location inside (eg, /usr).
-toSysDir :: FilePath -> FilePath -> FilePath
-toSysDir chrootdir d = case makeRelative chrootdir d of
-		"." -> "/"
-		sysdir -> "/" ++ sysdir
-
--- | Where a partition is mounted. Use Nothing for eg, LinuxSwap.
-type MountPoint = Maybe FilePath
-
-defSz :: PartSize
-defSz = MegaBytes 128
-
--- Add 2% for filesystem overhead. Rationalle for picking 2%:
--- A filesystem with 1% overhead might just sneak by as acceptable.
--- Double that just in case. Add an additional 3 mb to deal with
--- non-scaling overhead, of filesystems (eg, superblocks).
-fudge :: PartSize -> PartSize
-fudge (MegaBytes n) = MegaBytes (n + n `div` 100 * 2 + 3)
-
--- | Specifies a mount point and a constructor for a Partition.
+-- | Ensures that a disk image file of the specified size exists.
 -- 
--- The size that is eventually provided is the amount of space needed to 
--- hold the files that appear in the directory where the partition is to be
--- mounted. Plus a fudge factor, since filesystems have some space
--- overhead.
+-- If the file doesn't exist, or is too small, creates a new one, full of 0's.
 --
--- (Partitions that are not to be mounted (ie, LinuxSwap), or that have
--- no corresponding directory in the chroot will have 128 MegaBytes
--- provided as a default size.)
-type PartSpec = (MountPoint, PartSize -> Partition)
-
--- | Specifies a swap partition of a given size.
-swapPartition :: PartSize -> PartSpec
-swapPartition sz = (Nothing, const (mkPartition LinuxSwap sz))
+-- If the file is too large, truncates it down to the specified size.
+imageExists :: FilePath -> ByteSize -> Property NoInfo
+imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do
+	ms <- catchMaybeIO $ getFileStatus img
+	case ms of
+		Just s 
+			| toInteger (fileSize s) == toInteger sz -> return NoChange
+			| toInteger (fileSize s) > toInteger sz -> do
+				setFileSize img (fromInteger sz)
+				return MadeChange
+		_ -> do
+			L.writeFile img (L.replicate (fromIntegral sz) 0)
+			return MadeChange
 
--- | Specifies a partition with a given filesystem.
+-- | A pair of properties. The first property is satisfied within the
+-- chroot, and is typically used to download the boot loader.
 --
--- The partition is not mounted anywhere by default; use the combinators
--- below to configure it.
-partition :: Fs -> PartSpec
-partition fs = (Nothing, mkPartition fs)
+-- The second property is run after the disk image is created,
+-- with its populated partition tree mounted in the provided
+-- location from the provided loop devices. This will typically
+-- take care of installing the boot loader to the image.
+-- 
+-- It's ok if the second property leaves additional things mounted
+-- in the partition tree.
+type Finalization = (Property NoInfo, (FilePath -> [LoopDev] -> Property NoInfo))
 
--- | Specifies where to mount a partition.
-mountedAt :: PartSpec -> FilePath -> PartSpec
-mountedAt (_, p) mp = (Just mp, p)
+imageFinalized :: Finalization -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> PartTable -> Property NoInfo
+imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) = 
+	property "disk image finalized" $ 
+		withTmpDir "mnt" $ \top -> 
+			go top `finally` liftIO (unmountall top)
+  where
+	go top = do
+		liftIO $ mountall top
+		liftIO $ writefstab top
+		ensureProperty $ final top devs
+	
+	-- Ordered lexographically by mount point, so / comes before /usr
+	-- comes before /usr/local
+	orderedmntsdevs :: [(Maybe MountPoint, (MountOpts, LoopDev))]
+	orderedmntsdevs = sortBy (compare `on` fst) $ zip mnts (zip mntopts devs)
+	
+	swaps = map (SwapPartition . partitionLoopDev . snd) $
+		filter ((== LinuxSwap) . partFs . fst) $
+			zip parts devs
 
--- | Adds additional free space to the partition.
-addFreeSpace :: PartSpec -> PartSize -> PartSpec
-addFreeSpace (mp, p) freesz = (mp, \sz -> p (sz <> freesz))
+	mountall top = forM_ orderedmntsdevs $ \(mp, (mopts, loopdev)) -> case mp of
+		Nothing -> noop
+		Just p -> do
+			let mnt = top ++ p
+			createDirectoryIfMissing True mnt
+			unlessM (mount "auto" (partitionLoopDev loopdev) mnt mopts) $
+				error $ "failed mounting " ++ mnt
 
--- | Forced a partition to be a specific size, instead of scaling to the
--- size needed for the files in the chroot.
-setSize :: PartSpec -> PartSize -> PartSpec
-setSize (mp, p) sz = (mp, const (p sz))
+	unmountall top = do
+		unmountBelow top
+		umountLazy top
+	
+	writefstab top = do
+		let fstab = top ++ "/etc/fstab"
+		old <- catchDefaultIO [] $ filter (not . unconfigured) . lines
+			<$> readFileStrict fstab
+		new <- genFstab (map (top ++) (catMaybes mnts))
+			swaps (toSysDir top)
+		writeFile fstab $ unlines $ new ++ old
+	-- Eg "UNCONFIGURED FSTAB FOR BASE SYSTEM"
+	unconfigured s = "UNCONFIGURED" `isInfixOf` s
 
--- | Sets a flag on the partition.
-setFlag :: PartSpec -> PartFlag -> PartSpec
-setFlag s f = adjustp s $ \p -> p { partFlags = (f, True):partFlags p }
+noFinalization :: Finalization
+noFinalization = (doNothing, \_ _ -> doNothing)
 
--- | Makes a MSDOS partition be Extended, rather than Primary.
-extended :: PartSpec -> PartSpec
-extended s = adjustp s $ \p -> p { partType = Extended }
+-- | Makes grub be the boot loader of the disk image.
+grubBooted :: Grub.BIOS -> Finalization
+grubBooted bios = (Grub.installed' bios, boots)
+  where
+	boots mnt loopdevs = combineProperties "disk image boots using grub"
+		-- bind mount host /dev so grub can access the loop devices
+		[ bindMount "/dev" (inmnt "/dev")
+		, mounted "proc" "proc" (inmnt "/proc") mempty
+		, mounted "sysfs" "sys" (inmnt "/sys") mempty
+		-- update the initramfs so it gets the uuid of the root partition
+		, inchroot "update-initramfs" ["-u"]
+		-- work around for http://bugs.debian.org/802717
+		 , check haveosprober $ inchroot "chmod" ["-x", osprober]
+		, inchroot "update-grub" []
+		, check haveosprober $ inchroot "chmod" ["+x", osprober]
+		, inchroot "grub-install" [wholediskloopdev]
+		-- sync all buffered changes out to the disk image
+		-- may not be necessary, but seemed needed sometimes
+		-- when using the disk image right away.
+		, cmdProperty "sync" []
+		]
+	  where
+	  	-- cannot use </> since the filepath is absolute
+		inmnt f = mnt ++ f
 
-adjustp :: PartSpec -> (Partition -> Partition) -> PartSpec
-adjustp (mp, p) f = (mp, f . p)
+		inchroot cmd ps = cmdProperty "chroot" ([mnt, cmd] ++ ps)
 
--- | The constructor for each Partition is passed the size of the files
--- from the chroot that will be put in that partition.
-fitChrootSize :: TableType -> [PartSpec] -> [PartSize] -> ([MountPoint], PartTable)
-fitChrootSize tt l basesizes = (mounts, parttable)
-  where
-	(mounts, sizers) = unzip l
-	parttable = PartTable tt (zipWith id sizers basesizes)
+		haveosprober = doesFileExist (inmnt osprober)
+		osprober = "/etc/grub.d/30_os-prober"
 
--- | A pair of properties. The first property is satisfied within the
--- chroot, and is typically used to download the boot loader.
--- The second property is satisfied chrooted into the resulting
--- disk image, and will typically take care of installing the boot loader
--- to the disk image.
-type Finalization = (Property NoInfo, Property NoInfo)
+		-- It doesn't matter which loopdev we use; all
+		-- come from the same disk image, and it's the loop dev
+		-- for the whole disk image we seek.
+		wholediskloopdev = case loopdevs of
+			(l:_) -> wholeDiskLoopDev l
+			[] -> error "No loop devs provided!"
 
--- | Makes grub be the boot loader of the disk image.
--- TODO not implemented
-grubBooted :: Grub.BIOS -> Finalization
-grubBooted bios = (Grub.installed bios, undefined)
+isChild :: FilePath -> Maybe MountPoint -> Bool
+isChild mntpt (Just d)
+	| d `equalFilePath` mntpt = False
+	| otherwise = mntpt `dirContains` d
+isChild _ Nothing = False
 
-noFinalization :: Finalization
-noFinalization = (doNothing, doNothing)
+-- | From a location in a chroot (eg, /tmp/chroot/usr) to
+-- the corresponding location inside (eg, /usr).
+toSysDir :: FilePath -> FilePath -> FilePath
+toSysDir chrootdir d = case makeRelative chrootdir d of
+		"." -> "/"
+		sysdir -> "/" ++ sysdir
diff --git a/src/Propellor/Property/DiskImage/PartSpec.hs b/src/Propellor/Property/DiskImage/PartSpec.hs
new file mode 100644
--- /dev/null
+++ b/src/Propellor/Property/DiskImage/PartSpec.hs
@@ -0,0 +1,81 @@
+-- | Disk image partition specification and combinators.
+
+module Propellor.Property.DiskImage.PartSpec (
+	module Propellor.Property.DiskImage.PartSpec,
+	Partition,
+	PartSize(..),
+	PartFlag(..),
+	TableType(..),
+	Fs(..),
+	MountPoint,
+) where
+
+import Propellor.Base
+import Propellor.Property.Parted
+import Propellor.Property.Mount
+
+-- | Specifies a mount point, mount options, and a constructor for a Partition.
+-- 
+-- The size that is eventually provided is the amount of space needed to 
+-- hold the files that appear in the directory where the partition is to be
+-- mounted. Plus a fudge factor, since filesystems have some space
+-- overhead.
+type PartSpec = (Maybe MountPoint, MountOpts, PartSize -> Partition)
+
+-- | Partitions that are not to be mounted (ie, LinuxSwap), or that have
+-- no corresponding directory in the chroot will have 128 MegaBytes
+-- provided as a default size.
+defSz :: PartSize
+defSz = MegaBytes 128
+
+-- | Add 2% for filesystem overhead. Rationalle for picking 2%:
+-- A filesystem with 1% overhead might just sneak by as acceptable.
+-- Double that just in case. Add an additional 3 mb to deal with
+-- non-scaling overhead of filesystems (eg, superblocks). 
+-- Add an additional 200 mb for temp files, journals, etc.
+fudge :: PartSize -> PartSize
+fudge (MegaBytes n) = MegaBytes (n + n `div` 100 * 2 + 3 + 200)
+
+-- | Specifies a swap partition of a given size.
+swapPartition :: PartSize -> PartSpec
+swapPartition sz = (Nothing, mempty, const (mkPartition LinuxSwap sz))
+
+-- | Specifies a partition with a given filesystem.
+--
+-- The partition is not mounted anywhere by default; use the combinators
+-- below to configure it.
+partition :: Fs -> PartSpec
+partition fs = (Nothing, mempty, mkPartition fs)
+
+-- | Specifies where to mount a partition.
+mountedAt :: PartSpec -> FilePath -> PartSpec
+mountedAt (_, o, p) mp = (Just mp, o, p)
+
+-- | Specifies a mount option, such as "noexec"
+mountOpt :: ToMountOpts o => PartSpec -> o -> PartSpec
+mountOpt (mp, o, p) o' = (mp, o <> toMountOpts o', p)
+
+-- | Mount option to make a partition be remounted readonly when there's an
+-- error accessing it.
+errorReadonly :: MountOpts
+errorReadonly = toMountOpts "errors=remount-ro"
+
+-- | Adds additional free space to the partition.
+addFreeSpace :: PartSpec -> PartSize -> PartSpec
+addFreeSpace (mp, o, p) freesz = (mp, o, \sz -> p (sz <> freesz))
+
+-- | Forced a partition to be a specific size, instead of scaling to the
+-- size needed for the files in the chroot.
+setSize :: PartSpec -> PartSize -> PartSpec
+setSize (mp, o, p) sz = (mp, o, const (p sz))
+
+-- | Sets a flag on the partition.
+setFlag :: PartSpec -> PartFlag -> PartSpec
+setFlag s f = adjustp s $ \p -> p { partFlags = (f, True):partFlags p }
+
+-- | Makes a MSDOS partition be Extended, rather than Primary.
+extended :: PartSpec -> PartSpec
+extended s = adjustp s $ \p -> p { partType = Extended }
+
+adjustp :: PartSpec -> (Partition -> Partition) -> PartSpec
+adjustp (mp, o, p) f = (mp, o, f . p)
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -70,6 +70,13 @@
 lacksLines :: FilePath -> [Line] -> Property NoInfo
 f `lacksLines` ls = fileProperty (f ++ " remove: " ++ show [ls]) (filter (`notElem` ls)) f
 
+-- | Replaces the content of a file with the transformed content of another file
+basedOn :: FilePath -> (FilePath, [Line] -> [Line]) -> Property NoInfo
+f `basedOn` (f', a) = property desc $ go =<< (liftIO $ readFile f')
+  where
+	desc = "replace " ++ f
+	go tmpl = ensureProperty $ fileProperty desc (\_ -> a $ lines $ tmpl) f
+
 -- | Removes a file. Does not remove symlinks or non-plain-files.
 notPresent :: FilePath -> Property NoInfo
 notPresent f = check (doesFileExist f) $ property (f ++ " not present") $ 
diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs
--- a/src/Propellor/Property/Grub.hs
+++ b/src/Propellor/Property/Grub.hs
@@ -18,14 +18,19 @@
 -- | Installs the grub package. This does not make grub be used as the
 -- bootloader.
 --
--- This includes running update-grub, so that the grub boot menu is
--- created. It will be automatically updated when kernel packages are
--- installed.
+-- This includes running update-grub.
 installed :: BIOS -> Property NoInfo
-installed bios = 
-	Apt.installed [pkg] `describe` "grub package installed"
-		`before`
-	cmdProperty "update-grub" []
+installed bios = installed' bios `before` mkConfig
+
+-- Run update-grub, to generate the grub boot menu. It will be
+-- automatically updated when kernel packages are
+--   -- installed.
+mkConfig :: Property NoInfo
+mkConfig = cmdProperty "update-grub" []
+
+-- | Installs grub; does not run update-grub.
+installed' :: BIOS -> Property NoInfo
+installed' bios = Apt.installed [pkg] `describe` "grub package installed"
   where
 	pkg = case bios of
 		PC -> "grub-pc"
diff --git a/src/Propellor/Property/Hostname.hs b/src/Propellor/Property/Hostname.hs
--- a/src/Propellor/Property/Hostname.hs
+++ b/src/Propellor/Property/Hostname.hs
@@ -2,12 +2,17 @@
 
 import Propellor.Base
 import qualified Propellor.Property.File as File
+import Propellor.Property.Chroot (inChroot)
 
 import Data.List
+import Data.List.Utils
 
--- | Ensures that the hostname is set using best practices.
+-- | Ensures that the hostname is set using best practices, to whatever
+-- name the `Host` has.
 --
--- Configures </etc/hostname> and the current hostname.
+-- Configures both </etc/hostname> and the current hostname.
+-- (However, when used inside a chroot, avoids setting the current hostname
+-- as that would impact the system outside the chroot.)
 --
 -- Configures </etc/mailname> with the domain part of the hostname.
 --
@@ -18,13 +23,23 @@
 -- other hostnames there is not best practices and can lead to annoying
 -- messages from eg, apache.
 sane :: Property NoInfo
-sane = property ("sane hostname") (ensureProperty . setTo =<< asks hostName)
+sane = sane' extractDomain
 
+sane' :: ExtractDomain -> Property NoInfo
+sane' extractdomain = property ("sane hostname") $
+	ensureProperty . setTo' extractdomain =<< asks hostName
+
+-- Like `sane`, but you can specify the hostname to use, instead
+-- of the default hostname of the `Host`.
 setTo :: HostName -> Property NoInfo
-setTo hn = combineProperties desc go
+setTo = setTo' extractDomain
+
+setTo' :: ExtractDomain -> HostName -> Property NoInfo
+setTo' extractdomain hn = combineProperties desc go
   where
 	desc = "hostname " ++ hn
-	(basehost, domain) = separate (== '.') hn
+	basehost = takeWhile (/= '.') hn
+	domain = extractdomain hn
 
 	go = catMaybes
 		[ Just $ "/etc/hostname" `File.hasContent` [basehost]
@@ -32,7 +47,8 @@
 			then Nothing 
 			else Just $ trivial $ hostsline "127.0.1.1" [hn, basehost]
 		, Just $ trivial $ hostsline "127.0.0.1" ["localhost"]
-		, Just $ trivial $ cmdProperty "hostname" [basehost]
+		, Just $ trivial $ check (not <$> inChroot) $
+			cmdProperty "hostname" [basehost]
 		, Just $ "/etc/mailname" `File.hasContent`
 			[if null domain then hn else domain]
 		]
@@ -47,11 +63,14 @@
 -- | Makes </etc/resolv.conf> contain search and domain lines for 
 -- the domain that the hostname is in.
 searchDomain :: Property NoInfo
-searchDomain = property desc (ensureProperty . go =<< asks hostName)
+searchDomain = searchDomain' extractDomain
+
+searchDomain' :: ExtractDomain -> Property NoInfo
+searchDomain' extractdomain = property desc (ensureProperty . go =<< asks hostName)
   where
 	desc = "resolv.conf search and domain configured"
 	go hn =
-		let (_basehost, domain) = separate (== '.') hn
+		let domain = extractdomain hn
 		in  File.fileProperty desc (use domain) "/etc/resolv.conf"
 	use domain ls = filter wanted $ nub (ls ++ cfgs)
 	  where
@@ -61,3 +80,21 @@
 			| "domain " `isPrefixOf` l = False
 			| "search " `isPrefixOf` l = False
 			| otherwise = True
+
+-- | Function to extract the domain name from a HostName.
+type ExtractDomain = HostName -> String
+
+-- | hostname of foo.example.com has a domain of example.com.
+-- But, when the hostname is example.com, the domain is
+-- example.com too.
+--
+-- This doesn't work for eg, foo.co.uk, or when foo.sci.uni.edu
+-- is in a sci.uni.edu subdomain. If you are in such a network,
+-- provide your own ExtractDomain function to the properties above.
+extractDomain :: ExtractDomain
+extractDomain hn = 
+	let bits = split "." hn
+	in intercalate "." $
+		if length bits > 2
+			then drop 1 bits
+			else bits
diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs
--- a/src/Propellor/Property/Mount.hs
+++ b/src/Propellor/Property/Mount.hs
@@ -1,29 +1,188 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances #-}
+
 module Propellor.Property.Mount where
 
 import Propellor.Base
+import qualified Propellor.Property.File as File
 import Utility.Path
 
-type FsType = String -- ^ type of filesystem to mount ("auto" to autodetect)
+import Data.Char
+import Data.List
+import Utility.Table
 
+-- | type of filesystem to mount ("auto" to autodetect)
+type FsType = String
+
+-- | A device or other thing to be mounted.
 type Source = String
 
+-- | A mount point for a filesystem.
+type MountPoint = FilePath
+
+-- | Filesystem mount options. Eg, "errors=remount-ro"
+newtype MountOpts = MountOpts [String]
+	deriving Monoid
+
+class ToMountOpts a where
+	toMountOpts :: a -> MountOpts
+	
+instance ToMountOpts MountOpts where
+	toMountOpts = id
+
+instance ToMountOpts String where
+	toMountOpts s = MountOpts [s]
+
+formatMountOpts :: MountOpts -> String
+formatMountOpts (MountOpts []) = "defaults"
+formatMountOpts (MountOpts l) = intercalate "," l
+
+-- | Mounts a device.
+mounted :: FsType -> Source -> MountPoint -> MountOpts -> Property NoInfo
+mounted fs src mnt opts = property (mnt ++ " mounted") $ 
+	toResult <$> liftIO (mount fs src mnt opts)
+
+-- | Bind mounts the first directory so its contents also appear
+-- in the second directory.
+bindMount :: FilePath -> FilePath -> Property NoInfo
+bindMount src dest = cmdProperty "mount" ["--bind", src, dest]
+	`describe` ("bind mounted " ++ src ++ " to " ++ dest)
+
+mount :: FsType -> Source -> MountPoint -> MountOpts -> IO Bool
+mount fs src mnt opts = boolSystem "mount" $
+	[ Param "-t", Param fs
+	, Param "-o", Param (formatMountOpts opts)
+	, Param src
+	, Param mnt
+	]
+
+newtype SwapPartition = SwapPartition FilePath
+
+-- | Replaces </etc/fstab> with a file that should cause the currently
+-- mounted partitions to be re-mounted the same way on boot.
+--
+-- For each specified MountPoint, the UUID of each partition
+-- (or if there is no UUID, its label), its filesystem type,
+-- and its mount options are all automatically probed.
+--
+-- The SwapPartitions are also included in the generated fstab.
+fstabbed :: [MountPoint] -> [SwapPartition] -> Property NoInfo
+fstabbed mnts swaps = property "fstabbed" $ do
+	fstab <- liftIO $ genFstab mnts swaps id
+	ensureProperty $ 
+		"/etc/fstab" `File.hasContent` fstab
+
+genFstab :: [MountPoint] -> [SwapPartition] -> (MountPoint -> MountPoint) -> IO [String]
+genFstab mnts swaps mnttransform = do
+	fstab <- liftIO $ mapM getcfg (sort mnts)
+	swapfstab <- liftIO $ mapM getswapcfg swaps
+	return $ header ++ formatTable (legend : fstab ++ swapfstab)
+  where
+	header =
+		[ "# /etc/fstab: static file system information. See fstab(5)"
+		, "# "
+		]
+	legend = ["# <file system>", "<mount point>", "<type>", "<options>", "<dump>", "<pass>"]
+	getcfg mnt = sequence
+		[ fromMaybe (error $ "unable to find mount source for " ++ mnt)
+			<$> getM (\a -> a mnt)
+				[ uuidprefix getMountUUID
+				, sourceprefix getMountLabel
+				, getMountSource
+				]
+		, pure (mnttransform mnt)
+		, fromMaybe "auto" <$> getFsType mnt
+		, formatMountOpts <$> getFsMountOpts mnt
+		, pure "0"
+		, pure (if mnt == "/" then "1" else "2")
+		]
+	getswapcfg (SwapPartition swap) = sequence
+		[ fromMaybe swap <$> getM (\a -> a swap)
+			[ uuidprefix getSourceUUID
+			, sourceprefix getSourceLabel
+			]
+		, pure "none"
+		, pure "swap"
+		, pure (formatMountOpts mempty)
+		, pure "0"
+		, pure "0"
+		]
+	prefix s getter m = fmap (s ++) <$> getter m
+	uuidprefix = prefix "UUID="
+	sourceprefix = prefix "LABEL="
+
+-- | Checks if </etc/fstab> is not configured. 
+-- This is the case if it doesn't exist, or
+-- consists entirely of blank lines or comments.
+--
+-- So, if you want to only replace the fstab once, and then never touch it
+-- again, allowing local modifications:
+--
+-- > check noFstab (fstabbed mnts [])
+noFstab :: IO Bool
+noFstab = ifM (doesFileExist "/etc/fstab")
+	( null . filter iscfg . lines <$> readFile "/etc/fstab"
+	, return True
+	)
+  where
+	iscfg l
+		| null l = False
+		| otherwise = not $ "#" `isPrefixOf` dropWhile isSpace l
+	
 -- | Lists all mount points of the system.
-mountPoints :: IO [FilePath]
+mountPoints :: IO [MountPoint]
 mountPoints = lines <$> readProcess "findmnt" ["-rn", "--output", "target"]
 
 -- | Finds all filesystems mounted inside the specified directory.
-mountPointsBelow :: FilePath -> IO [FilePath]
+mountPointsBelow :: FilePath -> IO [MountPoint]
 mountPointsBelow target = filter (\p -> simplifyPath p /= simplifyPath target)
 	. filter (dirContains target)
 	<$> mountPoints
 
 -- | Filesystem type mounted at a given location.
-getFsType :: FilePath -> IO (Maybe FsType)
-getFsType mnt = catchDefaultIO Nothing $
-	headMaybe . lines
-		<$> readProcess "findmnt" ["-n", mnt, "--output", "fstype"]
+getFsType :: MountPoint -> IO (Maybe FsType)
+getFsType = findmntField "fstype"
 
--- | Unmounts a device, lazily so any running processes don't block it.
+-- | Mount options for the filesystem mounted at a given location.
+getFsMountOpts :: MountPoint -> IO MountOpts
+getFsMountOpts p = maybe mempty toMountOpts
+	<$> findmntField "fs-options" p
+
+type UUID = String
+
+-- | UUID of filesystem mounted at a given location.
+getMountUUID :: MountPoint -> IO (Maybe UUID)
+getMountUUID = findmntField "uuid"
+
+-- | UUID of a device
+getSourceUUID :: Source -> IO (Maybe UUID)
+getSourceUUID = blkidTag "UUID"
+
+type Label = String
+
+-- | Label of filesystem mounted at a given location.
+getMountLabel :: MountPoint -> IO (Maybe Label)
+getMountLabel = findmntField "label"
+
+-- | Label of a device
+getSourceLabel :: Source -> IO (Maybe UUID)
+getSourceLabel = blkidTag "LABEL"
+
+-- | Device mounted at a given location.
+getMountSource :: MountPoint -> IO (Maybe Source)
+getMountSource = findmntField "source"
+
+findmntField :: String -> FilePath -> IO (Maybe String)
+findmntField field mnt = catchDefaultIO Nothing $
+	headMaybe . filter (not . null) . lines
+		<$> readProcess "findmnt" ["-n", mnt, "--output", field]
+
+blkidTag :: String -> Source -> IO (Maybe String)
+blkidTag tag dev = catchDefaultIO Nothing $
+	headMaybe . filter (not . null) . lines
+		<$> readProcess "blkid" [dev, "-s", tag, "-o", "value"]
+
+-- | Unmounts a device or mountpoint,
+-- lazily so any running processes don't block it.
 umountLazy :: FilePath -> IO ()
 umountLazy mnt =  
 	unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $
@@ -34,7 +193,3 @@
 unmountBelow d = do
 	submnts <- mountPointsBelow d
 	forM_ submnts umountLazy
-
--- | Mounts a device.
-mount :: FsType -> Source -> FilePath -> IO Bool
-mount fs src mnt = boolSystem "mount" [Param "-t", Param fs, Param src, Param mnt]
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -123,16 +123,16 @@
 
 		-- Remount /dev, so that block devices etc are
 		-- available for other properties to use.
-		unlessM (mount devfstype devfstype "/dev") $ do
+		unlessM (mount devfstype devfstype "/dev" mempty) $ do
 			warningMessage $ "failed mounting /dev using " ++ devfstype ++ "; falling back to MAKEDEV generic"
 			void $ boolSystem "sh" [Param "-c", Param "cd /dev && /sbin/MAKEDEV generic"]
 
 		-- Mount /sys too, needed by eg, grub-mkconfig.
-		unlessM (mount "sysfs" "sysfs" "/sys") $
+		unlessM (mount "sysfs" "sysfs" "/sys" mempty) $
 			warningMessage "failed mounting /sys"
 
 		-- And /dev/pts, used by apt.
-		unlessM (mount "devpts" "devpts" "/dev/pts") $
+		unlessM (mount "devpts" "devpts" "/dev/pts" mempty) $
 			warningMessage "failed mounting /dev/pts"
 
 		return MadeChange
diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs
--- a/src/Propellor/Property/Parted.hs
+++ b/src/Propellor/Property/Parted.hs
@@ -160,7 +160,7 @@
 		[ parted eep disk partedparams
 		, if isdev
 			then formatl (map (\n -> disk ++ show n) [1 :: Int ..])
-			else Partition.kpartx disk formatl
+			else Partition.kpartx disk (formatl . map Partition.partitionLoopDev)
 		]
   where
 	desc = disk ++ " partitioned"
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs
--- a/src/Propellor/Property/Partition.hs
+++ b/src/Propellor/Property/Partition.hs
@@ -4,10 +4,14 @@
 
 import Propellor.Base
 import qualified Propellor.Property.Apt as Apt
+import Utility.Applicative
 
+import System.Posix.Files
+import Data.List
+
 -- | Filesystems etc that can be used for a partition.
 data Fs = EXT2 | EXT3 | EXT4 | BTRFS | REISERFS | XFS | FAT | VFAT | NTFS | LinuxSwap
-	deriving (Show)
+	deriving (Show, Eq)
 
 data Eep = YesReallyFormatPartition
 
@@ -41,20 +45,44 @@
 	-- Be quiet.
 	q l = "-q":l
 
+data LoopDev = LoopDev
+	{ partitionLoopDev :: FilePath -- ^ device for a loop partition
+	, wholeDiskLoopDev :: FilePath -- ^ corresponding device for the whole loop disk
+	} deriving (Show)
+
+isLoopDev :: LoopDev -> IO Bool
+isLoopDev l = isLoopDev' (partitionLoopDev l) <&&> isLoopDev' (wholeDiskLoopDev l)
+
+isLoopDev' :: FilePath -> IO Bool
+isLoopDev' f
+	| "loop" `isInfixOf` f = catchBoolIO $
+		isBlockDevice <$> getFileStatus f
+	| otherwise = return False
+
 -- | Uses the kpartx utility to create device maps for partitions contained
--- within a disk image file. The resulting devices are passed to the
+-- within a disk image file. The resulting loop devices are passed to the
 -- property, which can operate on them. Always cleans up after itself,
 -- by removing the device maps after the property is run.
-kpartx :: FilePath -> ([FilePath] -> Property NoInfo) -> Property NoInfo
+kpartx :: FilePath -> ([LoopDev] -> Property NoInfo) -> Property NoInfo
 kpartx diskimage mkprop = go `requires` Apt.installed ["kpartx"]
   where
 	go = property (propertyDesc (mkprop [])) $ do
 		cleanup -- idempotency
-		s <- liftIO $ readProcess "kpartx" ["-avs", diskimage]
-		r <- ensureProperty (mkprop (devlist s))
+		loopdevs <- liftIO $ kpartxParse
+			<$> readProcess "kpartx" ["-avs", diskimage]
+		bad <- liftIO $ filterM (not <$$> isLoopDev) loopdevs
+		unless (null bad) $
+			error $ "kpartx output seems to include non-loop-devices (possible parse failure): " ++ show bad
+		r <- ensureProperty (mkprop loopdevs)
 		cleanup
 		return r
-	devlist = mapMaybe (finddev . words) . lines
-	finddev ("add":"map":s:_) = Just ("/dev/mapper/" ++ s)
-	finddev _ = Nothing
 	cleanup = void $ liftIO $ boolSystem "kpartx" [Param "-d", File diskimage]
+
+kpartxParse :: String -> [LoopDev]
+kpartxParse = mapMaybe (finddev . words) . lines
+  where
+	finddev ("add":"map":ld:_:_:_:_:wd:_) = Just $ LoopDev 
+		{ partitionLoopDev = "/dev/mapper/" ++ ld
+		, wholeDiskLoopDev = wd
+		}
+	finddev _ = Nothing
diff --git a/src/Propellor/Property/Rsync.hs b/src/Propellor/Property/Rsync.hs
--- a/src/Propellor/Property/Rsync.hs
+++ b/src/Propellor/Property/Rsync.hs
@@ -22,10 +22,12 @@
 data Filter 
 	= Include Pattern
 	| Exclude Pattern
+	| Protect Pattern
 
 instance RsyncParam Filter where
 	toRsync (Include (Pattern p)) = "--include=" ++ p
 	toRsync (Exclude (Pattern p)) = "--exclude=" ++ p
+	toRsync (Protect (Pattern p)) = "--filter=P " ++ p
 
 -- | A pattern to match against files that rsync is going to transfer.
 --
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -99,13 +99,12 @@
 
 autoBuilderContainer :: (System -> Flavor -> Property HasInfo) -> System -> Flavor -> Times -> TimeOut -> Systemd.Container
 autoBuilderContainer mkprop osver@(System _ arch) flavor crontime timeout =
-	Systemd.container name bootstrap
+	Systemd.container name osver (Chroot.debootstrapped mempty)
 		& mkprop osver flavor
 		& buildDepsApt
 		& autobuilder arch crontime timeout
   where
 	name = arch ++ fromMaybe "" flavor ++ "-git-annex-builder"
-	bootstrap = Chroot.debootstrapped osver mempty
 
 type Flavor = Maybe String
 
@@ -144,8 +143,7 @@
 	-> Property i
 	-> FilePath
 	-> Systemd.Container
-androidContainer name setupgitannexdir gitannexdir = Systemd.container name bootstrap
-	& os osver
+androidContainer name setupgitannexdir gitannexdir = Systemd.container name osver bootstrap
 	& Apt.stdSourcesList
 	& User.accountFor (User builduser)
 	& File.dirExists gitbuilderdir
@@ -161,4 +159,4 @@
 		[ "cd " ++ gitannexdir ++ " && ./standalone/android/buildchroot-inchroot"
 		]
 	osver = System (Debian (Stable "jessie")) "i386"
-	bootstrap = Chroot.debootstrapped osver mempty
+	bootstrap = Chroot.debootstrapped mempty
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -15,6 +15,7 @@
 import qualified Propellor.Property.Obnam as Obnam
 import qualified Propellor.Property.Apache as Apache
 import qualified Propellor.Property.Postfix as Postfix
+import qualified Propellor.Property.Systemd as Systemd
 import Utility.FileMode
 
 import Data.List
@@ -346,6 +347,7 @@
 		`onChange` Service.restarted "rsync"
 	& "/etc/default/rsync" `File.containsLine` "RSYNC_ENABLE=true"
 		`onChange` Service.running "rsync"
+	& Systemd.enabled "rsync"
 	& endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild"
 	& endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild/x86_64-apple-yosemite"
 	& endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild/windows"
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -4,6 +4,7 @@
 	installed,
 	restarted,
 	PubKeyText,
+	SshKeyType(..),
 	-- * Daemon configuration
 	sshdConfig,
 	ConfigKeyword,
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -174,21 +174,22 @@
 					Apt.installed ["systemd-container"]
 			_ -> noChange
 
--- | Defines a container with a given machine name.
+-- | Defines a container with a given machine name, and operating system,
+-- and how to create its chroot if not already present.
 --
 -- Properties can be added to configure the Container.
 --
--- > container "webserver" (Chroot.debootstrapped (System (Debian Unstable) "amd64") mempty)
+-- > container "webserver" (System (Debian Unstable) "amd64") (Chroot.debootstrapped mempty)
 -- >    & Apt.installedRunning "apache2"
 -- >    & ...
-container :: MachineName -> (FilePath -> Chroot.Chroot) -> Container
-container name mkchroot = Container name c h
+container :: MachineName -> System -> (FilePath -> Chroot.Chroot) -> Container
+container name system mkchroot = Container name c h
 	& os system
 	& resolvConfed
 	& linkJournal
   where
 	c = mkchroot (containerDir name)
-	system = Chroot.chrootSystem c
+		& os system
 	h = Host name [] mempty
 
 -- | Runs a container using systemd-nspawn.
@@ -206,7 +207,7 @@
 -- Reverting this property stops the container, removes the systemd unit,
 -- and deletes the chroot and all its contents.
 nspawned :: Container -> RevertableProperty
-nspawned c@(Container name (Chroot.Chroot loc system builder _) h) =
+nspawned c@(Container name (Chroot.Chroot loc builder _) h) =
 	p `describe` ("nspawned " ++ name)
   where
 	p = enterScript c
@@ -216,7 +217,7 @@
 
 	-- Chroot provisioning is run in systemd-only mode,
 	-- which sets up the chroot and ensures systemd and dbus are
-	-- installed, but does not handle the other provisions.
+	-- installed, but does not handle the other properties.
 	chrootprovisioned = Chroot.provisioned' (Chroot.propagateChrootInfo chroot) chroot True
 
 	-- Use nsenter to enter container and and run propellor to
@@ -226,7 +227,7 @@
 			<!>
 		doNothing
 
-	chroot = Chroot.Chroot loc system builder h
+	chroot = Chroot.Chroot loc builder h
 
 -- | Sets up the service file for the container, and then starts
 -- it running.
@@ -382,7 +383,8 @@
 -- > 		`requires` Systemd.running Systemd.networkd
 -- >
 -- > webserver :: Systemd.container
--- > webserver = Systemd.container "webserver" (Chroot.debootstrapped (System (Debian Testing) "amd64") mempty)
+-- > webserver = Systemd.container "webserver" (Chroot.debootstrapped mempty)
+-- >	& os (System (Debian Testing) "amd64")
 -- >	& Systemd.privateNetwork
 -- >	& Systemd.running Systemd.networkd
 -- >	& Systemd.publish (Port 80 ->- Port 8080)
diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs
--- a/src/Propellor/Property/User.hs
+++ b/src/Propellor/Property/User.hs
@@ -58,14 +58,21 @@
 setPassword :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result
 setPassword getpassword = getpassword $ go
   where
-	go (Password user, password) = set user (privDataVal password) []
-	go (CryptPassword user, hash) = set user (privDataVal hash) ["--encrypted"]
+	go (Password user, password) = chpasswd (User user) (privDataVal password) []
+	go (CryptPassword user, hash) = chpasswd (User user) (privDataVal hash) ["--encrypted"]
 	go (f, _) = error $ "Unexpected type of privdata: " ++ show f
 
-	set user v ps = makeChange $ withHandle StdinHandle createProcessSuccess
-		(proc "chpasswd" ps) $ \h -> do
-			hPutStrLn h $ user ++ ":" ++ v
-			hClose h
+-- | Makes a user's password be the passed String. Highly insecure:
+-- The password is right there in your config file for anyone to see!
+hasInsecurePassword :: User -> String -> Property NoInfo
+hasInsecurePassword u@(User n) p = property (n ++ " has insecure password") $
+	chpasswd u p []
+
+chpasswd :: User -> String -> [String] -> Propellor Result
+chpasswd (User user) v ps = makeChange $ withHandle StdinHandle createProcessSuccess
+	(proc "chpasswd" ps) $ \h -> do
+		hPutStrLn h $ user ++ ":" ++ v
+		hClose h
 
 lockedPassword :: User -> Property NoInfo
 lockedPassword user@(User u) = check (not <$> isLockedPassword user) $ cmdProperty "passwd"
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -29,6 +29,7 @@
 	, CombinedType
 	, combineWith
 	, Propellor(..)
+	, LiftPropellor(..)
 	, EndAction(..)
 	, module Propellor.Types.OS
 	, module Propellor.Types.Dns
@@ -71,6 +72,15 @@
 		, MonadThrow
 		, MonadMask
 		)
+
+class LiftPropellor m where
+	liftPropellor :: m a -> Propellor a
+
+instance LiftPropellor Propellor where
+	liftPropellor = id
+
+instance LiftPropellor IO where
+	liftPropellor = liftIO
 
 instance Monoid (Propellor Result) where
 	mempty = return NoChange