From 804622719b8a348bfdd32f427502e0529d50a8ed Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 1 Sep 2015 11:24:02 -0700
Subject: removal of chroot on disk image rebuild

---
 src/Propellor/Property/Chroot/Util.hs | 12 ++++++++++++
 src/Propellor/Property/Debootstrap.hs | 11 ++---------
 src/Propellor/Property/DiskImage.hs   |  7 +++++++
 3 files changed, 21 insertions(+), 9 deletions(-)

(limited to 'src')

diff --git a/src/Propellor/Property/Chroot/Util.hs b/src/Propellor/Property/Chroot/Util.hs
index 382fbab7..73cf094a 100644
--- a/src/Propellor/Property/Chroot/Util.hs
+++ b/src/Propellor/Property/Chroot/Util.hs
@@ -1,7 +1,11 @@
 module Propellor.Property.Chroot.Util where
 
+import Propellor.Property.Mount
+
 import Utility.Env
 import Control.Applicative
+import Control.Monad
+import System.Directory
 
 -- When chrooting, it's useful to ensure that PATH has all the standard
 -- directories in it. This adds those directories to whatever PATH is
@@ -14,3 +18,11 @@ standardPathEnv = do
 
 stdPATH :: String
 stdPATH = "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin"
+
+-- Removes the contents of a chroot. First, unmounts any filesystems
+-- mounted within it.
+removeChroot :: FilePath -> IO ()
+removeChroot c = do
+	submnts <- mountPointsBelow c
+	forM_ submnts umountLazy
+	removeDirectoryRecursive c
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 8d974eba..a46451ef 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -13,7 +13,6 @@ module Propellor.Property.Debootstrap (
 import Propellor
 import qualified Propellor.Property.Apt as Apt
 import Propellor.Property.Chroot.Util
-import Propellor.Property.Mount
 import Utility.Path
 import Utility.FileMode
 
@@ -61,7 +60,7 @@ built target system config = built' (toProp installed) target system config <!>
 	teardown = check (not <$> unpopulated target) teardownprop
 	
 	teardownprop = property ("removed debootstrapped " ++ target) $
-		makeChange (removetarget target)
+		makeChange (removeChroot target)
 
 built' :: (Combines (Property NoInfo) (Property i)) => Property i -> FilePath -> System -> DebootstrapConfig -> Property (CInfo NoInfo i)
 built' installprop target system@(System _ arch) config = 
@@ -96,7 +95,7 @@ built' installprop target system@(System _ arch) config =
 	-- recover by deleting it and trying again.
 	ispartial = ifM (doesDirectoryExist (target </> "debootstrap"))
 		( do
-			removetarget target
+			removeChroot target
 			return True
 		, return False
 		)
@@ -104,12 +103,6 @@ built' installprop target system@(System _ arch) config =
 unpopulated :: FilePath -> IO Bool
 unpopulated d = null <$> catchDefaultIO [] (dirContents d)	
 
-removetarget :: FilePath -> IO ()
-removetarget target = do
-	submnts <- mountPointsBelow target
-	forM_ submnts umountLazy
-	removeDirectoryRecursive target
-
 extractSuite :: System -> Maybe String
 extractSuite (System (Debian s) _) = Just $ Apt.showSuite s
 extractSuite (System (Ubuntu r) _) = Just r
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index f649b7bb..54fa8945 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -15,6 +15,7 @@ module Propellor.Property.DiskImage (
 
 import Propellor
 import Propellor.Property.Chroot (Chroot)
+import Propellor.Property.Chroot.Util (removeChroot)
 import qualified Propellor.Property.Chroot as Chroot
 import Propellor.Property.Parted
 import qualified Propellor.Property.Grub as Grub
@@ -56,6 +57,7 @@ built' :: Bool -> FilePath -> (FilePath -> Chroot) -> MkPartTable -> DiskImageFi
 built' rebuild img mkchroot mkparttable final = 
 	(mkimg <!> unmkimg) 
 		`requires` Chroot.provisioned (mkchroot chrootdir)
+		`requires` (handlerebuild <!> doNothing)
 		`describe` desc
   where
 	desc = "built disk image " ++ img
@@ -70,6 +72,11 @@ built' rebuild img mkchroot mkparttable final =
 			exists img disksz
 				`before`
 			partitioned YesReallyDeleteDiskContents img t
+	handlerebuild
+		| rebuild = property desc $ do
+			liftIO $ removeChroot chrootdir
+			return MadeChange
+		| otherwise = doNothing
 
 -- | Ensures that a disk image file of the specified size exists.
 -- 
-- 
cgit v1.3-2-g0d8e