propellor

propellor config for hosts.
git clone git://git.ricketyspace.net/propellor.git
Log | Files | Refs | LICENSE

Dns.hs (6175B)


      1 {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
      2 {-# LANGUAGE FlexibleInstances #-}
      3 
      4 module Propellor.Types.Dns where
      5 
      6 import Propellor.Types.OS (HostName)
      7 import Propellor.Types.Empty
      8 import Propellor.Types.Info
      9 import Propellor.Types.ConfigurableValue
     10 import Utility.Split
     11 
     12 import Data.Word
     13 import qualified Data.Map as M
     14 import qualified Data.Set as S
     15 import qualified Data.Semigroup as Sem
     16 import Data.List
     17 import Data.Monoid
     18 import Prelude
     19 
     20 type Domain = String
     21 
     22 data IPAddr = IPv4 String | IPv6 String
     23 	deriving (Read, Show, Eq, Ord)
     24 
     25 instance ConfigurableValue IPAddr where
     26 	val (IPv4 addr) = addr
     27 	val (IPv6 addr) = addr
     28 
     29 newtype AliasesInfo = AliasesInfo (S.Set HostName)
     30 	deriving (Show, Eq, Ord, Sem.Semigroup, Monoid, Typeable)
     31 
     32 instance IsInfo AliasesInfo where
     33 	propagateInfo _ = PropagateInfo False
     34 
     35 toAliasesInfo :: [HostName] -> AliasesInfo
     36 toAliasesInfo l = AliasesInfo (S.fromList l)
     37 
     38 fromAliasesInfo :: AliasesInfo -> [HostName]
     39 fromAliasesInfo (AliasesInfo s) = S.toList s
     40 
     41 -- | Use this for DNS Info that should propagate from a container to a
     42 -- host. For example, this can be used for CNAME to make aliases
     43 -- of the containers in the host be reflected in the DNS.
     44 newtype DnsInfoPropagated = DnsInfoPropagated
     45 	{ fromDnsInfoPropagated :: S.Set Record }
     46 	deriving (Show, Eq, Ord, Sem.Semigroup, Monoid, Typeable)
     47 
     48 toDnsInfoPropagated :: S.Set Record -> DnsInfoPropagated
     49 toDnsInfoPropagated = DnsInfoPropagated
     50 
     51 instance IsInfo DnsInfoPropagated where
     52 	propagateInfo _ = PropagateInfo True
     53 
     54 -- | Use this for DNS Info that should not propagate from a container to a
     55 -- host. For example, an IP address of a container should not influence
     56 -- the host.
     57 newtype DnsInfoUnpropagated = DnsInfoUnpropagated
     58 	{ fromDnsInfoUnpropagated :: S.Set Record }
     59 	deriving (Show, Eq, Ord, Sem.Semigroup, Monoid, Typeable)
     60 
     61 toDnsInfoUnpropagated :: S.Set Record -> DnsInfoUnpropagated
     62 toDnsInfoUnpropagated = DnsInfoUnpropagated
     63 
     64 -- | Get all DNS Info.
     65 getDnsInfo :: Info -> S.Set Record
     66 getDnsInfo i = fromDnsInfoUnpropagated (fromInfo i)
     67 	`S.union` fromDnsInfoPropagated (fromInfo i)
     68 
     69 instance IsInfo DnsInfoUnpropagated where
     70 	propagateInfo _ = PropagateInfo False
     71 
     72 -- | Represents a bind 9 named.conf file.
     73 data NamedConf = NamedConf
     74 	{ confDomain :: Domain
     75 	, confDnsServerType :: DnsServerType
     76 	, confFile :: FilePath
     77 	, confMasters :: [IPAddr]
     78 	, confAllowTransfer :: [IPAddr]
     79 	, confLines :: [String]
     80 	}
     81 	deriving (Show, Eq, Ord)
     82 
     83 data DnsServerType = Master | Secondary
     84 	deriving (Show, Eq, Ord)
     85 
     86 -- | Represents a bind 9 zone file.
     87 data Zone = Zone
     88 	{ zDomain :: Domain
     89 	, zSOA :: SOA
     90 	, zHosts :: [(BindDomain, Record)]
     91 	}
     92 	deriving (Read, Show, Eq)
     93 
     94 -- | Every domain has a SOA record, which is big and complicated.
     95 data SOA = SOA
     96 	{ sDomain :: BindDomain
     97 	-- ^ Typically ns1.your.domain
     98 	, sSerial :: SerialNumber
     99 	-- ^ The most important parameter is the serial number,
    100 	-- which must increase after each change.
    101 	, sRefresh :: Integer
    102 	, sRetry :: Integer
    103 	, sExpire :: Integer
    104 	, sNegativeCacheTTL :: Integer
    105 	}
    106 	deriving (Read, Show, Eq)
    107 
    108 -- | Types of DNS records.
    109 --
    110 -- This is not a complete list, more can be added.
    111 data Record
    112 	= Address IPAddr
    113 	| CNAME BindDomain
    114 	| MX Int BindDomain
    115 	| NS BindDomain
    116 	| TXT String
    117 	| SRV Word16 Word16 Word16 BindDomain
    118 	| SSHFP Int Int String
    119 	| INCLUDE FilePath
    120 	| PTR ReverseIP
    121 	deriving (Read, Show, Eq, Ord, Typeable)
    122 
    123 -- | An in-addr.arpa record corresponding to an IPAddr.
    124 type ReverseIP = String
    125 
    126 reverseIP :: IPAddr -> ReverseIP
    127 reverseIP (IPv4 addr) = intercalate "." (reverse $ splitc '.' addr) ++ ".in-addr.arpa"
    128 reverseIP addr@(IPv6 _) = reverse (intersperse '.' $ replace ":" "" $ val $ canonicalIP addr) ++ ".ip6.arpa"
    129 
    130 -- | Converts an IP address (particularly IPv6) to canonical, fully
    131 -- expanded form.
    132 canonicalIP :: IPAddr -> IPAddr
    133 canonicalIP (IPv4 addr) = IPv4 addr
    134 canonicalIP (IPv6 addr) = IPv6 $ intercalate ":" $ map canonicalGroup $ splitc ':' $ replaceImplicitGroups addr
    135   where
    136 	canonicalGroup g
    137 		| l <= 4    = replicate (4 - l) '0' ++ g
    138 		| otherwise = error $ "IPv6 group " ++ g ++ "as more than 4 hex digits"
    139 	  where
    140 		l = length g
    141 	emptyGroups n = iterate (++ ":") "" !! n
    142 	numberOfImplicitGroups a = 8 - length (splitc ':' $ replace "::" "" a)
    143 	replaceImplicitGroups a = concat $ aux $ split "::" a
    144 	  where
    145 		aux [] = []
    146 		aux (x : xs) = x : emptyGroups (numberOfImplicitGroups a) : xs
    147 
    148 getIPAddr :: Record -> Maybe IPAddr
    149 getIPAddr (Address addr) = Just addr
    150 getIPAddr _ = Nothing
    151 
    152 getCNAME :: Record -> Maybe BindDomain
    153 getCNAME (CNAME d) = Just d
    154 getCNAME _ = Nothing
    155 
    156 getNS :: Record -> Maybe BindDomain
    157 getNS (NS d) = Just d
    158 getNS _ = Nothing
    159 
    160 -- | Bind serial numbers are unsigned, 32 bit integers.
    161 type SerialNumber = Word32
    162 
    163 -- | Domains in the zone file must end with a period if they are absolute.
    164 --
    165 -- Let's use a type to keep absolute domains straight from relative
    166 -- domains.
    167 --
    168 -- The RootDomain refers to the top level of the domain, so can be used
    169 -- to add nameservers, MX's, etc to a domain.
    170 data BindDomain = RelDomain Domain | AbsDomain Domain | RootDomain
    171 	deriving (Read, Show, Eq, Ord)
    172 
    173 domainHostName :: BindDomain -> Maybe HostName
    174 domainHostName (RelDomain d) = Just d
    175 domainHostName (AbsDomain d) = Just d
    176 domainHostName RootDomain = Nothing
    177 
    178 newtype NamedConfMap = NamedConfMap (M.Map Domain NamedConf)
    179 	deriving (Eq, Ord, Show, Typeable)
    180 
    181 instance IsInfo NamedConfMap where
    182 	propagateInfo _ = PropagateInfo False
    183 
    184 -- | Adding a Master NamedConf stanza for a particulr domain always
    185 -- overrides an existing Secondary stanza for that domain, while a
    186 -- Secondary stanza is only added when there is no existing Master stanza.
    187 instance Sem.Semigroup NamedConfMap where
    188 	NamedConfMap old <> NamedConfMap new = NamedConfMap $
    189 		M.unionWith combiner new old
    190 	  where
    191 		combiner n o = case (confDnsServerType n, confDnsServerType o) of
    192 			(Secondary, Master) -> o
    193 			_  -> n
    194 
    195 instance Monoid NamedConfMap where
    196 	mempty = NamedConfMap M.empty
    197 	mappend = (Sem.<>)
    198 
    199 instance Empty NamedConfMap where
    200 	isEmpty (NamedConfMap m) = isEmpty m
    201 
    202 fromNamedConfMap :: NamedConfMap -> M.Map Domain NamedConf
    203 fromNamedConfMap (NamedConfMap m) = m