From 9a54ba471986b994f10ad332f27639059c18e7e1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 11 Mar 2017 16:52:00 -0400 Subject: don't propagate DNS info from DiskImage chroots * DiskImage building properties used to propagate DNS info out from the chroot used to build the disk image to the Host. That is no longer done, since that chroot only exists as a side effect of the disk image creation and servers will not be running in it. * The IsInfo types class's propagateInfo function changed to use a PropagateInfo data type. (API change) This is particularly important when using hostChroot, since the host could well have DNS settings then. This commit was sponsored by Ole-Morten Duesund on Patreon. --- src/Propellor/Property/Chroot.hs | 13 +++++++------ src/Propellor/Property/Conductor.hs | 6 +++--- src/Propellor/Property/DiskImage.hs | 5 ++++- src/Propellor/Property/Docker.hs | 5 +++-- src/Propellor/Property/FreeBSD/Pkg.hs | 5 +++-- src/Propellor/Property/FreeBSD/Poudriere.hs | 2 +- src/Propellor/Property/Ssh.hs | 4 ++-- 7 files changed, 23 insertions(+), 17 deletions(-) (limited to 'src/Propellor/Property') 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 -- cgit v1.2.3