From ecc275cfeb9dc2c18abe525f3a93aad7614e1a0c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 23 Jul 2014 12:23:44 -0400 Subject: propellor spin --- src/Propellor/Info.hs | 19 +++++++++++++++---- src/Propellor/Types/Info.hs | 4 +++- 2 files changed, 18 insertions(+), 5 deletions(-) diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs index 00f1b0e9..080a971e 100644 --- a/src/Propellor/Info.hs +++ b/src/Propellor/Info.hs @@ -43,11 +43,15 @@ ipv6 = addDNS . Address . IPv6 -- problems with CNAMEs, and also means that when multiple hosts have the -- same alias, a DNS round-robin is automatically set up. alias :: Domain -> Property -alias = addDNS . CNAME . AbsDomain +alias d = pureInfoProperty ("alias " ++ d) $ mempty + { _aliases = S.singleton d + -- A CNAME is added here, but the DNS setup code converts it to an + -- IP address when that makes sense. + , _dns = S.singleton $ CNAME $ AbsDomain d + } addDNS :: Record -> Property -addDNS r = pureInfoProperty (rdesc r) $ - mempty { _dns = S.singleton r } +addDNS r = pureInfoProperty (rdesc r) $ mempty { _dns = S.singleton r } where rdesc (CNAME d) = unwords ["alias", ddesc d] rdesc (Address (IPv4 addr)) = unwords ["ipv4", addr] @@ -71,8 +75,15 @@ getSshPubKey = askInfo _sshPubKey hostMap :: [Host] -> M.Map HostName Host hostMap l = M.fromList $ zip (map hostName l) l +aliasMap :: [Host] -> M.Map HostName Host +aliasMap l = M.fromList $ concat $ map (flip zip l) $ + map (S.toList . _aliases . hostInfo) l + findHost :: [Host] -> HostName -> Maybe Host -findHost l hn = M.lookup hn (hostMap l) +findHost l hn = maybe (findAlias l hn) Just (M.lookup hn (hostMap l)) + +findAlias :: [Host] -> HostName -> Maybe Host +findAlias l hn = M.lookup hn (aliasMap l) getAddresses :: Info -> [IPAddr] getAddresses = mapMaybe getIPAddr . S.toList . _dns diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs index 8856e06f..de072aa0 100644 --- a/src/Propellor/Types/Info.hs +++ b/src/Propellor/Types/Info.hs @@ -12,6 +12,7 @@ data Info = Info { _os :: Val System , _privDataFields :: S.Set (PrivDataField, Context) , _sshPubKey :: Val String + , _aliases :: S.Set HostName , _dns :: S.Set Dns.Record , _namedconf :: Dns.NamedConfMap , _dockerinfo :: DockerInfo @@ -19,11 +20,12 @@ data Info = Info deriving (Eq, Show) instance Monoid Info where - mempty = Info mempty mempty mempty mempty mempty mempty + mempty = Info mempty mempty mempty mempty mempty mempty mempty mappend old new = Info { _os = _os old <> _os new , _privDataFields = _privDataFields old <> _privDataFields new , _sshPubKey = _sshPubKey old <> _sshPubKey new + , _aliases = _aliases old <> _aliases new , _dns = _dns old <> _dns new , _namedconf = _namedconf old <> _namedconf new , _dockerinfo = _dockerinfo old <> _dockerinfo new -- cgit v1.2.3