summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
authorSean Whitton2018-11-10 12:53:14 -0700
committerSean Whitton2018-11-10 16:15:35 -0700
commit979f1459cf61886ab24302c8a11637965b7c77aa (patch)
tree78dacd827f3fe9660526d331c6be7819189d245c /src/Propellor
parent229d439829bcb398a9a2414678e474cf1f3ccd1a (diff)
add DiskImage.imageChrootNotPresent
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/Property/DiskImage.hs24
1 files changed, 21 insertions, 3 deletions
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