add dns records to Attr
This commit is contained in:
parent
2b9ee5b29b
commit
39d697ca78
|
@ -4,6 +4,7 @@ module Propellor.Attr where
|
|||
|
||||
import Propellor.Types
|
||||
import Propellor.Types.Attr
|
||||
import Propellor.Types.Dns
|
||||
|
||||
import "mtl" Control.Monad.Reader
|
||||
import qualified Data.Set as S
|
||||
|
@ -28,15 +29,16 @@ getOS :: Propellor (Maybe System)
|
|||
getOS = asks _os
|
||||
|
||||
cname :: Domain -> Property
|
||||
cname domain = pureAttrProperty ("cname " ++ domain) (addCName domain)
|
||||
cname domain = pureAttrProperty ("cname " ++ domain)
|
||||
(addDNS $ CNAME $ AbsDomain domain)
|
||||
|
||||
cnameFor :: Domain -> (Domain -> Property) -> Property
|
||||
cnameFor domain mkp =
|
||||
let p = mkp domain
|
||||
in p { propertyAttr = propertyAttr p . addCName domain }
|
||||
in p { propertyAttr = propertyAttr p . addDNS (CNAME $ AbsDomain domain) }
|
||||
|
||||
addCName :: HostName -> SetAttr
|
||||
addCName domain d = d { _cnames = S.insert domain (_cnames d) }
|
||||
addDNS :: Record -> SetAttr
|
||||
addDNS record d = d { _dns = S.insert record (_dns d) }
|
||||
|
||||
sshPubKey :: String -> Property
|
||||
sshPubKey k = pureAttrProperty ("ssh pubkey known") $
|
||||
|
|
|
@ -1,6 +1,18 @@
|
|||
module Propellor.Property.Dns where
|
||||
module Propellor.Property.Dns (
|
||||
module Propellor.Types.Dns,
|
||||
secondary,
|
||||
servingZones,
|
||||
mkSOA,
|
||||
nextSerialNumber,
|
||||
incrSerialNumber,
|
||||
currentSerialNumber,
|
||||
writeZoneFile,
|
||||
genZoneFile,
|
||||
genSOA,
|
||||
) where
|
||||
|
||||
import Propellor
|
||||
import Propellor.Types.Dns
|
||||
import Propellor.Property.File
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
import qualified Propellor.Property.Service as Service
|
||||
|
@ -8,48 +20,31 @@ import Utility.Applicative
|
|||
|
||||
import Data.List
|
||||
import Data.Time.Clock.POSIX
|
||||
import Data.Time.Format
|
||||
import Foreign.C.Types
|
||||
|
||||
namedconf :: FilePath
|
||||
namedconf = "/etc/bind/named.conf.local"
|
||||
|
||||
data NamedConf = NamedConf
|
||||
{ zdomain :: Domain
|
||||
, ztype :: Type
|
||||
, zfile :: FilePath
|
||||
, zmasters :: [IPAddr]
|
||||
, zconfiglines :: [String]
|
||||
}
|
||||
|
||||
zoneDesc :: NamedConf -> String
|
||||
zoneDesc z = zdomain z ++ " (" ++ show (ztype z) ++ ")"
|
||||
|
||||
type IPAddr = String
|
||||
|
||||
type Domain = String
|
||||
|
||||
data Type = Master | Secondary
|
||||
deriving (Show, Eq)
|
||||
zoneDesc z = confDomain z ++ " (" ++ show (confType z) ++ ")"
|
||||
|
||||
secondary :: Domain -> [IPAddr] -> NamedConf
|
||||
secondary domain masters = NamedConf
|
||||
{ zdomain = domain
|
||||
, ztype = Secondary
|
||||
, zfile = "db." ++ domain
|
||||
, zmasters = masters
|
||||
, zconfiglines = ["allow-transfer { }"]
|
||||
{ confDomain = domain
|
||||
, confType = Secondary
|
||||
, confFile = "db." ++ domain
|
||||
, confMasters = masters
|
||||
, confLines = ["allow-transfer { }"]
|
||||
}
|
||||
|
||||
zoneStanza :: NamedConf -> [Line]
|
||||
zoneStanza z =
|
||||
confStanza :: NamedConf -> [Line]
|
||||
confStanza c =
|
||||
[ "// automatically generated by propellor"
|
||||
, "zone \"" ++ zdomain z ++ "\" {"
|
||||
, cfgline "type" (if ztype z == Master then "master" else "slave")
|
||||
, cfgline "file" ("\"" ++ zfile z ++ "\"")
|
||||
, "zone \"" ++ confDomain c ++ "\" {"
|
||||
, cfgline "type" (if confType c == Master then "master" else "slave")
|
||||
, cfgline "file" ("\"" ++ confFile c ++ "\"")
|
||||
] ++
|
||||
(if null (zmasters z) then [] else mastersblock) ++
|
||||
(map (\l -> "\t" ++ l ++ ";") (zconfiglines z)) ++
|
||||
(if null (confMasters c) then [] else mastersblock) ++
|
||||
(map (\l -> "\t" ++ l ++ ";") (confLines c)) ++
|
||||
[ "};"
|
||||
, ""
|
||||
]
|
||||
|
@ -57,40 +52,17 @@ zoneStanza z =
|
|||
cfgline f v = "\t" ++ f ++ " " ++ v ++ ";"
|
||||
mastersblock =
|
||||
[ "\tmasters {" ] ++
|
||||
(map (\ip -> "\t\t" ++ ip ++ ";") (zmasters z)) ++
|
||||
(map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") (confMasters c)) ++
|
||||
[ "\t};" ]
|
||||
|
||||
-- | Rewrites the whole named.conf.local file to serve the specificed
|
||||
-- zones.
|
||||
zones :: [NamedConf] -> Property
|
||||
zones zs = hasContent namedconf (concatMap zoneStanza zs)
|
||||
servingZones :: [NamedConf] -> Property
|
||||
servingZones zs = hasContent namedconf (concatMap confStanza zs)
|
||||
`describe` ("dns server for zones: " ++ unwords (map zoneDesc zs))
|
||||
`requires` Apt.serviceInstalledRunning "bind9"
|
||||
`onChange` Service.reloaded "bind9"
|
||||
|
||||
-- | Represents a bind 9 zone file.
|
||||
data Zone = Zone
|
||||
{ zSOA :: SOA
|
||||
, zHosts :: [(HostName, 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
|
||||
, sTTL :: Integer
|
||||
, sRecord :: [Record]
|
||||
-- ^ Records for the root of the domain. Typically NS, A, TXT
|
||||
}
|
||||
deriving (Read, Show, Eq)
|
||||
|
||||
-- | Generates a SOA with some fairly sane numbers in it.
|
||||
mkSOA :: Domain -> [Record] -> SOA
|
||||
mkSOA d rs = SOA
|
||||
|
@ -105,49 +77,22 @@ mkSOA d rs = SOA
|
|||
where
|
||||
hours n = n * 60 * 60
|
||||
|
||||
-- | Types of DNS records.
|
||||
--
|
||||
-- This is not a complete list, more can be added.
|
||||
data Record
|
||||
= A Ipv4
|
||||
| AAAA Ipv6
|
||||
| CNAME BindDomain
|
||||
| MX Int BindDomain
|
||||
| NS BindDomain
|
||||
| TXT String
|
||||
deriving (Read, Show, Eq)
|
||||
|
||||
type Ipv4 = String
|
||||
type Ipv6 = String
|
||||
|
||||
-- | Bind serial numbers are unsigned, 32 bit integers.
|
||||
type SerialNumber = CInt
|
||||
|
||||
-- | 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 SOADomain refers to the root SOA record.
|
||||
data BindDomain = RelDomain Domain | AbsDomain Domain | SOADomain
|
||||
deriving (Read, Show, Eq)
|
||||
|
||||
dValue :: BindDomain -> String
|
||||
dValue (RelDomain d) = d
|
||||
dValue (AbsDomain d) = d ++ "."
|
||||
dValue (SOADomain) = "@"
|
||||
|
||||
rField :: Record -> String
|
||||
rField (A _) = "A"
|
||||
rField (AAAA _) = "AAAA"
|
||||
rField (Address (IPv4 _)) = "A"
|
||||
rField (Address (IPv6 _)) = "AAAA"
|
||||
rField (CNAME _) = "CNAME"
|
||||
rField (MX _ _) = "MX"
|
||||
rField (NS _) = "NS"
|
||||
rField (TXT _) = "TXT"
|
||||
|
||||
rValue :: Record -> String
|
||||
rValue (A addr) = addr
|
||||
rValue (AAAA addr) = addr
|
||||
rValue (Address (IPv4 addr)) = addr
|
||||
rValue (Address (IPv6 addr)) = addr
|
||||
rValue (CNAME d) = dValue d
|
||||
rValue (MX pri d) = show pri ++ " " ++ dValue d
|
||||
rValue (NS d) = dValue d
|
||||
|
|
|
@ -5,7 +5,6 @@
|
|||
module Propellor.Types
|
||||
( Host(..)
|
||||
, Attr
|
||||
, HostName
|
||||
, Propellor(..)
|
||||
, Property(..)
|
||||
, RevertableProperty(..)
|
||||
|
|
|
@ -1,14 +1,15 @@
|
|||
module Propellor.Types.Attr where
|
||||
|
||||
import Propellor.Types.OS
|
||||
import qualified Propellor.Types.Dns as Dns
|
||||
|
||||
import qualified Data.Set as S
|
||||
|
||||
-- | The attributes of a host. For example, its hostname.
|
||||
data Attr = Attr
|
||||
{ _hostname :: HostName
|
||||
, _cnames :: S.Set Domain
|
||||
, _os :: Maybe System
|
||||
, _dns :: S.Set Dns.Record
|
||||
, _sshPubKey :: Maybe String
|
||||
|
||||
, _dockerImage :: Maybe String
|
||||
|
@ -18,8 +19,8 @@ data Attr = Attr
|
|||
instance Eq Attr where
|
||||
x == y = and
|
||||
[ _hostname x == _hostname y
|
||||
, _cnames x == _cnames y
|
||||
, _os x == _os y
|
||||
, _dns x == _dns y
|
||||
, _sshPubKey x == _sshPubKey y
|
||||
|
||||
, _dockerImage x == _dockerImage y
|
||||
|
@ -30,17 +31,14 @@ instance Eq Attr where
|
|||
instance Show Attr where
|
||||
show a = unlines
|
||||
[ "hostname " ++ _hostname a
|
||||
, "cnames " ++ show (_cnames a)
|
||||
, "OS " ++ show (_os a)
|
||||
, "dns " ++ show (_dns a)
|
||||
, "sshPubKey " ++ show (_sshPubKey a)
|
||||
, "docker image " ++ show (_dockerImage a)
|
||||
, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
|
||||
]
|
||||
|
||||
newAttr :: HostName -> Attr
|
||||
newAttr hn = Attr hn S.empty Nothing Nothing Nothing []
|
||||
|
||||
type HostName = String
|
||||
type Domain = String
|
||||
newAttr hn = Attr hn Nothing S.empty Nothing Nothing []
|
||||
|
||||
type SetAttr = Attr -> Attr
|
||||
|
|
|
@ -0,0 +1,73 @@
|
|||
module Propellor.Types.Dns where
|
||||
|
||||
import Propellor.Types.OS (HostName)
|
||||
|
||||
import Foreign.C.Types
|
||||
|
||||
type Domain = String
|
||||
|
||||
data IPAddr = IPv4 String | IPv6 String
|
||||
deriving (Read, Show, Eq, Ord)
|
||||
|
||||
fromIPAddr :: IPAddr -> String
|
||||
fromIPAddr (IPv4 addr) = addr
|
||||
fromIPAddr (IPv6 addr) = addr
|
||||
|
||||
-- | Represents a bind 9 named.conf file.
|
||||
data NamedConf = NamedConf
|
||||
{ confDomain :: Domain
|
||||
, confType :: Type
|
||||
, confFile :: FilePath
|
||||
, confMasters :: [IPAddr]
|
||||
, confLines :: [String]
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Type = Master | Secondary
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | Represents a bind 9 zone file.
|
||||
data Zone = Zone
|
||||
{ zSOA :: SOA
|
||||
, zHosts :: [(HostName, 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
|
||||
, sTTL :: Integer
|
||||
, sRecord :: [Record]
|
||||
-- ^ Records for the root of the domain. Typically NS, A, TXT
|
||||
}
|
||||
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
|
||||
deriving (Read, Show, Eq, Ord)
|
||||
|
||||
-- | Bind serial numbers are unsigned, 32 bit integers.
|
||||
type SerialNumber = CInt
|
||||
|
||||
-- | 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 SOADomain refers to the root SOA record.
|
||||
data BindDomain = RelDomain Domain | AbsDomain Domain | SOADomain
|
||||
deriving (Read, Show, Eq, Ord)
|
|
@ -1,5 +1,6 @@
|
|||
module Propellor.Types.OS where
|
||||
|
||||
type HostName = String
|
||||
type UserName = String
|
||||
type GroupName = String
|
||||
|
||||
|
|
|
@ -82,7 +82,7 @@ hosts = -- (o) `
|
|||
& Ssh.hostKey SshEcdsa
|
||||
& Apt.unattendedUpgrades
|
||||
& Apt.serviceInstalledRunning "ntp"
|
||||
& Dns.zones myDnsSecondary
|
||||
& Dns.servingZones myDnsSecondary
|
||||
& Postfix.satellite
|
||||
|
||||
& Apt.serviceInstalledRunning "apache2"
|
||||
|
@ -234,8 +234,8 @@ myDnsSecondary =
|
|||
, Dns.secondary "branchable.com" branchablemaster
|
||||
]
|
||||
where
|
||||
master = ["80.68.85.49", "2001:41c8:125:49::10"] -- wren
|
||||
branchablemaster = ["66.228.46.55", "2600:3c03::f03c:91ff:fedf:c0e5"]
|
||||
master = [Dns.IPv4 "80.68.85.49", Dns.IPv6 "2001:41c8:125:49::10"] -- wren
|
||||
branchablemaster = [Dns.IPv4 "66.228.46.55", Dns.IPv6 "2600:3c03::f03c:91ff:fedf:c0e5"]
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain hosts
|
||||
|
|
|
@ -99,6 +99,7 @@ Library
|
|||
Propellor.Exception
|
||||
Propellor.Types
|
||||
Propellor.Types.OS
|
||||
Propellor.Types.Dns
|
||||
Other-Modules:
|
||||
Propellor.Types.Attr
|
||||
Propellor.CmdLine
|
||||
|
|
Loading…
Reference in New Issue