propellor 5.1.0 → 5.2.0

raw patch · 18 files changed

+838/−110 lines, 18 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG +28/−0
• debian/changelog +28/−0
• joeyconfig.hs +8/−14
• propellor.cabal +4/−1
• src/Propellor/Property/Bootstrap.hs +13/−1
• src/Propellor/Property/DiskImage.hs +33/−19
• src/Propellor/Property/DiskImage/PartSpec.hs +3/−3
• src/Propellor/Property/Grub.hs +42/−20
• src/Propellor/Property/Installer.hs +20/−0
• src/Propellor/Property/Installer/Target.hs +462/−0
• src/Propellor/Property/Installer/Types.hs +16/−0
• src/Propellor/Property/Mount.hs +3/−1
• src/Propellor/Property/Parted.hs +67/−26
• src/Propellor/Property/Parted/Types.hs +41/−20
• src/Propellor/Property/Sbuild.hs +15/−0
• src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +2/−0
• src/Propellor/Property/SiteSpecific/JoeySites.hs +48/−3
• src/Propellor/Types/Bootloader.hs +5/−2

@@ -1,3 +1,31 @@+propellor (5.2.0) unstable; urgency=medium++  [ Joey Hess ]+  * bootstrappedFrom: Set up local privdata file.+  * Parted: Fix names used for FAT and VFAT partitions.+  * Parted: Add an Alignment parameter. (API change)+    A good default to use is safeAlignment, which is 4MiB,+    well suited for inexpensive flash drives, and fine for other disks too.+    Previously, a very non-optimial 1MB (not 1MiB) alignment had been used.+  * DiskImage: Use safeAlignment. It didn't seem worth making the+    alignment configurable here.+  * Fixed rounding bug in Parted.calcPartTable.+  * DiskImage: Fix rsync crash when a mount point does not exist in the+    chroot.+  * Fix bug in unmountBelow that caused unmounting of nested mounts to+    fail.+  * Grub.boots, Grub.bootsMounted: Pass --target to grub-install.+  * Added Propellor.Property.Installer modules, which can be used to create+    bootable installer disk images, which then run propellor to install+    a system. This code was extracted from the demo I gave in my+    talk at DebConf 2017.++  [ Sean Whitton ]+  * Sbuild: add notes about Debian jessie hosts and backports of sbuild and+    autopkgtest.++ -- Joey Hess <id@joeyh.name>  Sat, 30 Dec 2017 13:34:29 -0400+ propellor (5.1.0) unstable; urgency=medium    [ Sean Whitton ]

@@ -1,3 +1,31 @@+propellor (5.2.0) unstable; urgency=medium++  [ Joey Hess ]+  * bootstrappedFrom: Set up local privdata file.+  * Parted: Fix names used for FAT and VFAT partitions.+  * Parted: Add an Alignment parameter. (API change)+    A good default to use is safeAlignment, which is 4MiB,+    well suited for inexpensive flash drives, and fine for other disks too.+    Previously, a very non-optimial 1MB (not 1MiB) alignment had been used.+  * DiskImage: Use safeAlignment. It didn't seem worth making the+    alignment configurable here.+  * Fixed rounding bug in Parted.calcPartTable.+  * DiskImage: Fix rsync crash when a mount point does not exist in the+    chroot.+  * Fix bug in unmountBelow that caused unmounting of nested mounts to+    fail.+  * Grub.boots, Grub.bootsMounted: Pass --target to grub-install.+  * Added Propellor.Property.Installer modules, which can be used to create+    bootable installer disk images, which then run propellor to install+    a system. This code was extracted from the demo I gave in my+    talk at DebConf 2017.++  [ Sean Whitton ]+  * Sbuild: add notes about Debian jessie hosts and backports of sbuild and+    autopkgtest.++ -- Joey Hess <id@joeyh.name>  Sat, 30 Dec 2017 13:34:29 -0400+ propellor (5.1.0) unstable; urgency=medium    [ Sean Whitton ]

