Merge branch 'master' of https://git.joeyh.name/git/propellor into sbuild-overhaul

18 files changed, 587 insertions, 156 deletions

diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
index 170c85d6..04f23f85 100644
--- a/src/Propellor/Bootstrap.hs
+++ b/src/Propellor/Bootstrap.hs
@@ -80,7 +80,7 @@ buildCommand bs = intercalate " && " (go (getBuilder bs))
   where
 	go Cabal =
 		[ "cabal configure"
-		, "cabal build propellor-config"
+		, "cabal build -j1 propellor-config"
 		, "ln -sf dist/build/propellor-config/propellor-config propellor"
 		]
 	go Stack =
@@ -280,7 +280,9 @@ cabalBuild msys = do
 				boolSystem "sh" [Param "-c", Param (depsCommand (Robustly Cabal) (Just sys))]
 					<&&> cabal ["configure"]
 		)
-	cabal_build = cabal ["build", "propellor-config"]
+	-- The -j1 is to only run one job at a time -- in some situations,
+	-- eg in qemu, ghc does not run reliably in parallel.
+	cabal_build = cabal ["build", "-j1", "propellor-config"]
 
 stackBuild :: Maybe System -> IO Bool
 stackBuild _msys = do
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index ea8b1407..0dd1f05a 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -9,7 +9,6 @@ module Propellor.Property.Chroot (
 	ChrootBootstrapper(..),
 	Debootstrapped(..),
 	ChrootTarball(..),
-	noServices,
 	inChroot,
 	exposeTrueLocaldir,
 	-- * Internal use
@@ -32,7 +31,6 @@ 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
-import Utility.FileMode
 import Utility.Split
 
 import qualified Data.Map as M
@@ -257,26 +255,6 @@ mungeloc = replace "/" "_"
 chrootDesc :: Chroot -> String -> String
 chrootDesc (Chroot loc _ _ _) desc = "chroot " ++ loc ++ " " ++ desc
 
--- | Adding this property to a chroot prevents daemons and other services
--- from being started, which is often something you want to prevent when
--- building a chroot.
---
--- On Debian, this is accomplished by installing a </usr/sbin/policy-rc.d>
--- script that does not let any daemons be started by packages that use
--- invoke-rc.d. Reverting the property removes the script.
---
--- This property has no effect on non-Debian systems.
-noServices :: RevertableProperty UnixLike UnixLike
-noServices = setup <!> teardown
-  where
-	f = "/usr/sbin/policy-rc.d"
-	script = [ "#!/bin/sh", "exit 101" ]
-	setup = combineProperties "no services started" $ toProps
-		[ File.hasContent f script
-		, File.mode f (combineModes (readModes ++ executeModes))
-		]
-	teardown = File.notPresent f
-
 -- | Check if propellor is currently running within a chroot.
 --
 -- This allows properties to check and avoid performing actions that
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index a9412b95..7c8e9618 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TypeFamilies #-}
+
 module Propellor.Property.Debootstrap (
 	Url,
 	DebootstrapConfig(..),
@@ -6,12 +8,12 @@ module Propellor.Property.Debootstrap (
 	extractSuite,
 	installed,
 	sourceInstall,
-	programPath,
 ) where
 
 import Propellor.Base
 import qualified Propellor.Property.Apt as Apt
 import Propellor.Property.Chroot.Util
+import Propellor.Property.Qemu
 import Utility.Path
 import Utility.FileMode
 
@@ -29,6 +31,7 @@ data DebootstrapConfig
 	| MinBase
 	| BuilddD
 	| DebootstrapParam String
+	| UseEmulation
 	| DebootstrapConfig :+ DebootstrapConfig
 	deriving (Show)
 
@@ -41,15 +44,41 @@ toParams DefaultConfig = []
 toParams MinBase = [Param "--variant=minbase"]
 toParams BuilddD = [Param "--variant=buildd"]
 toParams (DebootstrapParam p) = [Param p]
+toParams UseEmulation = []
 toParams (c1 :+ c2) = toParams c1 <> toParams c2
 
+useEmulation :: DebootstrapConfig -> Bool
+useEmulation UseEmulation = True
+useEmulation (a :+ b) = useEmulation a || useEmulation b
+useEmulation _ = False
+
 -- | Builds a chroot in the given directory using debootstrap.
 --
 -- The System can be any OS and architecture that debootstrap
 -- and the kernel support.
+--
+-- When the System is architecture that the kernel does not support,
+-- it can still be bootstrapped using emulation. This is determined
+-- by checking `supportsArch`, or can be configured with `UseEmulation`.
+--
+-- When emulation is used, the chroot will have an additional binary 
+-- installed in it. To get a completelty clean chroot (eg for producing a
+-- bootable disk image), use the `removeHostEmulationBinary` property.
 built :: FilePath -> System -> DebootstrapConfig -> Property Linux
-built target system config = built' (setupRevertableProperty installed) target system config
+built target system@(System _ targetarch) config =
+	withOS ("debootstrapped " ++ target) go
+  where
+	go w (Just hostos)
+		| supportsArch hostos targetarch && not (useEmulation config) =
+			ensureProperty w $
+				built' (setupRevertableProperty installed)
+					target system config
+	go w _ = ensureProperty w $ do
+		let p = setupRevertableProperty foreignBinariesEmulated
+			`before` setupRevertableProperty installed
+		built' p target system (config :+ UseEmulation)
 
+-- | Like `built`,  but uses the provided Property to install debootstrap.
 built' :: Property Linux -> FilePath -> System -> DebootstrapConfig -> Property Linux
 built' installprop target system@(System _ arch) config = 
 	go `before` oldpermfix
@@ -68,7 +97,9 @@ built' installprop target system@(System _ arch) config =
 			, Param suite
 			, Param target
 			]
-		cmd <- fromMaybe "debootstrap" <$> programPath
+		cmd <- if useEmulation config
+			then pure "qemu-debootstrap"
+			else fromMaybe "debootstrap" <$> programPath
 		de <- standardPathEnv
 		ifM (boolSystemEnv cmd params (Just de))
 			( return MadeChange
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 6c1a572c..2c35b532 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -24,9 +24,12 @@ import Propellor.Property.Chroot (Chroot)
 import Propellor.Property.Chroot.Util (removeChroot)
 import Propellor.Property.Mount
 import qualified Propellor.Property.Chroot as Chroot
+import qualified Propellor.Property.Service as Service
 import qualified Propellor.Property.Grub as Grub
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Qemu as Qemu
+import qualified Propellor.Property.FlashKernel as FlashKernel
 import Propellor.Property.Parted
 import Propellor.Property.Fstab (SwapPartition(..), genFstab)
 import Propellor.Property.Partition
@@ -101,7 +104,7 @@ instance DiskImage VirtualBoxPointer where
 -- to avoid expensive IO to generate a new one. And, it's updated in-place,
 -- so its contents are undefined during the build process.
 --
--- Note that the `Chroot.noServices` property is automatically added to the
+-- Note that the `Service.noServices` property is automatically added to the
 -- chroot while the disk image is being built, which should prevent any
 -- daemons that are included from being started on the system that is
 -- building the disk image.
@@ -183,7 +186,7 @@ imageBuilt' rebuild img mkchroot tabletype partspec =
 		in setContainerProps c $ containerProps c
 			-- Before ensuring any other properties of the chroot,
 			-- avoid starting services. Reverted by imageFinalized.
-			&^ Chroot.noServices
+			&^ Service.noServices
 			& cachesCleaned
 	-- Only propagate privdata Info from this chroot, nothing else.
 	propprivdataonly (Chroot.Chroot d b ip h) =
@@ -191,8 +194,14 @@ imageBuilt' rebuild img mkchroot tabletype partspec =
 	-- Pick boot loader finalization based on which bootloader is
 	-- installed.
 	final = case fromInfo (containerInfo chroot) of
-		[GrubInstalled] -> grubBooted
 		[] -> unbootable "no bootloader is installed"
+		[GrubInstalled] -> grubFinalized
+		[UbootInstalled p] -> ubootFinalized p
+		[FlashKernelInstalled] -> flashKernelFinalized
+		[UbootInstalled p, FlashKernelInstalled] -> 
+			ubootFlashKernelFinalized p
+		[FlashKernelInstalled, UbootInstalled p] -> 
+			ubootFlashKernelFinalized p
 		_ -> unbootable "multiple bootloaders are installed; don't know which to use"
 
 -- | This property is automatically added to the chroot when building a
@@ -215,7 +224,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg
 		liftIO $ unmountBelow chrootdir
 		szm <- M.mapKeys (toSysDir chrootdir) . M.map toPartSize
 			<$> liftIO (dirSizes chrootdir)
-		let calcsz mnts = maybe defSz fudge . getMountSz szm mnts
+		let calcsz mnts = maybe defSz fudgeSz . getMountSz szm mnts
 		-- tie the knot!
 		let (mnts, mntopts, parttable) = fitChrootSize tabletype partspec $
 			map (calcsz mnts) mnts
@@ -228,7 +237,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg
 	mkimg' mnts mntopts parttable devs =
 		partitionsPopulated chrootdir mnts mntopts devs
 			`before`
-		imageFinalized final mnts mntopts devs parttable
+		imageFinalized final dest mnts mntopts devs parttable
 	rmimg = undoRevertableProperty (buildDiskImage img)
 		`before` undoRevertableProperty (imageExists' dest dummyparttable)
 	dummyparttable = PartTable tabletype []
@@ -351,10 +360,10 @@ imageExists' dest@(RawDiskImage img) parttable = (setup <!> cleanup) `describe`
 --
 -- It's ok if the property leaves additional things mounted
 -- in the partition tree.
-type Finalization = (FilePath -> [LoopDev] -> Property Linux)
+type Finalization = (RawDiskImage -> FilePath -> [LoopDev] -> Property Linux)
 
-imageFinalized :: Finalization -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> PartTable -> Property Linux
-imageFinalized final mnts mntopts devs (PartTable _ parts) =
+imageFinalized :: Finalization -> RawDiskImage -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> PartTable -> Property Linux
+imageFinalized final img mnts mntopts devs (PartTable _ parts) =
 	property' "disk image finalized" $ \w ->
 		withTmpDir "mnt" $ \top ->
 			go w top `finally` liftIO (unmountall top)
@@ -363,7 +372,9 @@ imageFinalized final mnts mntopts devs (PartTable _ parts) =
 		liftIO $ mountall top
 		liftIO $ writefstab top
 		liftIO $ allowservices top
-		ensureProperty w $ final top devs
+		ensureProperty w $ 
+			final img top devs
+				`before` Qemu.removeHostEmulationBinary top
 
 	-- Ordered lexographically by mount point, so / comes before /usr
 	-- comes before /usr/local
@@ -399,18 +410,14 @@ imageFinalized final mnts mntopts devs (PartTable _ parts) =
 	allowservices top = nukeFile (top ++ "/usr/sbin/policy-rc.d")
 
 unbootable :: String -> Finalization
-unbootable msg = \_ _ -> property desc $ do
+unbootable msg = \_ _ _ -> property desc $ do
 	warningMessage (desc ++ ": " ++ msg)
 	return FailedChange
   where
 	desc = "image is not bootable"
 
--- | Makes grub be the boot loader of the disk image.
---
--- This does not install the grub package. You will need to add
--- the `Grub.installed` property to the chroot.
-grubBooted :: Finalization
-grubBooted mnt loopdevs = Grub.bootsMounted mnt wholediskloopdev
+grubFinalized :: Finalization
+grubFinalized _img mnt loopdevs = Grub.bootsMounted mnt wholediskloopdev
 	`describe` "disk image boots using grub"
   where
 	-- It doesn't matter which loopdev we use; all
@@ -420,6 +427,17 @@ grubBooted mnt loopdevs = Grub.bootsMounted mnt wholediskloopdev
 		(l:_) -> wholeDiskLoopDev l
 		[] -> error "No loop devs provided!"
 
+ubootFinalized :: (FilePath -> FilePath -> Property Linux) -> Finalization
+ubootFinalized p (RawDiskImage img) mnt _loopdevs = p img mnt
+
+flashKernelFinalized :: Finalization
+flashKernelFinalized _img mnt _loopdevs = FlashKernel.flashKernelMounted mnt
+
+ubootFlashKernelFinalized :: (FilePath -> FilePath -> Property Linux) -> Finalization
+ubootFlashKernelFinalized p img mnt loopdevs = 
+	ubootFinalized p img mnt loopdevs
+		`before` flashKernelFinalized img mnt loopdevs
+
 isChild :: FilePath -> Maybe MountPoint -> Bool
 isChild mntpt (Just d)
 	| d `equalFilePath` mntpt = False
diff --git a/src/Propellor/Property/DiskImage/PartSpec.hs b/src/Propellor/Property/DiskImage/PartSpec.hs
index 55249889..f7492589 100644
--- a/src/Propellor/Property/DiskImage/PartSpec.hs
+++ b/src/Propellor/Property/DiskImage/PartSpec.hs
@@ -1,10 +1,5 @@
 -- | Disk image partition specification and combinators.
 
--- Partitions in disk images default to being sized large enough 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.
-
 module Propellor.Property.DiskImage.PartSpec (
 	module Propellor.Types.PartSpec,
 	module Propellor.Property.DiskImage.PartSpec,
@@ -17,17 +12,63 @@ import Propellor.Property.Parted
 import Propellor.Types.PartSpec
 import Propellor.Property.Parted.Types
 import Propellor.Property.Partition (Fs(..))
+import Propellor.Property.Mount
+
+-- | Specifies a partition with a given filesystem.
+--
+-- The partition is not mounted anywhere by default; use the combinators
+-- below to configure it.
+partition :: Monoid t => Fs -> PartSpec t
+partition fs = (Nothing, mempty, mkPartition fs, mempty)
+
+-- | Specifies a swap partition of a given size.
+swapPartition :: Monoid t => PartSize -> PartSpec t
+swapPartition sz = (Nothing, mempty, const (mkPartition LinuxSwap sz), mempty)
 
--- | Adds additional free space to the partition.
+-- | Specifies where to mount a partition.
+mountedAt :: PartSpec t -> FilePath -> PartSpec t
+mountedAt (_, o, p, t) mp = (Just mp, o, p, t)
+
+-- | Partitions in disk images default to being sized large enough to hold
+-- the files that live in that partition.
+--
+-- This adds additional free space to a partition.
 addFreeSpace :: PartSpec t -> PartSize -> PartSpec t
 addFreeSpace (mp, o, p, t) freesz = (mp, o, p', t)
   where
 	p' = \sz -> p (sz <> freesz)
 
--- | 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)
+-- | Specify a fixed size for a partition.
+setSize :: PartSpec t -> PartSize -> PartSpec t
+setSize (mp, o, p, t) sz = (mp, o, const (p sz), t)
+
+-- | Specifies a mount option, such as "noexec"
+mountOpt :: ToMountOpts o => PartSpec t -> o -> PartSpec t
+mountOpt (mp, o, p, t) o' = (mp, o <> toMountOpts o', p, t)
+
+-- | Mount option to make a partition be remounted readonly when there's an
+-- error accessing it.
+errorReadonly :: MountOpts
+errorReadonly = toMountOpts "errors=remount-ro"
+
+-- | Sets the percent of the filesystem blocks reserved for the super-user.
+--
+-- The default is 5% for ext2 and ext4. Some filesystems may not support
+-- this.
+reservedSpacePercentage :: PartSpec t -> Int -> PartSpec t
+reservedSpacePercentage s percent = adjustp s $ \p -> 
+	p { partMkFsOpts = ("-m"):show percent:partMkFsOpts p }
+
+-- | Sets a flag on the partition.
+setFlag :: PartSpec t -> PartFlag -> PartSpec t
+setFlag s f = adjustp s $ \p -> p { partFlags = (f, True):partFlags p }
+
+-- | Makes a MSDOS partition be Extended, rather than Primary.
+extended :: PartSpec t -> PartSpec t
+extended s = adjustp s $ \p -> p { partType = Extended }
+
+adjustp :: PartSpec t -> (Partition -> Partition) -> PartSpec t
+adjustp (mp, o, p, t) f = (mp, o, f . p, t)
+
+adjustt :: PartSpec t -> (t -> t) -> PartSpec t
+adjustt (mp, o, p, t) f = (mp, o, p, f t)
diff --git a/src/Propellor/Property/Fail2Ban.hs b/src/Propellor/Property/Fail2Ban.hs
index 9f147943..342e2acb 100644
--- a/src/Propellor/Property/Fail2Ban.hs
+++ b/src/Propellor/Property/Fail2Ban.hs
@@ -2,6 +2,7 @@ module Propellor.Property.Fail2Ban where
 
 import Propellor.Base
 import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Service as Service
 import Propellor.Property.ConfFile
 
@@ -13,18 +14,47 @@ reloaded = Service.reloaded "fail2ban"
 
 type Jail = String
 
+type Filter = String
+
+type Action = String
+
 -- | By default, fail2ban only enables the ssh jail, but many others
 -- are available to be enabled, for example "postfix-sasl"
 jailEnabled :: Jail -> Property DebianLike
-jailEnabled name = jailConfigured name "enabled" "true"
+jailEnabled name = jailEnabled' name []
+	`onChange` reloaded
+
+jailEnabled' :: Jail -> [(IniKey, String)] -> Property DebianLike
+jailEnabled' name settings =
+	jailConfigured' name (("enabled", "true") : settings)
 	`onChange` reloaded
 
 -- | Configures a jail. For example:
 --
--- > jailConfigured "sshd" "port" "2222"
+-- > jailConfigured' "sshd" [("port", "2222")]
+jailConfigured' :: Jail -> [(IniKey, String)] -> Property UnixLike
+jailConfigured' name settings = propertyList ("jail \"" ++ name ++ "\" configuration") $ props
+	-- removes .conf files added by old versions of Fail2Ban properties
+	& File.notPresent (oldJailConfFile name)
+	& jailConfFile name `iniFileContains` [(name, settings)]
+
+-- | Adds a setting to a given jail. For example:
+--
+-- > jailConfigured "sshd" "port"  "2222"
 jailConfigured :: Jail -> IniKey -> String -> Property UnixLike
-jailConfigured name key value = 
-	jailConfFile name `containsIniSetting` (name, key, value)
+jailConfigured name key value = propertyList ("jail \"" ++ name ++ "\" configuration") $ props
+	-- removes .conf files added by old versions of Fail2Ban properties
+	& File.notPresent (oldJailConfFile name)
+	& jailConfFile name `containsIniSetting` (name, key, value)
+
+oldJailConfFile :: Jail -> FilePath
+oldJailConfFile name = "/etc/fail2ban/jail.d/" ++ name ++ ".conf"
 
 jailConfFile :: Jail -> FilePath
-jailConfFile name = "/etc/fail2ban/jail.d/" ++ name ++ ".conf"
+jailConfFile name = "/etc/fail2ban/jail.d/" ++ name ++ ".local"
+
+filterConfFile :: Filter -> FilePath
+filterConfFile name = "/etc/fail2ban/filter.d/" ++ name ++ ".local"
+
+actionConfFile :: Action -> FilePath
+actionConfFile name = "/etc/fail2ban/action.d/" ++ name ++ ".local"
diff --git a/src/Propellor/Property/FlashKernel.hs b/src/Propellor/Property/FlashKernel.hs
new file mode 100644
index 00000000..3f65f872
--- /dev/null
+++ b/src/Propellor/Property/FlashKernel.hs
@@ -0,0 +1,63 @@
+-- | Make ARM systems bootable using Debian's flash-kernel package.
+
+module Propellor.Property.FlashKernel where
+
+import Propellor.Base
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+import Propellor.Property.Mount
+import Propellor.Types.Bootloader
+import Propellor.Types.Info
+
+-- | A machine name, such as "Cubietech Cubietruck" or "Olimex A10-OLinuXino-LIME"
+--
+-- flash-kernel supports many different machines,
+-- see its file /usr/share/flash-kernel/db/all.db for a list.
+type Machine = String
+
+-- | Uses flash-kernel to make a machine bootable.
+--
+-- Before using this, an appropriate kernel needs to already be installed, 
+-- and on many machines, u-boot needs to be installed too.
+installed :: Machine -> Property (HasInfo + DebianLike)
+installed machine = setInfoProperty go (toInfo [FlashKernelInstalled])
+  where
+	go = "/etc/flash-kernel/machine" `File.hasContent` [machine]
+		`onChange` (cmdProperty "flash-kernel" [] `assume` MadeChange)
+		`requires` File.dirExists "/etc/flash-kernel"
+		`requires` Apt.installed ["flash-kernel"]
+
+-- | Runs flash-kernel in the system mounted at a particular directory.
+flashKernelMounted :: FilePath -> Property Linux
+flashKernelMounted mnt = combineProperties desc $ props
+	-- remove mounts that are done below to make sure the right thing
+	-- gets mounted
+	& cleanupmounts
+	& 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"]
+		`assume` MadeChange
+	& inchroot "flash-kernel" []
+		`assume` MadeChange
+	& cleanupmounts
+  where
+	desc = "flash-kernel run"
+
+	-- cannot use </> since the filepath is absolute
+	inmnt f = mnt ++ f
+
+	inchroot cmd ps = cmdProperty "chroot" ([mnt, cmd] ++ ps)
+
+	cleanupmounts :: Property Linux
+	cleanupmounts = property desc $ liftIO $ do
+		cleanup "/sys"
+		cleanup "/proc"
+		cleanup "/dev"
+		return NoChange
+	  where
+		cleanup m =
+			let mp = inmnt m
+			in whenM (isMounted mp) $
+				umountLazy mp
diff --git a/src/Propellor/Property/Machine.hs b/src/Propellor/Property/Machine.hs
new file mode 100644
index 00000000..b4ffc008
--- /dev/null
+++ b/src/Propellor/Property/Machine.hs
@@ -0,0 +1,164 @@
+-- | Machine-specific properties.
+--
+-- Many embedded computers have their own special configuration needed
+-- to use them. Rather than needing to hunt down documentation about the
+-- kernel, bootloader, etc for a given machine, if there's a property
+-- in here for your machine, you can simply use it.
+--
+-- Not all machine properties have been tested yet. If one flagged as
+-- untested and you find it works, please let us know.
+--
+-- You will need to configure the `Host` with the right `Architecture`
+-- for the machine. These properties do test at runtime that a supported
+-- Architecture was selected.
+--
+-- Sometimes non-free firmware is needed to use a board. If the board won't
+-- be functional at all without it, its property will include the non-free
+-- firmware, but if the non-free firmware is only needed for non-critical
+-- functionality, it won't be included.
+
+module Propellor.Property.Machine (
+	-- * ARM boards
+	Marvell_SheevaPlug_BootDevice(..),
+	marvell_SheevaPlug,
+	cubietech_Cubietruck,
+	olimex_A10_OLinuXino_LIME,
+	-- * ARM boards (untested)
+	cubietech_Cubieboard,
+	cubietech_Cubieboard2,
+	lemaker_Banana_Pi,
+	lemaker_Banana_Pro,
+	olimex_A10s_OLinuXino_Micro,
+	olimex_A20_OLinuXino_LIME,
+	olimex_A20_OLinuXino_LIME2,
+	olimex_A20_OLinuXino_Micro,
+	olimex_A20_SOM_EVB,
+	linkSprite_pcDuino3_Nano,
+) where
+
+import Propellor.Base
+import Propellor.Types.Core
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.FlashKernel as FlashKernel
+import qualified Propellor.Property.Uboot as Uboot
+
+data Marvell_SheevaPlug_BootDevice
+	= Marvell_SheevaPlug_SDCard
+	| Marvell_SheevaPlug_ESATA
+
+-- | Marvel SheevaPlug
+--
+-- Needs a small /boot partition formatted EXT2
+--
+-- Note that u-boot may need to be upgraded manually, and will need to be
+-- configured to boot from the SD card or eSATA. See
+-- https://www.cyrius.com/debian/kirkwood/sheevaplug/install/
+marvell_SheevaPlug :: Marvell_SheevaPlug_BootDevice -> Property (HasInfo + DebianLike)
+marvell_SheevaPlug Marvell_SheevaPlug_SDCard =
+	FlashKernel.installed "Marvell SheevaPlug Reference Board"
+		`requires` marvell
+marvell_SheevaPlug Marvell_SheevaPlug_ESATA =
+	FlashKernel.installed "Marvell eSATA SheevaPlug Reference Board"
+		`requires` marvell
+
+-- | Cubietech Cubietruck
+-- 
+-- Wifi needs non-free firmware-brcm80211, which is not installed by
+-- this property. Also, see https://bugs.debian.org/844056
+cubietech_Cubietruck :: Property (HasInfo + DebianLike)
+cubietech_Cubietruck = FlashKernel.installed "Cubietech Cubietruck"
+	`requires` sunixi "Cubietruck"
+	`requires` lpae
+
+-- | Cubietech Cubieboard (untested)
+cubietech_Cubieboard :: Property (HasInfo + DebianLike)
+cubietech_Cubieboard = FlashKernel.installed "Cubietech Cubieboard"
+	`requires` sunixi "Cubieboard"
+	`requires` armmp
+
+-- | Cubietech Cubieboard2 (untested)
+cubietech_Cubieboard2 :: Property (HasInfo + DebianLike)
+cubietech_Cubieboard2 = FlashKernel.installed "Cubietech Cubieboard2"
+	`requires` sunixi "Cubieboard2"
+	`requires` lpae
+
+-- | LeMaker Banana Pi
+lemaker_Banana_Pi :: Property (HasInfo + DebianLike)
+lemaker_Banana_Pi = FlashKernel.installed "LeMaker Banana Pi"
+	`requires` sunixi "Bananapi"
+	`requires` lpae
+
+-- | LeMaker Banana Pro (untested)
+lemaker_Banana_Pro :: Property (HasInfo + DebianLike)
+lemaker_Banana_Pro = FlashKernel.installed "LeMaker Banana Pro"
+	`requires` sunixi "Bananapro"
+	`requires` lpae
+
+-- | Olimex A10-OLinuXino-LIME
+olimex_A10_OLinuXino_LIME :: Property (HasInfo + DebianLike)
+olimex_A10_OLinuXino_LIME = FlashKernel.installed "Olimex A10-OLinuXino-LIME"
+	`requires` sunixi "A10-OLinuXino-Lime"
+	`requires` armmp
+
+-- | Olimex A10s-Olinuxino Micro (untested)
+olimex_A10s_OLinuXino_Micro :: Property (HasInfo + DebianLike)
+olimex_A10s_OLinuXino_Micro = FlashKernel.installed "Olimex A10s-Olinuxino Micro"
+	`requires` sunixi "A10s-OLinuXino-M"
+	`requires` armmp
+
+-- | Olimex A20-OlinuXino-LIME (untested)
+olimex_A20_OLinuXino_LIME :: Property (HasInfo + DebianLike)
+olimex_A20_OLinuXino_LIME = FlashKernel.installed "Olimex A20-OLinuXino-LIME"
+	`requires` sunixi "A20-OLinuXino-Lime"
+	`requires` lpae
+
+-- | Olimex A20-OlinuXino-LIME2 (untested)
+olimex_A20_OLinuXino_LIME2 :: Property (HasInfo + DebianLike)
+olimex_A20_OLinuXino_LIME2 = FlashKernel.installed "Olimex A20-OLinuXino-LIME2"
+	`requires` sunixi "A20-OLinuXino-Lime2"
+	`requires` lpae
+
+-- | Olimex A20-Olinuxino Micro (untested)
+olimex_A20_OLinuXino_Micro :: Property (HasInfo + DebianLike)
+olimex_A20_OLinuXino_Micro = FlashKernel.installed "Olimex A20-Olinuxino Micro"
+	`requires` sunixi "A20-OLinuXino-MICRO"
+	`requires` lpae
+
+-- | Olimex A20-SOM-EVB (untested)
+olimex_A20_SOM_EVB :: Property (HasInfo + DebianLike)
+olimex_A20_SOM_EVB = FlashKernel.installed "Olimex A20-Olimex-SOM-EVB"
+	`requires` sunixi "A20-Olimex-SOM-EVB"
+	`requires` lpae
+
+-- | LinkSprite pcDuino Nano (untested)
+--
+-- Needs non-free firmware, see
+-- https://wiki.debian.org/InstallingDebianOn/Allwinner
+linkSprite_pcDuino3_Nano :: Property (HasInfo + DebianLike)
+linkSprite_pcDuino3_Nano = FlashKernel.installed "LinkSprite pcDuino3 Nano"
+	`requires` sunixi "Linksprite_pcDuino3"
+	`requires` lpae
+
+sunixi :: Uboot.BoardName -> Property (HasInfo + DebianLike)
+sunixi boardname = Uboot.sunxi boardname
+	`requires` Apt.installed
+		[ "firmware-linux-free"
+		, "sunxi-tools"
+		]
+
+armmp :: Property DebianLike
+armmp = checkArchitecture [ARMHF, ARMEL] $
+	Apt.installed ["linux-image-armmp"]
+
+lpae :: Property DebianLike
+lpae = checkArchitecture [ARMHF, ARMEL] $ 
+	Apt.installed ["linux-image-armmp-lpae"]
+
+marvell :: Property DebianLike
+marvell = checkArchitecture [ARMEL] $
+	Apt.installed ["linux-image-marvell"]
+
+checkArchitecture :: [Architecture] -> Property DebianLike -> Property DebianLike
+checkArchitecture as p = withOS (getDesc p) $ \w o -> case o of
+	(Just (System _ arch)) | arch `elem` as -> ensureProperty w p
+	_ -> error $ "Machine needs architecture to be one of: " ++ show as
diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs
index 2c4d9620..c047161d 100644
--- a/src/Propellor/Property/Mount.hs
+++ b/src/Propellor/Property/Mount.hs
@@ -90,18 +90,18 @@ mountPointsBelow target = filter (\p -> simplifyPath p /= simplifyPath target)
 
 -- | Filesystem type mounted at a given location.
 getFsType :: MountPoint -> IO (Maybe FsType)
-getFsType = findmntField "fstype"
+getFsType p = findmntField "fstype" [p]
 
 -- | Mount options for the filesystem mounted at a given location.
 getFsMountOpts :: MountPoint -> IO MountOpts
 getFsMountOpts p = maybe mempty toMountOpts
-	<$> findmntField "fs-options" p
+	<$> findmntField "fs-options" [p]
 
 type UUID = String
 
 -- | UUID of filesystem mounted at a given location.
 getMountUUID :: MountPoint -> IO (Maybe UUID)
-getMountUUID = findmntField "uuid"
+getMountUUID p = findmntField "uuid" [p]
 
 -- | UUID of a device
 getSourceUUID :: Source -> IO (Maybe UUID)
@@ -111,7 +111,7 @@ type Label = String
 
 -- | Label of filesystem mounted at a given location.
 getMountLabel :: MountPoint -> IO (Maybe Label)
-getMountLabel = findmntField "label"
+getMountLabel p = findmntField "label" [p]
 
 -- | Label of a device
 getSourceLabel :: Source -> IO (Maybe UUID)
@@ -119,12 +119,16 @@ getSourceLabel = blkidTag "LABEL"
 
 -- | Device mounted at a given location.
 getMountSource :: MountPoint -> IO (Maybe Source)
-getMountSource = findmntField "source"
+getMountSource p = findmntField "source" [p]
 
-findmntField :: String -> FilePath -> IO (Maybe String)
-findmntField field mnt = catchDefaultIO Nothing $
+-- | Device that a given path is located within.
+getMountContaining :: FilePath -> IO (Maybe Source)
+getMountContaining p = findmntField "source" ["-T", p]
+
+findmntField :: String -> [String] -> IO (Maybe String)
+findmntField field ps = catchDefaultIO Nothing $
 	headMaybe . filter (not . null) . lines
-		<$> readProcess "findmnt" ["-n", mnt, "--output", field]
+		<$> readProcess "findmnt" ("-n" : ps ++ ["--output", field])
 
 blkidTag :: String -> Source -> IO (Maybe String)
 blkidTag tag dev = catchDefaultIO Nothing $
diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs
index 43744142..d60d4a60 100644
--- a/src/Propellor/Property/Parted.hs
+++ b/src/Propellor/Property/Parted.hs
@@ -21,13 +21,14 @@ module Propellor.Property.Parted (
 	parted,
 	Eep(..),
 	installed,
-	-- * PartSpec combinators
+	-- * Partition table sizing
 	calcPartTable,
 	DiskSize(..),
 	DiskPart,
-	module Propellor.Types.PartSpec,
 	DiskSpaceUse(..),
 	useDiskSpace,
+	defSz,
+	fudgeSz,
 ) where
 
 import Propellor.Base
@@ -35,7 +36,7 @@ import Propellor.Property.Parted.Types
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Pacman as Pacman
 import qualified Propellor.Property.Partition as Partition
-import Propellor.Types.PartSpec
+import Propellor.Types.PartSpec (PartSpec)
 import Utility.DataUnits
 
 import System.Posix.Files
@@ -160,3 +161,19 @@ instance Monoid DiskPart
 -- (less all fixed size partitions), or the remaining space in the disk.
 useDiskSpace :: PartSpec DiskPart -> DiskSpaceUse -> PartSpec DiskPart
 useDiskSpace (mp, o, p, _) diskuse = (mp, o, p, DynamicDiskPart diskuse)
+
+-- | Default partition size when not otherwize specified is 128 MegaBytes.
+defSz :: PartSize
+defSz = MegaBytes 128
+
+-- | When a partition is sized to fit the files that live in it,
+-- this fudge factor is added to the size of the files. This is necessary
+-- since filesystems have some space overhead.
+-- 
+-- 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.
+fudgeSz :: PartSize -> PartSize
+fudgeSz (MegaBytes n) = MegaBytes (n + n `div` 100 * 2 + 3 + 200)
diff --git a/src/Propellor/Property/Qemu.hs b/src/Propellor/Property/Qemu.hs
new file mode 100644
index 00000000..f204a0e1
--- /dev/null
+++ b/src/Propellor/Property/Qemu.hs
@@ -0,0 +1,49 @@
+module Propellor.Property.Qemu where
+
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+
+-- | Installs qemu user mode emulation binaries, built statically,
+-- which allow foreign binaries to run directly.
+foreignBinariesEmulated :: RevertableProperty Linux Linux
+foreignBinariesEmulated = (setup <!> cleanup)
+	`describe` "foreign binary emulation"
+  where
+	setup = Apt.installed p `pickOS` unsupportedOS
+	cleanup = Apt.removed p `pickOS` unsupportedOS
+	p = ["qemu-user-static"]
+
+-- | Removes qemu user mode emulation binary for the host CPU.
+-- This binary is copied into a chroot by qemu-debootstrap, and is not
+-- part of any package.
+--
+-- Note that removing the binary will prevent using the chroot on the host
+-- system.
+--
+-- The FilePath is the path to the top of the chroot.
+removeHostEmulationBinary :: FilePath -> Property Linux
+removeHostEmulationBinary top = tightenTargets $ 
+	scriptProperty ["rm -f " ++ top ++ "/usr/bin/qemu-*-static"]
+		`assume` MadeChange
+
+-- | Check if the given System supports an Architecture.
+--
+-- For example, on Debian, X86_64 supports X86_32, and vice-versa.
+supportsArch :: System -> Architecture -> Bool
+supportsArch (System os a) b
+	| a == b = True
+	| otherwise = case os of
+		Debian _ _ -> debianlike
+		Buntish _ -> debianlike
+		-- don't know about other OS's
+		_ -> False
+  where
+	debianlike =
+		let l = 
+			[ (X86_64, X86_32)
+			, (ARMHF, ARMEL)
+			, (PPC, PPC64)
+			, (SPARC, SPARC64)
+			, (S390, S390X)
+			]
+		in elem (a, b) l || elem (b, a) l
diff --git a/src/Propellor/Property/Service.hs b/src/Propellor/Property/Service.hs
index 46f9e8ef..1c230ce0 100644
--- a/src/Propellor/Property/Service.hs
+++ b/src/Propellor/Property/Service.hs
@@ -1,6 +1,11 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
 module Propellor.Property.Service where
 
 import Propellor.Base
+import Propellor.Types.Info
+import qualified Propellor.Property.File as File
+import Utility.FileMode
 
 type ServiceName = String
 
@@ -21,7 +26,34 @@ reloaded :: ServiceName -> Property DebianLike
 reloaded = signaled "reload" "reloaded"
 
 signaled :: String -> Desc -> ServiceName -> Property DebianLike
-signaled cmd desc svc = tightenTargets $ p `describe` (desc ++ " " ++ svc)
+signaled cmd desc svc = check (not <$> servicesDisabled) $
+	tightenTargets $ p `describe` (desc ++ " " ++ svc)
   where
 	p = scriptProperty ["service " ++ shellEscape svc ++ " " ++ cmd ++ " >/dev/null 2>&1 || true"]
 		`assume` NoChange
+
+-- | This property prevents daemons and other services from being started,
+-- which is often something you want to prevent when building a chroot.
+--
+-- When this is set, `running` and `restarted` will not start services.
+--
+-- On Debian this installs a </usr/sbin/policy-rc.d> script to further
+-- prevent any packages that get installed from starting daemons.
+-- Reverting the property removes the script.
+noServices :: RevertableProperty (HasInfo + UnixLike) UnixLike
+noServices = (setup `setInfoProperty` toInfo (InfoVal NoServices)) <!> teardown
+  where
+	f = "/usr/sbin/policy-rc.d"
+	script = [ "#!/bin/sh", "exit 101" ]
+	setup = combineProperties "no services started" $ toProps
+		[ File.hasContent f script
+		, File.mode f (combineModes (readModes ++ executeModes))
+		]
+	teardown = File.notPresent f
+
+-- | Check if the noServices property is in effect.
+servicesDisabled :: Propellor Bool
+servicesDisabled = isJust . fromInfoVal
+	<$> (askInfo :: Propellor (InfoVal NoServices))
+
+data NoServices = NoServices deriving (Eq, Show, Typeable)
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index bd4d0928..dd1085d7 100644
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -119,10 +119,10 @@ standardAutoBuilder :: DebianSuite -> Architecture -> Flavor -> Property (HasInf
 standardAutoBuilder suite arch flavor =
 	propertyList "standard git-annex autobuilder" $ props
 		& osDebian suite arch
-		& buildDepsApt
 		& Apt.stdSourcesList
 		& Apt.unattendedUpgrades
 		& Apt.cacheCleaned
+		& buildDepsApt
 		& User.accountFor (User builduser)
 		& tree (architectureToDebianArchString arch) flavor
 
diff --git a/src/Propellor/Property/SiteSpecific/GitHome.hs b/src/Propellor/Property/SiteSpecific/GitHome.hs
index f14b5f12..2a66d1e2 100644
--- a/src/Propellor/Property/SiteSpecific/GitHome.hs
+++ b/src/Propellor/Property/SiteSpecific/GitHome.hs
@@ -20,7 +20,14 @@ installedFor user@(User u) = check (not <$> hasGitDir user) $
 				moveout tmpdir home
 			, property "rmdir" $ makeChange $ void $
 				catchMaybeIO $ removeDirectory tmpdir
-			, userScriptProperty user ["rm -rf .aptitude/ .bashrc .profile; bin/mr checkout; bin/fixups"]
+			, userScriptProperty user ["rm -rf .aptitude/ .bashrc .profile"]
+				`assume` MadeChange
+			-- Set HOSTNAME so that this sees the right
+			-- hostname when run in a chroot with a different
+			-- hostname than the current one.
+			, userScriptProperty user ["HOSTNAME=$(cat /etc/hostname) bin/mr checkout"]
+				`assume` MadeChange
+			, userScriptProperty user ["bin/fixups"]
 				`assume` MadeChange
 			]
 	moveout tmpdir home = do
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 7812c855..097171a3 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -912,16 +912,20 @@ alarmClock oncalendar (User user) command = combineProperties "goodmorning timer
 homePowerMonitor :: IsContext c => User -> c -> (SshKeyType, Ssh.PubKeyText) -> Property (HasInfo + DebianLike)
 homePowerMonitor user ctx sshkey = propertyList "home power monitor" $ props
 	& Apache.installed
-	& Apt.installed ["python", "python-pymodbus"]
+	& Apt.installed ["python", "python-pymodbus", "rrdtool"]
 	& File.ownerGroup "/var/www/html" user (userGroup user)
 	& Git.cloned user "git://git.kitenet.net/joey/homepower" d Nothing
-		`onChange` buildpoller
+	& buildpoller
 	& Systemd.enabled servicename
 		`requires` serviceinstalled
 		`onChange` Systemd.started servicename
+	& User.hasGroup user (Group "dialout")
 	& Cron.niceJob "homepower upload"
 		(Cron.Times "1 * * * *") user d rsynccommand
 		`requires` Ssh.userKeyAt (Just sshkeyfile) user ctx sshkey
+		`requires` File.ownerGroup (takeDirectory sshkeyfile)
+			user (userGroup user)
+		`requires` File.dirExists (takeDirectory sshkeyfile)
   where
 	d = "/var/www/html/homepower"
 	sshkeyfile = d </> ".ssh/key"
@@ -957,30 +961,34 @@ homeRouter :: Property (HasInfo + DebianLike)
 homeRouter = propertyList "home router" $ props
 	& Network.static "wlan0" (IPv4 "10.1.1.1") Nothing
 		`requires` Network.cleanInterfacesFile
-	& Apt.serviceInstalledRunning "hostapd"
-		`requires` File.hasContent "/etc/hostapd/hostapd.conf"
+	& Apt.installed ["hostapd"]
+	& File.hasContent "/etc/hostapd/hostapd.conf"
 			[ "interface=wlan0"
 			, "ssid=house"
 			, "hw_mode=g"
 			, "channel=8"
 			]
-		`requires` File.dirExists "/lib/hostapd"
-	& Apt.serviceInstalledRunning "dnsmasq"
-		`requires` File.hasContent "/etc/dnsmasq.conf"
-			[ "domain-needed"
-			, "bogus-priv"
-			, "interface=wlan0"
-			, "domain=kitenet.net"
-			, "dhcp-range=10.1.1.100,10.1.1.150,24h"
-			, "no-hosts"
-			, "address=/honeybee.kitenet.net/10.1.1.1"
-			]
-		`requires` File.hasContent "/etc/resolv.conf"
-			[ "domain kitenet.net"
-			, "search kitenet.net"
-			, "nameserver 8.8.8.8"
-			, "nameserver 8.8.4.4"
-			]
+		`requires` File.dirExists "/etc/hostapd"
+		`requires` File.hasContent "/etc/default/hostapd"
+			[ "DAEMON_CONF=/etc/hostapd/hostapd.conf" ]
+		`onChange` Service.running "hostapd"
+	& File.hasContent "/etc/resolv.conf"
+		[ "domain kitenet.net"
+		, "search kitenet.net"
+		, "nameserver 8.8.8.8"
+		, "nameserver 8.8.4.4"
+		]
+	& Apt.installed ["dnsmasq"]
+	& File.hasContent "/etc/dnsmasq.conf"
+		[ "domain-needed"
+		, "bogus-priv"
+		, "interface=wlan0"
+		, "domain=kitenet.net"
+		, "dhcp-range=10.1.1.100,10.1.1.150,24h"
+		, "no-hosts"
+		, "address=/honeybee.kitenet.net/10.1.1.1"
+		]
+		`onChange` Service.restarted "dnsmasq"
 	& ipmasq "wlan0"
 	& Apt.serviceInstalledRunning "netplug"
 	& Network.dhcp' "eth0"
diff --git a/src/Propellor/Property/Uboot.hs b/src/Propellor/Property/Uboot.hs
new file mode 100644
index 00000000..562d2441
--- /dev/null
+++ b/src/Propellor/Property/Uboot.hs
@@ -0,0 +1,36 @@
+module Propellor.Property.Uboot where
+
+import Propellor.Base
+import Propellor.Types.Info
+import Propellor.Types.Bootloader
+import Propellor.Property.Chroot
+import Propellor.Property.Mount
+import qualified Propellor.Property.Apt as Apt
+
+-- | Name of a board.
+type BoardName = String
+
+-- | Installs u-boot for Allwinner/sunxi platforms.
+--
+-- This includes writing it to the boot sector.
+sunxi :: BoardName -> Property (HasInfo + DebianLike)
+sunxi boardname = setInfoProperty (check (not <$> inChroot) go) info
+	`requires` Apt.installed ["u-boot", "u-boot-sunxi"]
+  where
+	go :: Property Linux
+	go = property' "u-boot installed" $ \w -> do
+		v <- liftIO $ getMountContaining "/boot"
+		case v of
+			Nothing -> error "unable to determine boot device"
+			Just dev -> ensureProperty w (dd dev "/")
+	dd :: FilePath -> FilePath -> Property Linux
+	dd dev prefix = tightenTargets $ cmdProperty "dd"
+		[ "conv=fsync,notrunc"
+		, "if=" ++ prefix ++ "/usr/lib/u-boot/"
+			++ boardname ++ "/u-boot-sunxi-with-spl.bin"
+		, "of=" ++ dev
+		, "bs=1024"
+		, "seek=8"
+		]
+		`assume` NoChange
+	info = toInfo [UbootInstalled dd]
diff --git a/src/Propellor/Types/Bootloader.hs b/src/Propellor/Types/Bootloader.hs
index 4a75503a..fd929d7e 100644
--- a/src/Propellor/Types/Bootloader.hs
+++ b/src/Propellor/Types/Bootloader.hs
@@ -2,11 +2,20 @@
 
 module Propellor.Types.Bootloader where
 
+import Propellor.Types
 import Propellor.Types.Info
 
 -- | Boot loader installed on a host.
-data BootloaderInstalled = GrubInstalled
-	deriving (Typeable, Show)
+data BootloaderInstalled
+	= GrubInstalled
+	| FlashKernelInstalled
+	| UbootInstalled (FilePath -> FilePath -> Property Linux)
+	deriving (Typeable)
+
+instance Show BootloaderInstalled where
+	show GrubInstalled = "GrubInstalled"
+	show FlashKernelInstalled = "FlashKernelInstalled"
+	show (UbootInstalled _) = "UbootInstalled"
 
 instance IsInfo [BootloaderInstalled] where
 	propagateInfo _ = PropagateInfo False
diff --git a/src/Propellor/Types/PartSpec.hs b/src/Propellor/Types/PartSpec.hs
index 2b0a8787..860b38f6 100644
--- a/src/Propellor/Types/PartSpec.hs
+++ b/src/Propellor/Types/PartSpec.hs
@@ -1,66 +1,8 @@
--- | Partition specification combinators.
-
 module Propellor.Types.PartSpec where
 
-import Propellor.Base
 import Propellor.Property.Parted.Types
 import Propellor.Property.Mount
-import Propellor.Property.Partition
 
 -- | Specifies a mount point, mount options, and a constructor for a
 -- Partition that determines its size.
 type PartSpec t = (Maybe MountPoint, MountOpts, PartSize -> Partition, t)
-
--- | Specifies a partition with a given filesystem.
---
--- The partition is not mounted anywhere by default; use the combinators
--- below to configure it.
-partition :: Monoid t => Fs -> PartSpec t
-partition fs = (Nothing, mempty, mkPartition fs, mempty)
-
--- | Specifies a swap partition of a given size.
-swapPartition :: Monoid t => PartSize -> PartSpec t
-swapPartition sz = (Nothing, mempty, const (mkPartition LinuxSwap sz), mempty)
-
--- | Specifies where to mount a partition.
-mountedAt :: PartSpec t -> FilePath -> PartSpec t
-mountedAt (_, o, p, t) mp = (Just mp, o, p, t)
-
--- | Specify a fixed size for a partition.
-setSize :: PartSpec t -> PartSize -> PartSpec t
-setSize (mp, o, p, t) sz = (mp, o, const (p sz), t)
-
--- | Specifies a mount option, such as "noexec"
-mountOpt :: ToMountOpts o => PartSpec t -> o -> PartSpec t
-mountOpt (mp, o, p, t) o' = (mp, o <> toMountOpts o', p, t)
-
--- | Mount option to make a partition be remounted readonly when there's an
--- error accessing it.
-errorReadonly :: MountOpts
-errorReadonly = toMountOpts "errors=remount-ro"
-
--- | Sets the percent of the filesystem blocks reserved for the super-user.
---
--- The default is 5% for ext2 and ext4. Some filesystems may not support
--- this.
-reservedSpacePercentage :: PartSpec t -> Int -> PartSpec t
-reservedSpacePercentage s percent = adjustp s $ \p -> 
-	p { partMkFsOpts = ("-m"):show percent:partMkFsOpts p }
-
--- | Sets a flag on the partition.
-setFlag :: PartSpec t -> PartFlag -> PartSpec t
-setFlag s f = adjustp s $ \p -> p { partFlags = (f, True):partFlags p }
-
--- | Makes a MSDOS partition be Extended, rather than Primary.
-extended :: PartSpec t -> PartSpec t
-extended s = adjustp s $ \p -> p { partType = Extended }
-
-adjustp :: PartSpec t -> (Partition -> Partition) -> PartSpec t
-adjustp (mp, o, p, t) f = (mp, o, f . p, t)
-
-adjustt :: PartSpec t -> (t -> t) -> PartSpec t
-adjustt (mp, o, p, t) f = (mp, o, p, f t)
-
--- | Default partition size when not otherwize specified is 128 MegaBytes.
-defSz :: PartSize
-defSz = MegaBytes 128