summaryrefslogtreecommitdiff
path: root/src/Propellor/Property
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property')
-rw-r--r--src/Propellor/Property/Chroot.hs13
-rw-r--r--src/Propellor/Property/Conductor.hs6
-rw-r--r--src/Propellor/Property/DiskImage.hs5
-rw-r--r--src/Propellor/Property/Docker.hs5
-rw-r--r--src/Propellor/Property/FreeBSD/Pkg.hs5
-rw-r--r--src/Propellor/Property/FreeBSD/Poudriere.hs2
-rw-r--r--src/Propellor/Property/Ssh.hs4
7 files changed, 23 insertions, 17 deletions
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 4b9b48e1..8f18d724 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -135,7 +135,7 @@ provisioned'
-> Bool
-> RevertableProperty (HasInfo + Linux) Linux
provisioned' c@(Chroot loc bootstrapper infopropigator _) systemdonly =
- (infopropigator $ setup `describe` chrootDesc c "exists")
+ (infopropigator normalContainerInfo $ setup `describe` chrootDesc c "exists")
<!>
(teardown `describe` chrootDesc c "removed")
where
@@ -154,11 +154,12 @@ provisioned' c@(Chroot loc bootstrapper infopropigator _) systemdonly =
property ("removed " ++ loc) $
makeChange (removeChroot loc)
-type InfoPropagator = Property Linux -> Property (HasInfo + Linux)
+type InfoPropagator = (PropagateInfo -> Bool) -> Property Linux -> Property (HasInfo + Linux)
propagateChrootInfo :: Chroot -> InfoPropagator
-propagateChrootInfo c@(Chroot location _ _ _) p = propagateContainer location c $
- p `setInfoProperty` chrootInfo c
+propagateChrootInfo c@(Chroot location _ _ _) pinfo p =
+ propagateContainer location c pinfo $
+ p `setInfoProperty` chrootInfo c
chrootInfo :: Chroot -> Info
chrootInfo (Chroot loc _ _ h) = mempty `addInfo`
@@ -308,6 +309,6 @@ hostChroot h bootstrapper d = chroot
-- 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 h c p =
- propagateContainer (hostName h) c $
+propagateHostChrootInfo h c pinfo p =
+ propagateContainer (hostName h) c pinfo $
p `setInfoProperty` chrootInfo c
diff --git a/src/Propellor/Property/Conductor.hs b/src/Propellor/Property/Conductor.hs
index 8aa18d20..cfeb5aa7 100644
--- a/src/Propellor/Property/Conductor.hs
+++ b/src/Propellor/Property/Conductor.hs
@@ -323,15 +323,15 @@ instance Show NotConductorFor where
show (NotConductorFor l) = "NotConductorFor " ++ show (map hostName l)
instance IsInfo ConductorFor where
- propagateInfo _ = False
+ propagateInfo _ = PropagateInfo False
instance IsInfo NotConductorFor where
- propagateInfo _ = False
+ propagateInfo _ = PropagateInfo False
-- Added to Info when a host has been orchestrated.
newtype Orchestrated = Orchestrated Any
deriving (Typeable, Monoid, Show)
instance IsInfo Orchestrated where
- propagateInfo _ = False
+ propagateInfo _ = PropagateInfo False
isOrchestrated :: Orchestrated -> Bool
isOrchestrated (Orchestrated v) = getAny v
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index c7868c47..06d0694e 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -130,7 +130,7 @@ imageBuilt' rebuild img mkchroot tabletype final partspec =
| otherwise = doNothing
chrootdir = img ++ ".chroot"
chroot =
- let c = mkchroot chrootdir
+ let c = propprivdataonly $ mkchroot chrootdir
in setContainerProps c $ containerProps c
-- Before ensuring any other properties of the chroot,
-- avoid starting services. Reverted by imageFinalized.
@@ -138,6 +138,9 @@ imageBuilt' rebuild img mkchroot tabletype final partspec =
-- First stage finalization.
& fst final
& 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
-- | 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/Docker.hs b/src/Propellor/Property/Docker.hs
index d2b2ee35..1080418b 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -184,8 +184,9 @@ imagePulled ctr = pulled `describe` msg
image = getImageName ctr
propagateContainerInfo :: Container -> Property (HasInfo + Linux) -> Property (HasInfo + Linux)
-propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr $
- p `addInfoProperty` dockerinfo
+propagateContainerInfo ctr@(Container _ h) p =
+ propagateContainer cn ctr normalContainerInfo $
+ p `addInfoProperty` dockerinfo
where
dockerinfo = dockerInfo $
mempty { _dockerContainers = M.singleton cn h }
diff --git a/src/Propellor/Property/FreeBSD/Pkg.hs b/src/Propellor/Property/FreeBSD/Pkg.hs
index 704c1db9..77bf5768 100644
--- a/src/Propellor/Property/FreeBSD/Pkg.hs
+++ b/src/Propellor/Property/FreeBSD/Pkg.hs
@@ -39,7 +39,7 @@ pkgCmd cmd args =
newtype PkgUpdate = PkgUpdate String
deriving (Typeable, Monoid, Show)
instance IsInfo PkgUpdate where
- propagateInfo _ = False
+ propagateInfo _ = PropagateInfo False
pkgUpdated :: PkgUpdate -> Bool
pkgUpdated (PkgUpdate _) = True
@@ -55,8 +55,9 @@ update =
newtype PkgUpgrade = PkgUpgrade String
deriving (Typeable, Monoid, Show)
+
instance IsInfo PkgUpgrade where
- propagateInfo _ = False
+ propagateInfo _ = PropagateInfo False
pkgUpgraded :: PkgUpgrade -> Bool
pkgUpgraded (PkgUpgrade _) = True
diff --git a/src/Propellor/Property/FreeBSD/Poudriere.hs b/src/Propellor/Property/FreeBSD/Poudriere.hs
index e6ddea16..378c5530 100644
--- a/src/Propellor/Property/FreeBSD/Poudriere.hs
+++ b/src/Propellor/Property/FreeBSD/Poudriere.hs
@@ -21,7 +21,7 @@ newtype PoudriereConfigured = PoudriereConfigured String
deriving (Typeable, Monoid, Show)
instance IsInfo PoudriereConfigured where
- propagateInfo _ = False
+ propagateInfo _ = PropagateInfo False
poudriereConfigured :: PoudriereConfigured -> Bool
poudriereConfigured (PoudriereConfigured _) = True
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 828601b8..fd89f97a 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -227,7 +227,7 @@ newtype HostKeyInfo = HostKeyInfo
deriving (Eq, Ord, Typeable, Show)
instance IsInfo HostKeyInfo where
- propagateInfo _ = False
+ propagateInfo _ = PropagateInfo False
instance Monoid HostKeyInfo where
mempty = HostKeyInfo M.empty
@@ -248,7 +248,7 @@ newtype UserKeyInfo = UserKeyInfo
deriving (Eq, Ord, Typeable, Show)
instance IsInfo UserKeyInfo where
- propagateInfo _ = False
+ propagateInfo _ = PropagateInfo False
instance Monoid UserKeyInfo where
mempty = UserKeyInfo M.empty