summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2017-10-04 13:10:59 -0400
committerJoey Hess2017-10-04 13:10:59 -0400
commit422435f505bf0c6c0e00dc85e0bfd2860b79100e (patch)
treedc0c9ac9b7dee43628525520bd3806d468ad449e /src
parent7898079adb6caa2cb0da4384542f28bd1ce21011 (diff)
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.
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Info.hs24
-rw-r--r--src/Propellor/Property/Dns.hs6
-rw-r--r--src/Propellor/Spin.hs2
-rw-r--r--src/Propellor/Types/Dns.hs33
4 files changed, 48 insertions, 17 deletions
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