@@ -32,7 +32,6 @@ import qualified Propellor.Property.Systemd as Systemd import qualified Propellor.Property.Journald as Journald import qualified Propellor.Property.Fail2Ban as Fail2Ban-import qualified Propellor.Property.Aiccu as Aiccu import qualified Propellor.Property.OS as OS import qualified Propellor.Property.HostingProvider.CloudAtCost as CloudAtCost import qualified Propellor.Property.HostingProvider.Linode as Linode@@ -86,20 +85,20 @@ darkstar = host "darkstar.kitenet.net" $ props 	& osDebian Unstable X86_64 	& ipv6 "2001:4830:1600:187::2"-	& Aiccu.hasConfig "T18376" "JHZ2-SIXXS"--	& User.nuked (User "nosuchuser") User.YesReallyDeleteHome+	& Hostname.sane+	& Apt.serviceInstalledRunning "swapspace"  	& JoeySites.dkimMilter 	& JoeySites.postfixSaslPasswordClient 	-- & JoeySites.alarmClock "*-*-* 7:30" (User "joey") 	--	"/usr/bin/timeout 45m /home/joey/bin/goodmorning"+	& JoeySites.laptopSoftware 	& Ssh.userKeys (User "joey") hostContext 		[ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC1YoyHxZwG5Eg0yiMTJLSWJ/+dMM6zZkZiR4JJ0iUfP+tT2bm/lxYompbSqBeiCq+PYcSC67mALxp1vfmdOV//LWlbXfotpxtyxbdTcQbHhdz4num9rJQz1tjsOsxTEheX5jKirFNC5OiKhqwIuNydKWDS9qHGqsKcZQ8p+n1g9Lr3nJVGY7eRRXzw/HopTpwmGmAmb9IXY6DC2k91KReRZAlOrk0287LaK3eCe1z0bu7LYzqqS+w99iXZ/Qs0m9OqAPnHZjWQQ0fN4xn5JQpZSJ7sqO38TBAimM+IHPmy2FTNVVn9zGM+vN1O2xr3l796QmaUG1+XLL0shfR/OZbb joey@darkstar") 		]-	& imageBuiltFor honeybee-		(RawDiskImage "/srv/honeybee.img")-		(Debootstrapped mempty)+	-- & imageBuiltFor honeybee+	--	(RawDiskImage "/srv/honeybee.img")+	--	(Debootstrapped mempty)  gnu :: Host gnu = host "gnu.kitenet.net" $ props@@ -183,15 +182,9 @@ 	 	& cubietech_Cubietruck 	& hasPartition-		( partition EXT2-			`mountedAt` "/boot"-			`partLocation` Beginning-			`setSize` MegaBytes 200-		)-	& hasPartition 		( partition EXT4 			`mountedAt` "/"-			`addFreeSpace` MegaBytes 500+			`setSize` MegaBytes 8000 		) 	 	& Apt.installed ["firmware-brcm80211"]@@ -207,6 +200,7 @@  	& JoeySites.homePowerMonitor 		(User "joey")+		hosts 		(Context "homepower.joeyh.name") 		(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIMAmVYddg/RgCbIj+cLcEiddeFXaYFnbEJ3uGj9G/EyV joey@honeybee") 	& JoeySites.homeRouter

@@ -1,5 +1,5 @@ Name: propellor-Version: 5.1.0+Version: 5.2.0 Cabal-Version: >= 1.20 License: BSD2 Maintainer: Joey Hess <id@joeyh.name>@@ -121,6 +121,9 @@     Propellor.Property.Gpg     Propellor.Property.Group     Propellor.Property.Grub+    Propellor.Property.Installer+    Propellor.Property.Installer.Types+    Propellor.Property.Installer.Target     Propellor.Property.Journald     Propellor.Property.Kerberos     Propellor.Property.LetsEncrypt

@@ -14,6 +14,8 @@ import Propellor.Bootstrap import Propellor.Types.Info import Propellor.Property.Chroot+import Propellor.PrivData.Paths+import Utility.FileMode  import Data.List import qualified Data.ByteString as B@@ -63,8 +65,18 @@ 	go :: Property Linux 	go = property "Propellor bootstrapped" $ do 		system <- getOS+		-- gets Host value representing the chroot this is run in+		chroothost <- ask+		-- load privdata from outside the chroot, and filter+		-- to only the privdata needed inside the chroot.+		privdata <- liftIO $ filterPrivData chroothost+			<$> readPrivDataFile privDataLocal 		bootstrapper <- getBootstrapper-		assumeChange $ exposeTrueLocaldir $ const $ +		assumeChange $ exposeTrueLocaldir $ const $ do+			liftIO $ createDirectoryIfMissing True $+				takeDirectory privDataLocal+			liftIO $ writeFileProtected privDataLocal $+				show privdata 			runShellCommand $ buildShellCommand 				[ "cd " ++ localdir 				, checkDepsCommand bootstrapper system

@@ -17,7 +17,7 @@ 	imageRebuiltFor, 	imageBuiltFrom, 	imageExists,-	Grub.BIOS(..),+	GrubTarget(..), ) where  import Propellor.Base@@ -41,6 +41,7 @@ import Propellor.Container import Utility.Path import Utility.FileMode+import Utility.DataUnits  import Data.List (isPrefixOf, isInfixOf, sortBy, unzip4) import Data.Function (on)@@ -220,7 +221,7 @@ 	-- installed. 	final = case fromInfo (containerInfo chroot) of 		[] -> unbootable "no bootloader is installed"-		[GrubInstalled] -> grubFinalized+		[GrubInstalled grubtarget] -> grubFinalized grubtarget 		[UbootInstalled p] -> ubootFinalized p 		[FlashKernelInstalled] -> flashKernelFinalized 		[UbootInstalled p, FlashKernelInstalled] -> @@ -265,7 +266,7 @@ 		imageFinalized final dest mnts mntopts devs parttable 	rmimg = undoRevertableProperty (buildDiskImage img) 		`before` undoRevertableProperty (imageExists' dest dummyparttable)-	dummyparttable = PartTable tabletype []+	dummyparttable = PartTable tabletype safeAlignment []  partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property DebianLike partitionsPopulated chrootdir mnts mntopts devs = property' desc $ \w ->@@ -274,13 +275,18 @@ 	desc = "partitions populated from " ++ chrootdir  	go _ Nothing _ _ = noChange-	go w (Just mnt) mntopt loopdev = withTmpDir "mnt" $ \tmpdir -> bracket-		(liftIO $ mount "auto" (partitionLoopDev loopdev) tmpdir mntopt)-		(const $ liftIO $ umountLazy tmpdir)-		$ \ismounted -> if ismounted-			then ensureProperty w $-				syncDirFiltered (filtersfor mnt) (chrootdir ++ mnt) tmpdir-			else return FailedChange+	go w (Just mnt) mntopt loopdev = ifM (liftIO $ doesDirectoryExist srcdir) $+		( withTmpDir "mnt" $ \tmpdir -> bracket+			(liftIO $ mount "auto" (partitionLoopDev loopdev) tmpdir mntopt)+			(const $ liftIO $ umountLazy tmpdir)+			$ \ismounted -> if ismounted+				then ensureProperty w $+					syncDirFiltered (filtersfor mnt) srcdir tmpdir+				else return FailedChange+		, return NoChange+		)+	  where+		srcdir = chrootdir ++ mnt  	filtersfor mnt = 		let childmnts = map (drop (length (dropTrailingPathSeparator mnt))) $@@ -300,7 +306,7 @@ fitChrootSize tt l basesizes = (mounts, mountopts, parttable)   where 	(mounts, mountopts, sizers, _) = unzip4 l-	parttable = PartTable tt (zipWith id sizers basesizes)+	parttable = PartTable tt safeAlignment (zipWith id sizers basesizes)  -- | Generates a map of the sizes of the contents of -- every directory in a filesystem tree.@@ -339,17 +345,24 @@ imageExists :: RawDiskImage -> ByteSize -> Property Linux imageExists (RawDiskImage img) isz = property ("disk image exists" ++ img) $ liftIO $ do 	ms <- catchMaybeIO $ getFileStatus img-	case ms of+	case fmap (toInteger . fileSize) ms of 		Just s-			| toInteger (fileSize s) == toInteger sz -> return NoChange-			| toInteger (fileSize s) > toInteger sz -> do+			| s == toInteger sz -> return NoChange+			| s > toInteger sz -> do+				infoMessage ["truncating " ++ img ++ " to " ++ humansz] 				setFileSize img (fromInteger sz) 				return MadeChange-		_ -> do+			| otherwise -> do+				infoMessage ["expanding " ++ img ++ " from " ++ roughSize storageUnits False s ++ " to " ++ humansz]+				L.writeFile img (L.replicate (fromIntegral sz) 0)+				return MadeChange+		Nothing -> do+			infoMessage ["creating " ++ img ++ " of size " ++ humansz] 			L.writeFile img (L.replicate (fromIntegral sz) 0) 			return MadeChange   where 	sz = ceiling (fromInteger isz / sectorsize) * ceiling sectorsize+	humansz = roughSize storageUnits False (toInteger sz) 	-- Disks have a sector size, and making a disk image not 	-- aligned to a sector size will confuse some programs. 	-- Common sector sizes are 512 and 4096; use 4096 as it's larger.@@ -388,7 +401,7 @@ type Finalization = (RawDiskImage -> FilePath -> [LoopDev] -> Property Linux)  imageFinalized :: Finalization -> RawDiskImage -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> PartTable -> Property Linux-imageFinalized final img mnts mntopts devs (PartTable _ parts) =+imageFinalized final img mnts mntopts devs (PartTable _ _ parts) = 	property' "disk image finalized" $ \w -> 		withTmpDir "mnt" $ \top -> 			go w top `finally` liftIO (unmountall top)@@ -441,9 +454,10 @@   where 	desc = "image is not bootable" -grubFinalized :: Finalization-grubFinalized _img mnt loopdevs = Grub.bootsMounted mnt wholediskloopdev-	`describe` "disk image boots using grub"+grubFinalized :: GrubTarget -> Finalization+grubFinalized grubtarget _img mnt loopdevs = +	Grub.bootsMounted mnt wholediskloopdev grubtarget+		`describe` "disk image boots using grub"   where 	-- It doesn't matter which loopdev we use; all 	-- come from the same disk image, and it's the loop dev

@@ -160,8 +160,8 @@ 	(PartInfo [PartSpecInfo p])   where 	desc = case mmp of-		Just mp -> "has " ++ mp ++ " partition"-		Nothing -> "has unmounted partition"+		Just mp -> mp ++ " partition"+		Nothing -> "unmounted partition"  -- | Adjusts the PartSpec for the partition mounted at the specified location. --@@ -170,7 +170,7 @@ -- > 	& adjustPartition "/boot" (`addFreeSpace` MegaBytes 150) adjustPartition :: MountPoint -> (PartSpec PartLocation -> PartSpec PartLocation) -> Property (HasInfo + UnixLike) adjustPartition mp f = pureInfoProperty-	("has " ++ mp ++ " adjusted")+	(mp ++ " adjusted") 	(PartInfo [AdjustPartSpecInfo mp f])  -- | Indicates partition layout in a disk. Default is somewhere in the

@@ -1,4 +1,15 @@-module Propellor.Property.Grub where+module Propellor.Property.Grub (+	GrubDevice,+	OSDevice,+	GrubTarget(..),+	installed,+	mkConfig,+	installed',+	boots,+	bootsMounted,+	TimeoutSecs,+	chainPVGrub+) where  import Propellor.Base import qualified Propellor.Property.File as File@@ -14,40 +25,36 @@ -- | Eg, \"\/dev/sda\" type OSDevice = String -type TimeoutSecs = Int---- | Types of machines that grub can boot.-data BIOS = PC | EFI64 | EFI32 | Coreboot | Xen- -- | Installs the grub package. This does not make grub be used as the -- bootloader. -- -- This includes running update-grub, unless it's run in a chroot.-installed :: BIOS -> Property (HasInfo + DebianLike)-installed bios = installed' bios +installed :: GrubTarget -> Property (HasInfo + DebianLike)+installed grubtarget = installed' grubtarget  	`onChange` (check (not <$> inChroot) mkConfig) --- Run update-grub, to generate the grub boot menu. It will be+-- | Run update-grub, to generate the grub boot menu. It will be -- automatically updated when kernel packages are installed. mkConfig :: Property DebianLike mkConfig = tightenTargets $ cmdProperty "update-grub" [] 	`assume` MadeChange  -- | Installs grub; does not run update-grub.-installed' :: BIOS -> Property (HasInfo + DebianLike)-installed' bios = setInfoProperty aptinstall-	(toInfo [GrubInstalled])+installed' :: GrubTarget -> Property (HasInfo + DebianLike)+installed' grubtarget = setInfoProperty aptinstall+	(toInfo [GrubInstalled grubtarget]) 	`describe` "grub package installed"   where 	aptinstall = Apt.installed [debpkg]-	debpkg = case bios of+	debpkg = case grubtarget of 		PC -> "grub-pc" 		EFI64 -> "grub-efi-amd64" 		EFI32 -> "grub-efi-ia32" 		Coreboot -> "grub-coreboot" 		Xen -> "grub-xen" --- | Installs grub onto a device, so the system can boot from that device.+-- | Installs grub onto a device's boot loader, +-- so the system can boot from that device. -- -- You may want to install grub to multiple devices; eg for a system -- that uses software RAID.@@ -57,10 +64,25 @@ -- to arrange for this property to only run once, by eg making it be run -- onChange after OS.cleanInstallOnce. boots :: OSDevice -> Property Linux-boots dev = tightenTargets $ cmdProperty "grub-install" [dev]-	`assume` MadeChange-	`describe` ("grub boots " ++ dev)+boots dev = property' ("grub boots " ++ dev) $ \w -> do+	grubtarget <- askInfo+	let ps = case grubtarget of+		[GrubInstalled t] -> [targetParam t]+		_ -> []+	ensureProperty w $+		cmdProperty "grub-install" (ps ++ [dev])+			`assume` MadeChange +targetParam :: GrubTarget -> String+targetParam t = "--target=" ++ case t of+	PC -> "i386-pc"+	EFI32 -> "i386-efi"+	EFI64 -> "x86_64-efi"+	Coreboot -> "i386-coreboot"+	Xen -> "x86_64-xen"++type TimeoutSecs = Int+ -- | Use PV-grub chaining to boot -- -- Useful when the VPS's pv-grub is too old to boot a modern kernel image.@@ -95,8 +117,8 @@ -- at a particular directory. The OSDevice should be the underlying disk -- device that grub will be installed to (generally a whole disk,  -- not a partition).-bootsMounted :: FilePath -> OSDevice -> Property Linux-bootsMounted mnt wholediskdev = combineProperties desc $ props+bootsMounted :: FilePath -> OSDevice -> GrubTarget -> Property Linux+bootsMounted mnt wholediskdev grubtarget = combineProperties desc $ props 	-- remove mounts that are done below to make sure the right thing 	-- gets mounted 	& cleanupmounts@@ -112,7 +134,7 @@ 	& inchroot "update-grub" [] 		`assume` MadeChange 	& check haveosprober (inchroot "chmod" ["+x", osprober])-	& inchroot "grub-install" [wholediskdev]+	& inchroot "grub-install" [targetParam grubtarget, wholediskdev] 		`assume` MadeChange 	& cleanupmounts 	-- sync all buffered changes out to the disk in case it's

@@ -0,0 +1,20 @@+-- | Installer disk image generation+--+-- These modules contain properties that can be used to create a disk+-- image, suitable for booting from removable media, that can perform an+-- interactive or non-interactive installation of a Host's internal disk.+--+-- The disk image is created using propellor. When booted, it runs+-- propellor to install to the desired disk.+--+-- There is no user interface included here. For an example of using+-- this to build a full, interactive installer, see+-- <https://git.joeyh.name/index.cgi/secret-project.git/>++module Propellor.Property.Installer (+	module Propellor.Property.Installer.Types,+	module Propellor.Property.Installer.Target+) where++import Propellor.Property.Installer.Types+import Propellor.Property.Installer.Target

@@ -0,0 +1,462 @@+{-# LANGUAGE TypeOperators #-}++-- | Installation to a target disk.+-- +-- Note that the RevertableProperties in this module are not really+-- revertable; the target disk can't be put back how it was. +-- The RevertableProperty type is used only to let them  be used+-- in a Versioned Host as shown below.+--+-- Here's an example of a noninteractive installer image using+-- these properties.+--+-- There are two versions of Hosts, the installer and the target system.+-- +-- > data Variety = Installer | Target+-- > 	deriving (Eq)+-- +-- The seed of both the installer and the target. They have some properties+-- in common, and some different properties. The `targetInstalled`+-- property knows how to convert the installer it's running on into a+-- target system.+--+-- > seed :: Versioned Variety Host+-- > seed ver = host "debian.local" $ props+-- > 	& osDebian Unstable X86_64+-- > 	& Hostname.sane+-- > 	& Apt.stdSourcesList+-- > 	& Apt.installed ["linux-image-amd64"]+-- > 	& Grub.installed PC+-- > 	& "en_US.UTF-8" `Locale.selectedFor` ["LANG"]+-- > 	& ver ( (== Installer) --> targetInstalled seed Target (userInput ver) parts)+-- > 	& ver ( (== Target)    --> fstabLists (userInput ver) parts)+-- > 	& ver ( (== Installer) --> targetBootable (userInput ver))+-- >   where+-- > 	parts = TargetPartTable MSDOS+-- > 		[ partition EXT4 `mountedAt` "/"+-- > 			`useDiskSpace` RemainingSpace+-- > 		, swapPartition (MegaBytes 1024)+-- > 		]+-- +-- The installer disk image can then be built from the seed as follows:+-- +-- > installerBuilt :: RevertableProperty (HasInfo + DebianLike) Linux+-- > installerBuilt = imageBuilt (VirtualBoxPointer "/srv/installer.vmdk")+-- >	(hostChroot (seed `version` installer) (Debootstrapped mempty))+-- >	MSDOS+-- > 	 [ partition EXT4 `mountedAt` "/"+-- >		`setFlag` BootFlag+-- >		`reservedSpacePercentage` 0+-- > 		`addFreeSpace` MegaBytes 256+-- > 	]+--+-- When the installer is booted up, and propellor is run, it installs+-- to the target disk. Since this example is a noninteractive installer,+-- the details of what it installs to are configured before it's built.+-- +-- > data HardCodedUserInput = HardCodedUserInput (Maybe TargetDiskDevice) (Maybe DiskEraseConfirmed)+-- > +-- > instance UserInput HardCodedUserInput where +-- > 	targetDiskDevice (HardCodedUserInput t _) = Just t+-- > 	diskEraseConfirmed (HardCodedUserInput _ c) = Just c+-- > +-- > userInput :: Version -> HardCodedUserInput+-- > userInput Installer =  HardCodedUserInput Nothing Nothing+-- > userInput Target = HardCodedUserInput (Just (TargetDiskDevice "/dev/sda")) (Just DiskEraseConfirmed)+--+-- For an example of how to use this to make an interactive installer,+-- see <https://git.joeyh.name/index.cgi/secret-project.git/>++module Propellor.Property.Installer.Target (+	TargetPartTable(..),+	targetInstalled,+	mountTarget,+	fstabLists,+	targetBootable,+	partitionTargetDisk,+	targetDir,+	probeDisk,+	findDiskDevices,+	TargetFilled,+	TargetFilledHandle,+	prepTargetFilled,+	checkTargetFilled,+	TargetFilledPercent(..),+	targetFilledPercent,+) where++import Propellor+import Propellor.Property.Installer.Types+import Propellor.Message+import Propellor.Types.Bootloader+import Propellor.Types.PartSpec+import Propellor.Property.Chroot+import Propellor.Property.Versioned+import Propellor.Property.Parted+import Propellor.Property.Mount+import qualified Propellor.Property.Fstab as Fstab+import qualified Propellor.Property.Grub as Grub+import qualified Propellor.Property.Rsync as Rsync++import Text.Read+import Control.Monad+import Control.Monad.IO.Class (liftIO)+import System.Directory+import System.FilePath+import Data.Maybe+import Data.List+import Data.Char+import Data.Ord+import Data.Ratio+import System.Process (readProcess)++data TargetPartTable = TargetPartTable TableType [PartSpec DiskPart]++-- | Property that installs the target system to the TargetDiskDevice+-- specified in the UserInput. That device will be re-partitioned and+-- formatted and all files erased.+--+-- The installation is done efficiently by rsyncing the installer's files+-- to the target, which forms the basis for a chroot that is provisioned with+-- the specified version of the Host. Thanks to+-- Propellor.Property.Versioned, any unwanted properties of the installer+-- will be automatically reverted in the chroot.+--+-- When there is no TargetDiskDevice or the user has not confirmed the+-- installation, nothing is done except for installing dependencies. +-- So, this can also be used as a property of the installer+-- image.+targetInstalled+	:: UserInput i +	=> Versioned v Host+	-> v+	-> i+	-> TargetPartTable+	-> RevertableProperty (HasInfo + DebianLike) (HasInfo + DebianLike)+targetInstalled vtargethost v userinput (TargetPartTable tabletype partspec) = +	case (targetDiskDevice userinput, diskEraseConfirmed userinput) of+		(Just (TargetDiskDevice targetdev), Just _diskeraseconfirmed) -> +			go `describe` ("target system installed to " ++ targetdev)+		_ -> tightenTargets installdeps <!> doNothing+  where+	targethost = vtargethost `version` v+	go = RevertableProperty+		(setupRevertableProperty p)+		-- Versioned needs both "sides" of the RevertableProperty+		-- to have the same type, so add empty Info to make the+		-- types line up.+		(undoRevertableProperty p `setInfoProperty` mempty)+	  where+		p = partitionTargetDisk userinput tabletype partspec+			`before` mountTarget userinput partspec+			`before` provisioned chroot+	+	chroot = hostChroot targethost RsyncBootstrapper targetDir++	-- Install dependencies that will be needed later when installing+	-- the target.+	installdeps = Rsync.installed++data RsyncBootstrapper = RsyncBootstrapper++instance ChrootBootstrapper RsyncBootstrapper where+	buildchroot RsyncBootstrapper _ target = Right $+		mountaside+			`before` rsynced+			`before` umountaside+	  where+	  	-- bind mount the root filesystem to /mnt, which exposes+		-- the contents of all directories that have things mounted+		-- on top of them to rsync.+		mountaside = bindMount "/" "/mnt"+		rsynced = Rsync.rsync+			[ "--one-file-system"+			, "-aHAXS"+			, "--delete"+			, "/mnt/"+			, target+			]+		umountaside = cmdProperty "umount" ["-l", "/mnt"]+			`assume` MadeChange++mountTarget+	:: UserInput i+	=> i+	-> [PartSpec DiskPart]+	-> RevertableProperty Linux Linux+mountTarget userinput partspec = setup <!> cleanup+  where+	setup = property "target mounted" $+		case targetDiskDevice userinput of+			Just (TargetDiskDevice targetdev) -> do+				liftIO unmountTarget+				r <- liftIO $ forM tomount $+					mountone targetdev+				if and r+					then return MadeChange+					else return FailedChange+			Nothing -> return NoChange+	cleanup = property "target unmounted" $ do+		liftIO unmountTarget+		liftIO $ removeDirectoryRecursive targetDir+		return NoChange++	-- Sort so / comes before /home etc+	tomount = sortOn (fst . fst) $+		map (\((mp, mo, _, _), n) -> ((mp, mo), n)) $+		zip partspec partNums++	mountone targetdev ((mmountpoint, mountopts), num) =+		case mmountpoint of+			Nothing -> return True+			Just mountpoint -> do+				let targetmount = targetDir ++ mountpoint+				createDirectoryIfMissing True targetmount+				let dev = diskPartition targetdev num+				mount "auto" dev targetmount mountopts++-- | Property for use in the target Host to set up its fstab.+-- Should be passed the same TargetPartTable as `targetInstalled`.+fstabLists+	:: UserInput i+	=> i+	-> TargetPartTable+	-> RevertableProperty Linux Linux+fstabLists userinput (TargetPartTable _ partspecs) = setup <!> doNothing+  where+	setup = case targetDiskDevice userinput of+		Just (TargetDiskDevice targetdev) ->+			Fstab.fstabbed mnts (swaps targetdev)+				`requires` devmounted+				`before` devumounted+		Nothing -> doNothing++	-- needed for ftabbed UUID probing to work+	devmounted :: Property Linux+	devmounted = tightenTargets $ mounted "devtmpfs" "udev" "/dev" mempty+	devumounted :: Property Linux+	devumounted = tightenTargets $ cmdProperty "umount" ["-l", "/dev"]+		`assume` MadeChange+	+	partitions = map (\(mp, _, mkpart, _) -> (mp, mkpart mempty)) partspecs+	mnts = mapMaybe fst $+		filter (\(_, p) -> partFs p /= LinuxSwap) partitions+	swaps targetdev = +		map (Fstab.SwapPartition . diskPartition targetdev . snd) $+			filter (\((_, p), _) -> partFs p == LinuxSwap)+				(zip partitions partNums)++-- | Make the target bootable using whatever bootloader is installed on it.+targetBootable+	:: UserInput i+	=> i+	-> RevertableProperty Linux Linux+targetBootable userinput = +	case (targetDiskDevice userinput, diskEraseConfirmed userinput) of+		(Just (TargetDiskDevice targetdev), Just _diskeraseconfirmed) -> +			go targetdev <!> doNothing+		_ -> doNothing <!> doNothing+  where+	desc = "bootloader installed on target disk"+	go :: FilePath -> Property Linux+	go targetdev = property' desc $ \w -> do+		bootloaders <- askInfo+		case bootloaders of+			[GrubInstalled gt] -> ensureProperty w $+				Grub.bootsMounted targetDir targetdev gt+			[] -> do+				warningMessage "no bootloader was installed"+				return NoChange+			l -> do+				warningMessage $ "don't know how to enable bootloader(s) " ++ show l+				return FailedChange++partitionTargetDisk+	:: UserInput i+	=> i+	-> TableType+	-> [PartSpec DiskPart]+	-> RevertableProperty DebianLike DebianLike+partitionTargetDisk userinput tabletype partspec = go <!> doNothing+  where+	go = check targetNotMounted $ property' "target disk partitioned" $ \w -> do+		case (targetDiskDevice userinput, diskEraseConfirmed userinput) of+			(Just (TargetDiskDevice targetdev), Just _diskeraseconfirmed) -> do+				liftIO $ unmountTarget+				disksize <- liftIO $ getDiskSize targetdev+				let parttable = calcPartTable disksize tabletype safeAlignment partspec+				ensureProperty w $ +					partitioned YesReallyDeleteDiskContents targetdev parttable+			_ -> error "user input does not allow partitioning disk"++unmountTarget :: IO ()+unmountTarget = mapM_ umountLazy . reverse . sort =<< targetMountPoints++targetMountPoints :: IO [MountPoint]+targetMountPoints = filter isTargetMountPoint <$> mountPoints++isTargetMountPoint :: MountPoint -> Bool+isTargetMountPoint mp = +	mp == targetDir +		|| addTrailingPathSeparator targetDir `isPrefixOf` mp++targetNotMounted :: IO Bool+targetNotMounted = not . any (== targetDir) <$> mountPoints++-- | Where the target disk is mounted while it's being installed.+targetDir :: FilePath+targetDir = "/target"++partNums :: [Integer]+partNums = [1..]++-- /dev/sda to /dev/sda1+diskPartition :: FilePath -> Integer -> FilePath+diskPartition dev num = dev ++ show num++-- | This can be used to find a likely disk device to use as the target+-- for an installation.+--+-- This is a bit of a hack; of course the user could be prompted but to+-- avoid prompting, some heuristics...+--   * It should not already be mounted. +--   * Prefer disks big enough to comfortably hold a Linux installation,+--     so at least 8 gb.+--     (But, if the system only has a smaller disk, it should be used.)+--   * A medium size internal disk is better than a large removable disk,+--     because removable or added drives are often used for data storage+--     on systems with smaller internal disk for the OS.+--     (But, if the internal disk is too small, prefer removable disk;+--     some systems have an unusably small internal disk.)+--   * Prefer the first disk in BIOS order, all other things being equal,+--     because the main OS disk typically comes first. This can be+--     approximated by preferring /dev/sda to /dev/sdb.+probeDisk :: IO TargetDiskDevice+probeDisk = do+	unmountTarget+	mounteddevs <- getMountedDeviceIDs+	let notmounted d = flip notElem (map Just mounteddevs)+		<$> getMinorNumber d+	candidates <- mapM probeCandidate+		=<< filterM notmounted+		=<< findDiskDevices+	case reverse (sort candidates) of+		(Candidate { candidateDevice = Down dev } : _) -> +			return $ TargetDiskDevice dev+		[] -> error "Unable to find any disk to install to!"++-- | Find disk devices, such as /dev/sda (not partitions)+findDiskDevices :: IO [FilePath]+findDiskDevices = map ("/dev" </>) . filter isdisk+	<$> getDirectoryContents "/dev"+  where+	isdisk ('s':'d':_:[]) = True+	isdisk _ = False++-- | When comparing two Candidates, the better of the two will be larger.+data Candidate = Candidate+	{ candidateBigEnoughForOS :: Bool+	, candidateIsFixedDisk :: Bool+	-- use Down so that /dev/sda orders larger than /dev/sdb+	, candidateDevice :: Down FilePath+	} deriving (Eq, Ord)++probeCandidate :: FilePath -> IO Candidate+probeCandidate dev = do+	DiskSize sz <- getDiskSize dev+	isfixeddisk <- not <$> isRemovableDisk dev+	return $ Candidate+		{ candidateBigEnoughForOS = sz >= 8 * onegb+		, candidateIsFixedDisk = isfixeddisk+		, candidateDevice = Down dev+		}+  where+	onegb = 1024*1024*1000++newtype MinorNumber = MinorNumber Integer+	deriving (Eq, Show)++getMountedDeviceIDs :: IO [MinorNumber]+getMountedDeviceIDs = mapMaybe parse . lines <$> readProcess "findmnt"+	[ "-rn"+	, "--output"+	, "MAJ:MIN"+	]+	""+  where+	parse = fmap MinorNumber . readMaybe +		. dropWhile (not . isDigit) . dropWhile (/= ':')++-- There is not currently a native haskell interface for getting the minor+-- number of a device.+getMinorNumber :: FilePath -> IO (Maybe MinorNumber)+getMinorNumber dev = fmap MinorNumber . readMaybe +	<$> readProcess "stat" [ "--printf", "%T", dev ] ""++-- A removable disk may show up as removable or as hotplug.+isRemovableDisk :: FilePath -> IO Bool+isRemovableDisk dev = do+	isremovable <- checkblk "RM"+	ishotplug <- checkblk "HOTPLUG"+	return (isremovable || ishotplug)+  where+	checkblk field = (== "1\n") <$> readProcess "lsblk"+		[ "-rn"+		, "--nodeps"+		, "--output", field+		, dev+		]+		""++getDiskSize :: FilePath -> IO DiskSize+getDiskSize dev = do+	sectors <- fromMaybe 0 . readMaybe +		<$> readProcess "blockdev" ["--getsz", dev] ""+	return (DiskSize (sectors * 512))++getMountsSizes :: IO [(MountPoint, Integer)]+getMountsSizes = mapMaybe (parse . words) . lines <$> readProcess "findmnt" ps ""+  where+	ps = ["-rnb", "-o", "TARGET,USED"]+	parse (mp:szs:[]) = do+		sz <- readMaybe szs+		return (mp, sz)+	parse _ = Nothing++-- | How much of the target disks are used, compared with the size of the+-- installer's root device. Since the main part of an installation +-- is rsyncing the latter to the former, this allows roughly estimating+-- the percent done while an install is running, and can be used in some+-- sort of progress display.+data TargetFilled = TargetFilled (Ratio Integer)+	deriving (Show, Eq)++instance Monoid TargetFilled where+	mempty = TargetFilled (0 % 1)+	mappend (TargetFilled n) (TargetFilled m) = TargetFilled (n+m)++newtype TargetFilledHandle = TargetFilledHandle Integer++prepTargetFilled :: IO TargetFilledHandle+prepTargetFilled = go =<< getMountSource "/"+  where+	go (Just dev) = do+		-- Assumes that the installer uses a single partition.+		DiskSize sz <- getDiskSize dev+		return (TargetFilledHandle sz)+	go Nothing = return (TargetFilledHandle 0)++checkTargetFilled :: TargetFilledHandle -> IO TargetFilled+checkTargetFilled (TargetFilledHandle installsz) = do+	targetsz <- sum . map snd . filter (isTargetMountPoint . fst)+		<$> getMountsSizes+	return (TargetFilled (targetsz % max 1 installsz))++newtype TargetFilledPercent = TargetFilledPercent Int+	deriving (Show, Eq)++targetFilledPercent :: TargetFilled -> TargetFilledPercent+targetFilledPercent (TargetFilled r) = TargetFilledPercent $ floor percent+  where+	percent :: Double+	percent = min 100 (fromRational r * 100)

@@ -0,0 +1,16 @@+module Propellor.Property.Installer.Types where++-- | The disk device to install to.+newtype TargetDiskDevice = TargetDiskDevice FilePath+	deriving (Read, Show)++data DiskEraseConfirmed = DiskEraseConfirmed+	deriving (Read, Show)++-- | Class of user input that an installer might prompt for.+class UserInput i where+	-- | Get the disk device the user selected to install to.+	targetDiskDevice :: i -> Maybe TargetDiskDevice+	-- | Check if the user has confirmed they want to erase the target+	-- disk device.+	diskEraseConfirmed :: i -> Maybe DiskEraseConfirmed

@@ -149,4 +149,6 @@ unmountBelow :: FilePath -> IO () unmountBelow d = do 	submnts <- mountPointsBelow d-	forM_ submnts umountLazy+	-- sort so sub-mounts are unmounted before the mount point+	-- containing them+	forM_ (reverse (sort submnts)) umountLazy

@@ -13,6 +13,8 @@ 	toPartSize, 	fromPartSize, 	reducePartSize,+	Alignment(..),+	safeAlignment, 	Partition.MkfsOpts, 	PartType(..), 	PartFlag(..),@@ -50,19 +52,28 @@ -- -- This deletes any existing partitions in the disk! Use with EXTREME caution! partitioned :: Eep -> FilePath -> PartTable -> Property DebianLike-partitioned eep disk (PartTable tabletype parts) = property' desc $ \w -> do+partitioned eep disk parttable@(PartTable _ _ parts) = property' desc $ \w -> do 	isdev <- liftIO $ isBlockDevice <$> getFileStatus disk 	ensureProperty w $ combineProperties desc $ props-		& parted eep disk partedparams+		& parted eep disk (fst (calcPartedParamsSize parttable)) 		& if isdev 			then formatl (map (\n -> disk ++ show n) [1 :: Int ..]) 			else Partition.kpartx disk (formatl . map Partition.partitionLoopDev)   where 	desc = disk ++ " partitioned" 	formatl devs = combineProperties desc (toProps $ map format (zip parts devs))-	partedparams = concat $ mklabel : mkparts (1 :: Integer) mempty parts [] 	format (p, dev) = Partition.formatted' (partMkFsOpts p) 		Partition.YesReallyFormatPartition (partFs p) dev++-- | Gets the total size of the disk specified by the partition table.+partTableSize :: PartTable -> ByteSize+partTableSize = snd . calcPartedParamsSize++calcPartedParamsSize :: PartTable -> ([String], ByteSize)+calcPartedParamsSize (PartTable tabletype alignment parts) = +	let (ps, sz) = calcparts (1 :: Integer) firstpos parts []+	in (concat (mklabel : ps), sz)+  where 	mklabel = ["mklabel", pval tabletype] 	mkflag partnum (f, b) = 		[ "set"@@ -70,39 +81,58 @@ 		, pval f 		, pval b 		]-	mkpart partnum offset p =+	mkpart partnum startpos endpos p = 		[ "mkpart" 		, pval (partType p) 		, pval (partFs p)-		, pval offset-		, pval (offset <> partSize p)+		, partposexact startpos+		, partposfuzzy endpos 		] ++ case partName p of 			Just n -> ["name", show partnum, n] 			Nothing -> []-	mkparts partnum offset (p:ps) c = -		mkparts (partnum+1) (offset <> partSize p) ps-			(c ++ mkpart partnum offset p : map (mkflag partnum) (partFlags p))-	mkparts _ _ [] c = c+	calcparts partnum startpos (p:ps) c =+		let endpos = startpos + align (partSize p)+		in calcparts (partnum+1) endpos ps+			(c ++ mkpart partnum startpos (endpos-1) p : map (mkflag partnum) (partFlags p))+	calcparts _ endpos [] c = (c, endpos) +	-- Exact partition position value for parted.+	-- For alignment to work, the start of a partition must be+	-- specified exactly.+	partposexact n+		| n > 0 = show n ++ "B"+		-- parted can't make partitions smaller than 1MB;+		-- avoid failure in edge cases+		| otherwise = "1MB"+	+	-- Fuzzy partition position valie for parted.+	-- This is used to specify the end of the partition,+	-- parted takes the "MB" as license to slightly reduce the+	-- partition size when something about the partition table+	-- does not allow the partition to end exactly at the position.+	partposfuzzy n+		| n > 0 = show (fromIntegral n / 1000000 :: Double) ++ "MB"+		| otherwise = "1MB"++	-- Location of the start of the first partition,+	-- leaving space for the partition table, and aligning.+	firstpos = align partitionTableOverhead+	+	align = alignTo alignment+ -- | Runs parted on a disk with the specified parameters. -- -- Parted is run in script mode, so it will never prompt for input.--- It is asked to use cylinder alignment for the disk. parted :: Eep -> FilePath -> [String] -> Property (DebianLike + ArchLinux) parted YesReallyDeleteDiskContents disk ps = p `requires` installed   where-	p = cmdProperty "parted" ("--script":"--align":"cylinder":disk:ps)+	p = cmdProperty "parted" ("--script":"--align":"none":disk:ps) 		`assume` MadeChange  -- | Gets parted installed. installed :: Property (DebianLike + ArchLinux) installed = Apt.installed ["parted"] `pickOS` Pacman.installed ["parted"] --- | Gets the total size of the disk specified by the partition table.-partTableSize :: PartTable -> ByteSize-partTableSize (PartTable _ ps) = fromPartSize $-	mconcat (partitionTableOverhead : map partSize ps)- -- | Some disk is used to store the partition table itself. Assume less -- than 1 mb. partitionTableOverhead :: PartSize@@ -112,27 +142,27 @@ -- -- For example: ----- >	calcPartTable (DiskSize (1024 * 1024 * 1024 * 100)) MSDOS+-- >	calcPartTable (DiskSize (1024 * 1024 * 1024 * 100)) MSDOS safeAlignment -- > 		[ partition EXT2 `mountedAt` "/boot" -- > 			`setSize` MegaBytes 256 -- > 			`setFlag` BootFlag -- >		, partition EXT4 `mountedAt` "/"--- >			`useDisk` RemainingSpace+-- >			`useDiskSpace` RemainingSpace -- >		]-calcPartTable :: DiskSize -> TableType -> [PartSpec DiskPart] -> PartTable-calcPartTable (DiskSize disksize) tt l = PartTable tt (map go l)+calcPartTable :: DiskSize -> TableType -> Alignment -> [PartSpec DiskPart] -> PartTable+calcPartTable (DiskSize disksize) tt alignment l =+	PartTable tt alignment (map go l)   where 	go (_, _, mkpart, FixedDiskPart) = mkpart defSz-	go (_, _, mkpart, DynamicDiskPart (Percent p)) = mkpart $ toPartSize $+	go (_, _, mkpart, DynamicDiskPart (Percent p)) = mkpart $ Bytes $ 		diskremainingafterfixed * fromIntegral p `div` 100-	go (_, _, mkpart, DynamicDiskPart RemainingSpace) = mkpart $ toPartSize $+	go (_, _, mkpart, DynamicDiskPart RemainingSpace) = mkpart $ Bytes $ 		diskremaining `div` genericLength (filter isremainingspace l)-	diskremainingafterfixed = +	diskremainingafterfixed = 		disksize - sumsizes (filter isfixed l) 	diskremaining = 		disksize - sumsizes (filter (not . isremainingspace) l)-	sumsizes = sum . map fromPartSize . (partitionTableOverhead :) .-		map (partSize . go)+	sumsizes = partTableSize . PartTable tt alignment . map go 	isfixed (_, _, _, FixedDiskPart) = True 	isfixed _ = False 	isremainingspace (_, _, _, DynamicDiskPart RemainingSpace) = True@@ -177,3 +207,14 @@ -- Add an additional 200 mb for temp files, journals, etc. fudgeSz :: PartSize -> PartSize fudgeSz (MegaBytes n) = MegaBytes (n + n `div` 100 * 2 + 3 + 200)+fudgeSz (Bytes n) = fudgeSz (toPartSize n)++alignTo :: Alignment -> PartSize -> ByteSize+alignTo _ (Bytes n) = n -- no alignment done for Bytes+alignTo (Alignment alignment) partsize+	| alignment < 1 = n+	| otherwise = case rem n alignment of+		0 -> n+		r -> n - r + alignment+  where+	n = fromPartSize partsize

@@ -1,6 +1,5 @@ module Propellor.Property.Parted.Types where -import Propellor.Base import qualified Propellor.Property.Partition as Partition import Utility.DataUnits @@ -17,14 +16,16 @@ 	pval = map toLower . show  -- | A disk's partition table.-data PartTable = PartTable TableType [Partition]+data PartTable = PartTable TableType Alignment [Partition] 	deriving (Show)  instance Monoid PartTable where-	-- | default TableType is MSDOS-	mempty = PartTable MSDOS []+	-- | default TableType is MSDOS, with a `safeAlignment`.+	mempty = PartTable MSDOS safeAlignment [] 	-- | uses the TableType of the second parameter-	mappend (PartTable _l1 ps1) (PartTable l2 ps2) = PartTable l2 (ps1 ++ ps2)+	-- and the larger alignment,+	mappend (PartTable _l1 a1 ps1) (PartTable l2 a2 ps2) =+		PartTable l2 (max a1 a2) (ps1 ++ ps2)  -- | A partition on the disk. data Partition = Partition@@ -57,34 +58,52 @@ 	pval Logical = "logical" 	pval Extended = "extended" --- | All partition sizing is done in megabytes, so that parted can--- automatically lay out the partitions.------ Note that these are SI megabytes, not mebibytes.-newtype PartSize = MegaBytes Integer+-- | Size of a partition.+data PartSize+	-- Since disk sizes are typically given in MB, not MiB, this+	-- uses SI MegaBytes (powers of 10).+	= MegaBytes Integer+	-- For more control, the partition size can be given in bytes.+	-- Note that this will prevent any automatic alignment from +	-- being done.+	| Bytes Integer 	deriving (Show) -instance PartedVal PartSize where-	pval (MegaBytes n)-		| n > 0 = val n ++ "MB"-		-- parted can't make partitions smaller than 1MB;-		-- avoid failure in edge cases-		| otherwise = "1MB"- -- | Rounds up to the nearest MegaByte. toPartSize :: ByteSize -> PartSize-toPartSize b = MegaBytes $ ceiling (fromInteger b / 1000000 :: Double)+toPartSize = toPartSize' ceiling +toPartSize' :: (Double -> Integer) -> ByteSize -> PartSize+toPartSize' rounder b = MegaBytes $ rounder (fromInteger b / 1000000 :: Double)+ fromPartSize :: PartSize -> ByteSize fromPartSize (MegaBytes b) = b * 1000000+fromPartSize (Bytes n) = n  instance Monoid PartSize where 	mempty = MegaBytes 0 	mappend (MegaBytes a) (MegaBytes b) = MegaBytes (a + b)+	mappend (Bytes a) b = Bytes (a + fromPartSize b)+	mappend a (Bytes b) = Bytes (b + fromPartSize a)  reducePartSize :: PartSize -> PartSize -> PartSize reducePartSize (MegaBytes a) (MegaBytes b) = MegaBytes (a - b)+reducePartSize (Bytes a) b = Bytes (a - fromPartSize b)+reducePartSize a (Bytes b) = Bytes (fromPartSize a - b) +-- | Partitions need to be aligned for optimal efficiency.+-- The alignment is a number of bytes.+newtype Alignment = Alignment ByteSize+	deriving (Show, Eq, Ord)++-- | 4MiB alignment is optimal for inexpensive flash drives and+-- is a good safe default for all drives.+safeAlignment :: Alignment+safeAlignment = Alignment (4*1024*1024)++fromAlignment :: Alignment -> ByteSize+fromAlignment (Alignment n) = n+ -- | Flags that can be set on a partition. data PartFlag = BootFlag | RootFlag | SwapFlag | HiddenFlag | RaidFlag | LvmFlag | LbaFlag | LegacyBootFlag | IrstFlag | EspFlag | PaloFlag 	deriving (Show)@@ -106,6 +125,8 @@ 	pval True = "on" 	pval False = "off" +-- This is used for creating partitions, not formatting partitions,+-- so it's ok to use eg, fat32 for both FAT and VFAT. instance PartedVal Partition.Fs where 	pval Partition.EXT2 = "ext2" 	pval Partition.EXT3 = "ext3"@@ -113,7 +134,7 @@ 	pval Partition.BTRFS = "btrfs" 	pval Partition.REISERFS = "reiserfs" 	pval Partition.XFS = "xfs"-	pval Partition.FAT = "fat"-	pval Partition.VFAT = "vfat"+	pval Partition.FAT = "fat32"+	pval Partition.VFAT = "fat32" 	pval Partition.NTFS = "ntfs" 	pval Partition.LinuxSwap = "linux-swap"

@@ -48,6 +48,14 @@ > >  $autopkgtest_root_args = ""; >  $autopkgtest_opts = ["--", "schroot", "%r-%a-sbuild"];++On Debian jessie hosts, you should ensure that sbuild and autopkgtest come from+the same suite.  This is because the autopkgtest binary changed its name between+jessie and stretch.  If you have not installed backports of sbuild or+autopkgtest, you don't need to do anything.  But if you have installed either+package from jessie-backports (with Propellor or otherwise), you should install+the other from jessie-backports, too.+ -}  module Propellor.Property.Sbuild (@@ -376,6 +384,13 @@ -- -- You probably want a custom ~/.sbuildrc on your workstation, but -- this property is handy for quickly setting up build boxes.+--+-- On Debian jessie hosts, you should ensure that sbuild and autopkgtest come+-- from the same suite.  This is because the autopkgtest binary changed its name+-- between jessie and stretch.  If you have not installed backports of sbuild or+-- autopkgtest, you don't need to do anything.  But if you have installed either+-- package from jessie-backports (with Propellor or otherwise), you should+-- install the other from jessie-backports, too. userConfig :: User -> Property DebianLike userConfig user@(User u) = go 	`requires` usableBy user

@@ -181,6 +181,8 @@ 		-- Works around ghc crash with parallel builds on arm. 		& (homedir </> ".cabal" </> "config") 			`File.lacksLine` "jobs: $ncpus"+		-- Work around https://github.com/systemd/systemd/issues/7135+		& Systemd.containerCfg "--system-call-filter=set_tls"  androidAutoBuilderContainer :: Times -> TimeOut -> Systemd.Container androidAutoBuilderContainer crontimes timeout =

@@ -646,7 +646,7 @@ 		& Apt.serviceInstalledRunning "opendkim" 		& File.dirExists "/etc/mail" 		& File.hasPrivContent "/etc/mail/dkim.key" (Context "kitenet.net")-		& File.ownerGroup "/etc/mail/dkim.key" (User "opendkim") (Group "opendkim")+		& File.ownerGroup "/etc/mail/dkim.key" (User "root") (Group "root") 		& "/etc/default/opendkim" `File.containsLine` 			"SOCKET=\"inet:8891@localhost\"" 			`onChange` @@ -906,8 +906,8 @@ 		("Login", "LidSwitchIgnoreInhibited", "no")  -- My home power monitor.-homePowerMonitor :: IsContext c => User -> c -> (SshKeyType, Ssh.PubKeyText) -> Property (HasInfo + DebianLike)-homePowerMonitor user ctx sshkey = propertyList "home power monitor" $ props+homePowerMonitor :: IsContext c => User -> [Host] -> c -> (SshKeyType, Ssh.PubKeyText) -> Property (HasInfo + DebianLike)+homePowerMonitor user hosts ctx sshkey = propertyList "home power monitor" $ props 	& Apache.installed 	& Apt.installed ["python", "python-pymodbus", "rrdtool", "rsync"] 	& File.ownerGroup "/var/www/html" user (userGroup user)@@ -923,6 +923,7 @@ 		`requires` File.ownerGroup (takeDirectory sshkeyfile) 			user (userGroup user) 		`requires` File.dirExists (takeDirectory sshkeyfile)+		`requires` Ssh.knownHost hosts "kitenet.net" user   where 	d = "/var/www/html/homepower" 	sshkeyfile = d </> ".ssh/key"@@ -1033,3 +1034,47 @@ 	ifupscript = "/etc/network/if-up.d/ipmasq" 	pppupscript = "/etc/ppp/ip-up.d/ipmasq" 	scriptmode f = f `File.mode` combineModes (readModes ++ executeModes)++laptopSoftware :: Property DebianLike+laptopSoftware = Apt.installed+	[ "procmeter3", "xfce4", "procmeter3", "unclutter"+	, "mplayer", "fbreader", "firefox", "chromium"+	, "libdatetime-event-sunrise-perl", "libtime-duration-perl"+	, "iftop", "network-manager", "gtk-redshift", "powertop"+	, "gimp", "gthumb", "inkscape", "sozi", "xzgv", "hugin"+	, "mpc", "mpd", "ncmpc", "sonata", "mpdtoys"+	, "bsdgames", "nethack"+	, "xmonad", "libghc-xmonad-dev", "libghc-xmonad-contrib-dev"+	, "ttf-bitstream-vera"+	, "mairix", "offlineimap", "mutt"+	, "nmap"+	, "udevil", "pmount"+	, "arbtt", "hledger", "bc"+	, "apache2", "ikiwiki", "libhighlight-perl"+	, "pal"+	, "yeahconsole", "xkbset", "xinput"+	, "assword", "pumpa", "vorbis-tools"+	, "xul-ext-ublock-origin", "xul-ext-pdf.js", "xul-ext-status4evar"+	, "vim-syntastic", "vim-fugitive"+	, "adb", "gthumb"+	, "w3m", "sm", "weechat"+	, "borgbackup", "wipe"+	]+	`requires` baseSoftware+	`requires` devSoftware++baseSoftware :: Property DebianLike+baseSoftware = Apt.installed+	[ "bash", "bash-completion", "vim", "screen", "less", "moreutils"+	, "git", "mr", "etckeeper", "git-annex", "ssh", "vim-vimoutliner"+	]++devSoftware :: Property DebianLike+devSoftware = Apt.installed+	[ "build-essential", "debhelper", "devscripts"+	, "ghc", "cabal-install", "haskell-stack"+	, "hothasktags", "hdevtools", "hlint"+	, "gdb", "dpkg-repack", "lintian"+	, "pristine-tar", "github-backup"+	, "kvm"+	]

@@ -7,13 +7,16 @@  -- | Boot loader installed on a host. data BootloaderInstalled-	= GrubInstalled+	= GrubInstalled GrubTarget 	| FlashKernelInstalled 	| UbootInstalled (FilePath -> FilePath -> Property Linux) 	deriving (Typeable) +-- | Platforms that grub can boot.+data GrubTarget = PC | EFI64 | EFI32 | Coreboot | Xen+ instance Show BootloaderInstalled where-	show GrubInstalled = "GrubInstalled"+	show (GrubInstalled _) = "GrubInstalled" 	show FlashKernelInstalled = "FlashKernelInstalled" 	show (UbootInstalled _) = "UbootInstalled"