cadey
/
propellor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

propellor spin

This commit is contained in:
Joey Hess 2014-07-23 12:23:44 -04:00
parent d393b8fc53
commit ecc275cfeb
Failed to extract signature
2 changed files with 18 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/Propellor/Info.hs
View File

@ -43,11 +43,15 @@ ipv6 = addDNS . Address . IPv6
-- problems with CNAMEs, and also means that when multiple hosts have the -- problems with CNAMEs, and also means that when multiple hosts have the
-- same alias, a DNS round-robin is automatically set up. -- same alias, a DNS round-robin is automatically set up.
alias :: Domain -> Property 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 :: Record -> Property
addDNS r = pureInfoProperty (rdesc r) $ addDNS r = pureInfoProperty (rdesc r) $ mempty { _dns = S.singleton r }
mempty { _dns = S.singleton r }
where where
rdesc (CNAME d) = unwords ["alias", ddesc d] rdesc (CNAME d) = unwords ["alias", ddesc d]
rdesc (Address (IPv4 addr)) = unwords ["ipv4", addr] rdesc (Address (IPv4 addr)) = unwords ["ipv4", addr]
@ -71,8 +75,15 @@ getSshPubKey = askInfo _sshPubKey
hostMap :: [Host] -> M.Map HostName Host hostMap :: [Host] -> M.Map HostName Host
hostMap l = M.fromList $ zip (map hostName l) l 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 :: [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 :: Info -> [IPAddr]
getAddresses = mapMaybe getIPAddr . S.toList . _dns getAddresses = mapMaybe getIPAddr . S.toList . _dns

4
src/Propellor/Types/Info.hs
View File

@ -12,6 +12,7 @@ data Info = Info
{ _os :: Val System { _os :: Val System
, _privDataFields :: S.Set (PrivDataField, Context) , _privDataFields :: S.Set (PrivDataField, Context)
, _sshPubKey :: Val String , _sshPubKey :: Val String
, _aliases :: S.Set HostName
, _dns :: S.Set Dns.Record , _dns :: S.Set Dns.Record
, _namedconf :: Dns.NamedConfMap , _namedconf :: Dns.NamedConfMap
, _dockerinfo :: DockerInfo , _dockerinfo :: DockerInfo
@ -19,11 +20,12 @@ data Info = Info
deriving (Eq, Show) deriving (Eq, Show)
instance Monoid Info where 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 mappend old new = Info
{ _os = _os old <> _os new { _os = _os old <> _os new
, _privDataFields = _privDataFields old <> _privDataFields new , _privDataFields = _privDataFields old <> _privDataFields new
, _sshPubKey = _sshPubKey old <> _sshPubKey new , _sshPubKey = _sshPubKey old <> _sshPubKey new
, _aliases = _aliases old <> _aliases new
, _dns = _dns old <> _dns new , _dns = _dns old <> _dns new
, _namedconf = _namedconf old <> _namedconf new , _namedconf = _namedconf old <> _namedconf new
, _dockerinfo = _dockerinfo old <> _dockerinfo new , _dockerinfo = _dockerinfo old <> _dockerinfo new