diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Propellor/Property/Chroot.hs | 16 | ||||
| -rw-r--r-- | src/Propellor/Property/DiskImage.hs | 2 | ||||
| -rw-r--r-- | src/Propellor/Property/Systemd.hs | 2 |
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. |