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