From f01286bc4338dcb3942b3870d7a6ea69ca773265 Mon Sep 17 00:00:00 2001 From: Joey Hess 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(-) 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 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.2.3