From f49dd3692708ea8e0adbaa701f562de264f40153 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 2 Sep 2015 14:09:44 -0700 Subject: cleanup --- src/Propellor/Property/DiskImage.hs | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index a74f3ac8..59baa8d1 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -75,7 +75,7 @@ imageBuilt' rebuild img mkchroot mkparttable final = -- TODO fst final -- TODO chroot topevel directory perm fixup `requires` Chroot.provisioned (mkchroot chrootdir) - `requires` (handlerebuild doNothing) + `requires` (cleanrebuild doNothing) `describe` desc where desc = "built disk image " ++ img @@ -85,7 +85,7 @@ imageBuilt' rebuild img mkchroot mkparttable final = -- unmount helper filesystems such as proc from the chroot -- before getting sizes liftIO $ unmountBelow chrootdir - szm <- liftIO $ M.mapKeys tosysdir . M.map toPartSize + szm <- liftIO $ M.mapKeys (toSysDir chrootdir) . M.map toPartSize <$> dirSizes chrootdir -- tie the knot! -- TODO when /boot is in part table, size of / @@ -96,16 +96,12 @@ imageBuilt' rebuild img mkchroot mkparttable final = imageExists img (partTableSize t) `before` partitioned YesReallyDeleteDiskContents img t - handlerebuild + cleanrebuild | rebuild = property desc $ do liftIO $ removeChroot chrootdir return MadeChange | otherwise = doNothing - tosysdir d = case makeRelative chrootdir d of - "." -> "/" - sysdir -> "/" ++ sysdir - -- | Ensures that a disk image file of the specified size exists. -- -- If the file doesn't exist, or is too small, creates a new one, full of 0's. @@ -144,6 +140,13 @@ dirSizes top = go M.empty top [top] else go (M.insertWith (+) dir sz m) dir is subdirof parent i = not (i `equalFilePath` parent) && takeDirectory i `equalFilePath` parent +-- | From a location in a chroot (eg, /tmp/chroot/usr) to +-- the corresponding location inside (eg, /usr). +toSysDir :: FilePath -> FilePath -> FilePath +toSysDir chrootdir d = case makeRelative chrootdir d of + "." -> "/" + sysdir -> "/" ++ sysdir + -- | Where a partition is mounted. Use Nothing for eg, LinuxSwap. type MountPoint = Maybe FilePath -- cgit v1.2.3