From 422435f505bf0c6c0e00dc85e0bfd2860b79100e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 4 Oct 2017 13:10:59 -0400 Subject: avoid propagating non-alias DNS info from container to host * When the ipv4 and ipv6 properties are used with a container, avoid propagating the address out to the host. * DnsInfo has been replaced with DnsInfoPropagated and DnsInfoUnpropagated. (API change) * Code that used fromDnsInfo . fromInfo changes to use getDnsInfo. * addDNS takes an additional Bool parameter to control whether the DNS info should propagate out of containers. (API change) This commit was sponsored by Trenton Cronholm on Patreon. --- src/Propellor/Info.hs | 24 +++++++++++++++++------- src/Propellor/Property/Dns.hs | 6 +++--- src/Propellor/Spin.hs | 2 +- src/Propellor/Types/Dns.hs | 33 +++++++++++++++++++++++++++------ 4 files changed, 48 insertions(+), 17 deletions(-) (limited to 'src') diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs index ed6c2d85..fd295aa3 100644 --- a/src/Propellor/Info.hs +++ b/src/Propellor/Info.hs @@ -128,11 +128,11 @@ getOS = fromInfoVal <$> askInfo -- if the host's IP Property matches the DNS. If the DNS is missing or -- out of date, the host will instead be contacted directly by IP address. ipv4 :: String -> Property (HasInfo + UnixLike) -ipv4 = addDNS . Address . IPv4 +ipv4 = addDNS False . Address . IPv4 -- | Indicate that a host has an AAAA record in the DNS. ipv6 :: String -> Property (HasInfo + UnixLike) -ipv6 = addDNS . Address . IPv6 +ipv6 = addDNS False . Address . IPv6 -- | Indicates another name for the host in the DNS. -- @@ -145,11 +145,21 @@ alias d = pureInfoProperty' ("alias " ++ d) $ mempty `addInfo` toAliasesInfo [d] -- A CNAME is added here, but the DNS setup code converts it to an -- IP address when that makes sense. - `addInfo` (toDnsInfo $ S.singleton $ CNAME $ AbsDomain d) - -addDNS :: Record -> Property (HasInfo + UnixLike) -addDNS r = pureInfoProperty (rdesc r) (toDnsInfo (S.singleton r)) + `addInfo` (toDnsInfoPropagated $ S.singleton $ CNAME $ AbsDomain d) + +-- | Add a DNS Record. +addDNS + :: Bool + -- ^ When used in a container, the DNS info will only + -- propagate out the the Host when this is True. + -> Record + -> Property (HasInfo + UnixLike) +addDNS prop r + | prop = pureInfoProperty (rdesc r) (toDnsInfoPropagated s) + | otherwise = pureInfoProperty (rdesc r) (toDnsInfoUnpropagated s) where + s = S.singleton r + rdesc (CNAME d) = unwords ["alias", ddesc d] rdesc (Address (IPv4 addr)) = unwords ["ipv4", addr] rdesc (Address (IPv6 addr)) = unwords ["ipv6", addr] @@ -182,7 +192,7 @@ findAlias :: [Host] -> HostName -> Maybe Host findAlias l hn = M.lookup hn (aliasMap l) getAddresses :: Info -> [IPAddr] -getAddresses = mapMaybe getIPAddr . S.toList . fromDnsInfo . fromInfo +getAddresses = mapMaybe getIPAddr . S.toList . getDnsInfo hostAddresses :: HostName -> [Host] -> [IPAddr] hostAddresses hn hosts = maybe [] (getAddresses . hostInfo) (findHost hosts hn) diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs index 889aece5..d99a76b0 100644 --- a/src/Propellor/Property/Dns.hs +++ b/src/Propellor/Property/Dns.hs @@ -468,7 +468,7 @@ genZone inzdomain hostmap zdomain soa = -- So we can just use the IPAddrs. addcnames :: Host -> [Either WarningMessage (BindDomain, Record)] addcnames h = concatMap gen $ filter (inDomain zdomain) $ - mapMaybe getCNAME $ S.toList $ fromDnsInfo $ fromInfo info + mapMaybe getCNAME $ S.toList $ getDnsInfo info where info = hostInfo h gen c = case getAddresses info of @@ -483,7 +483,7 @@ genZone inzdomain hostmap zdomain soa = where info = hostInfo h l = zip (repeat $ AbsDomain $ hostName h) - (S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (fromDnsInfo $ fromInfo info)) + (S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (getDnsInfo info)) -- Simplifies the list of hosts. Remove duplicate entries. -- Also, filter out any CHAMES where the same domain has an @@ -531,7 +531,7 @@ genSSHFP domain h = concatMap mk . concat <$> (gen =<< get) gen = liftIO . mapM genSSHFP' . M.elems . fromMaybe M.empty mk r = mapMaybe (\d -> if inDomain domain d then Just (d, r) else Nothing) (AbsDomain hostname : cnames) - cnames = mapMaybe getCNAME $ S.toList $ fromDnsInfo $ fromInfo info + cnames = mapMaybe getCNAME $ S.toList $ getDnsInfo info hostname = hostName h info = hostInfo h diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index aeaa4643..88d2b473 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -173,7 +173,7 @@ getSshTarget target hst return ip configips = map val $ mapMaybe getIPAddr $ - S.toList $ fromDnsInfo $ fromInfo $ hostInfo hst + S.toList $ getDnsInfo $ hostInfo hst -- Update the privdata, repo url, and git repo over the ssh -- connection, talking to the user's local propellor instance which is diff --git a/src/Propellor/Types/Dns.hs b/src/Propellor/Types/Dns.hs index 87756d81..513f162a 100644 --- a/src/Propellor/Types/Dns.hs +++ b/src/Propellor/Types/Dns.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleInstances #-} module Propellor.Types.Dns where @@ -36,17 +37,37 @@ toAliasesInfo l = AliasesInfo (S.fromList l) fromAliasesInfo :: AliasesInfo -> [HostName] fromAliasesInfo (AliasesInfo s) = S.toList s -newtype DnsInfo = DnsInfo { fromDnsInfo :: S.Set Record } +-- | Use this for DNS Info that should propagate from a container to a +-- host. For example, this can be used for CNAME to make aliases +-- of the containers in the host be reflected in the DNS. +newtype DnsInfoPropagated = DnsInfoPropagated + { fromDnsInfoPropagated :: S.Set Record } deriving (Show, Eq, Ord, Monoid, Typeable) -toDnsInfo :: S.Set Record -> DnsInfo -toDnsInfo = DnsInfo +toDnsInfoPropagated :: S.Set Record -> DnsInfoPropagated +toDnsInfoPropagated = DnsInfoPropagated --- | DNS Info is propagated, so that eg, aliases of a container --- are reflected in the dns for the host where it runs. -instance IsInfo DnsInfo where +instance IsInfo DnsInfoPropagated where propagateInfo _ = PropagateInfo True +-- | Use this for DNS Info that should not propagate from a container to a +-- host. For example, an IP address of a container should not influence +-- the host. +newtype DnsInfoUnpropagated = DnsInfoUnpropagated + { fromDnsInfoUnpropagated :: S.Set Record } + deriving (Show, Eq, Ord, Monoid, Typeable) + +toDnsInfoUnpropagated :: S.Set Record -> DnsInfoUnpropagated +toDnsInfoUnpropagated = DnsInfoUnpropagated + +-- | Get all DNS Info. +getDnsInfo :: Info -> S.Set Record +getDnsInfo i = fromDnsInfoUnpropagated (fromInfo i) + `S.union` fromDnsInfoPropagated (fromInfo i) + +instance IsInfo DnsInfoUnpropagated where + propagateInfo _ = PropagateInfo False + -- | Represents a bind 9 named.conf file. data NamedConf = NamedConf { confDomain :: Domain -- cgit v1.2.3