From 979f1459cf61886ab24302c8a11637965b7c77aa Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 10 Nov 2018 12:53:14 -0700 Subject: add DiskImage.imageChrootNotPresent --- src/Propellor/Property/DiskImage.hs | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index fa41808e..29bc2d1c 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -17,6 +17,7 @@ module Propellor.Property.DiskImage ( imageRebuiltFor, imageBuiltFrom, imageExists, + imageChrootNotPresent, GrubTarget(..), noBootloader, ) where @@ -200,14 +201,13 @@ imageBuilt' rebuild img mkchroot tabletype partspec = `describe` desc where desc = "built disk image " ++ describeDiskImage img - RawDiskImage imgfile = rawDiskImage img cleanrebuild :: Property Linux cleanrebuild | rebuild = property desc $ do liftIO $ removeChroot chrootdir return MadeChange | otherwise = doNothing - chrootdir = imgfile ++ ".chroot" + chrootdir = imageChroot img chroot = let c = propprivdataonly $ mkchroot chrootdir in setContainerProps c $ containerProps c @@ -378,7 +378,7 @@ imageExists' :: RawDiskImage -> PartTable -> RevertableProperty DebianLike UnixL imageExists' dest@(RawDiskImage img) parttable = (setup cleanup) `describe` desc where desc = "disk image exists " ++ img - parttablefile = img ++ ".parttable" + parttablefile = imageParttableFile dest setup = property' desc $ \w -> do oldparttable <- liftIO $ catchDefaultIO "" $ readFileStrict parttablefile res <- ensureProperty w $ imageExists dest (partTableSize parttable) @@ -488,6 +488,24 @@ noBootloader = pureInfoProperty "no bootloader" [NoBootloader] noBootloaderFinalized :: Finalization noBootloaderFinalized _img _mnt _loopDevs = doNothing +imageChrootNotPresent :: DiskImage d => d -> Property UnixLike +imageChrootNotPresent img = check (doesDirectoryExist dir) $ + property "destroy the chroot used to build the image" $ makeChange $ do + removeChroot dir + nukeFile $ imageParttableFile img + where + dir = imageChroot img + +imageChroot :: DiskImage d => d -> FilePath +imageChroot img = imgfile <.> "chroot" + where + RawDiskImage imgfile = rawDiskImage img + +imageParttableFile :: DiskImage d => d -> FilePath +imageParttableFile img = imgfile <.> "parttable" + where + RawDiskImage imgfile = rawDiskImage img + isChild :: FilePath -> Maybe MountPoint -> Bool isChild mntpt (Just d) | d `equalFilePath` mntpt = False -- cgit v1.2.3