fix diskimage finalization bug

  * Fix bug when using setContainerProps with a chroot that prevented
    properties added to a chroot that way from being seen when propellor
    was running inside the chroot. This affected disk image creation, and
    possibly other things that use chroots.

The problem was, propagateChrootInfo was being passed the initial
version of the Chroot, but then the Chroot got more properties
added, and so those were not recorded in the _chroot info.

Fix was simply to make InfoPropagator be passed the Chroot as an
additional parameter, so Chroot.provisioned' can pass in the final
Chroot to it.

3 files changed, 11 insertions, 9 deletions

diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 920a46d4..7738d97e 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -46,7 +46,9 @@ data Chroot where
 instance IsContainer Chroot where
 	containerProperties (Chroot _ _ _ h) = containerProperties h
 	containerInfo (Chroot _ _ _ h) = containerInfo h
-	setContainerProperties (Chroot loc b p h) ps = Chroot loc b p (setContainerProperties h ps)
+	setContainerProperties (Chroot loc b p h) ps =
+		let h' = setContainerProperties h ps
+		in Chroot loc b p h'
 
 chrootSystem :: Chroot -> Maybe System
 chrootSystem = fromInfoVal . fromInfo . containerInfo
@@ -118,7 +120,7 @@ debootstrapped conf = bootstrapped (Debootstrapped conf)
 bootstrapped :: ChrootBootstrapper b => b -> FilePath -> Props metatypes -> Chroot
 bootstrapped bootstrapper location ps = c
   where
-	c = Chroot location bootstrapper (propagateChrootInfo c) (host location ps)
+	c = Chroot location bootstrapper propagateChrootInfo (host location ps)
 
 -- | Ensures that the chroot exists and is provisioned according to its
 -- properties.
@@ -134,7 +136,7 @@ provisioned'
 	-> Bool
 	-> RevertableProperty (HasInfo + Linux) Linux
 provisioned' c@(Chroot loc bootstrapper infopropigator _) systemdonly =
-	(infopropigator normalContainerInfo $ setup `describe` chrootDesc c "exists")
+	(infopropigator c normalContainerInfo $ setup `describe` chrootDesc c "exists")
 		<!>
 	(teardown `describe` chrootDesc c "removed")
   where
@@ -153,9 +155,9 @@ provisioned' c@(Chroot loc bootstrapper infopropigator _) systemdonly =
 		property ("removed " ++ loc) $
 			makeChange (removeChroot loc)
 
-type InfoPropagator = (PropagateInfo -> Bool) -> Property Linux -> Property (HasInfo + Linux)
+type InfoPropagator = Chroot -> (PropagateInfo -> Bool) -> Property Linux -> Property (HasInfo + Linux)
 
-propagateChrootInfo :: Chroot -> InfoPropagator
+propagateChrootInfo :: InfoPropagator
 propagateChrootInfo c@(Chroot location _ _ _) pinfo p =
 	propagateContainer location c pinfo $
 		p `setInfoProperty` chrootInfo c
@@ -302,12 +304,12 @@ hostChroot :: ChrootBootstrapper bootstrapper => Host -> bootstrapper -> FilePat
 hostChroot h bootstrapper d = chroot
   where
 	chroot = Chroot d bootstrapper pinfo h
-	pinfo = propagateHostChrootInfo h chroot
+	pinfo = propagateHostChrootInfo h
 
 -- This is different than propagateChrootInfo in that Info using
 -- HostContext is not made to use the name of the chroot as its context,
 -- but instead uses the hostname of the Host.
-propagateHostChrootInfo :: Host -> Chroot -> InfoPropagator
+propagateHostChrootInfo :: Host -> InfoPropagator
 propagateHostChrootInfo h c pinfo p =
 	propagateContainer (hostName h) c pinfo $
 		p `setInfoProperty` chrootInfo c
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 06d0694e..90b7010b 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -140,7 +140,7 @@ imageBuilt' rebuild img mkchroot tabletype final partspec =
 			& cachesCleaned
 	-- Only propagate privdata Info from this chroot, nothing else.
 	propprivdataonly (Chroot.Chroot d b ip h) =
-		Chroot.Chroot d b (const $ ip onlyPrivData) h
+		Chroot.Chroot d b (\c _ -> ip c onlyPrivData) h
 
 -- | This property is automatically added to the chroot when building a
 -- disk image. It cleans any caches of information that can be omitted;
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 8f9c3beb..7c40bd16 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -281,7 +281,7 @@ nspawned c@(Container name (Chroot.Chroot loc builder _ _) h) =
 			<!>
 		doNothing
 
-	chroot = Chroot.Chroot loc builder (Chroot.propagateChrootInfo chroot) h
+	chroot = Chroot.Chroot loc builder Chroot.propagateChrootInfo h
 
 -- | Sets up the service file for the container, and then starts
 -- it running.