From e10ca0800469bcae1d208d2d4540e44b21ee1edf Mon Sep 17 00:00:00 2001
From: Sean Whitton <spwhitton@spwhitton.name>
Date: Sat, 22 Jul 2017 10:53:02 -0700
Subject: avoid one failure of Reboot.toKernelNewerThan when /boot not mounted

If the running kernel is new enough, there is no need to look at the
kernels installed on the system.
---
 src/Propellor/Property/Reboot.hs | 17 +++++++++--------
 1 file changed, 9 insertions(+), 8 deletions(-)

(limited to 'src')

diff --git a/src/Propellor/Property/Reboot.hs b/src/Propellor/Property/Reboot.hs
index 3781cd7b..909d87fb 100644
--- a/src/Propellor/Property/Reboot.hs
+++ b/src/Propellor/Property/Reboot.hs
@@ -78,15 +78,16 @@ toKernelNewerThan ver =
 	property' ("reboot to kernel newer than " ++ ver) $ \w -> do
 		wantV <- tryReadVersion ver
 		runningV <- tryReadVersion =<< liftIO runningKernelVersion
-		installedV <- maximum <$>
-			(mapM tryReadVersion =<< liftIO installedKernelVersions)
 		if runningV >= wantV then noChange
-			else if installedV >= wantV
-				then ensureProperty w now
-				else errorMessage $
-					"kernel newer than "
-					++ ver
-					++ " not installed"
+			else maximum <$> installedVs >>= \installedV ->
+				if installedV >= wantV
+					then ensureProperty w now
+					else errorMessage $
+						"kernel newer than "
+						++ ver
+						++ " not installed"
+  where
+	installedVs = mapM tryReadVersion =<< liftIO installedKernelVersions
 
 runningInstalledKernel :: IO Bool
 runningInstalledKernel = do
-- 
cgit v1.3-2-g0d8e


From f01286bc4338dcb3942b3870d7a6ea69ca773265 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 25 Jul 2017 15:13:57 -0400
Subject: DiskImage: Avoid re-partitioning disk image unncessarily, for a large
 speedup.

This commit was sponsored by Anthony DeRobertis on Patreon.
---
 debian/changelog                    |  2 ++
 src/Propellor/Property/DiskImage.hs | 22 +++++++++++++++++++---
 2 files changed, 21 insertions(+), 3 deletions(-)

(limited to 'src')

diff --git a/debian/changelog b/debian/changelog
index c359ac2b..d0b62bbf 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -3,6 +3,8 @@ propellor (4.5.1) UNRELEASED; urgency=medium
   * Reboot.toKernelNewerThan: If running kernel is new enough, avoid
     looking at what kernels are installed.
     Thanks, Sean Whitton.
+  * DiskImage: Avoid re-partitioning disk image unncessarily, for a large
+    speedup.
 
  -- Joey Hess <id@joeyh.name>  Sun, 23 Jul 2017 09:41:58 -0400
 
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 4d10f300..332ad96a 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -174,9 +174,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg
 		let (mnts, mntopts, parttable) = fitChrootSize tabletype partspec $
 			map (calcsz mnts) mnts
 		ensureProperty w $
-			imageExists img (partTableSize parttable)
-				`before`
-			partitioned YesReallyDeleteDiskContents img parttable
+			imageSetup img parttable
 				`before`
 			kpartx img (mkimg' mnts mntopts parttable)
 	mkimg' mnts mntopts parttable devs =
@@ -273,6 +271,24 @@ imageExists img isz = property ("disk image exists" ++ img) $ liftIO $ do
 	-- Common sector sizes are 512 and 4096; use 4096 as it's larger.
 	sectorsize = 4096 :: Double
 
+-- | Ensure that disk image file exists and is partitioned.
+--
+-- Avoids repartitioning the disk image, when a file of the right size
+-- already exists, and it has the same PartTable.
+imageSetup :: FilePath -> PartTable -> Property DebianLike
+imageSetup img parttable = property' ("disk image set up " ++ img) $ \w -> do
+	oldparttable <- liftIO $ catchDefaultIO "" $ readFile parttablefile
+	res <- ensureProperty w $ imageExists img (partTableSize parttable)
+	if res == NoChange && oldparttable == show parttable
+		then return NoChange
+		else if res == FailedChange
+			then return FailedChange
+			else do
+				liftIO $ writeFile parttablefile (show parttable)
+				ensureProperty w $ partitioned YesReallyDeleteDiskContents img parttable
+  where
+	parttablefile = img ++ ".parttable"
+
 -- | A property that is run after the disk image is created, with
 -- its populated partition tree mounted in the provided
 -- location from the provided loop devices. This is typically used to
-- 
cgit v1.3-2-g0d8e