summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2014-04-18 21:58:23 -0400
committerJoey Hess2014-04-18 21:58:23 -0400
commit395d3f206af48dcac5980fc70f7189a77e43fcc8 (patch)
tree323ed0a78334761a273ed01fdfafae49088002b6
parentc8a3653775892bd361091885c63113b6ca36ed5a (diff)
Dns.primary wrote, not quite ready
-rw-r--r--Propellor/Attr.hs1
-rw-r--r--Propellor/Property/Dns.hs37
-rw-r--r--Propellor/Types.hs2
-rw-r--r--config-joey.hs18
4 files changed, 50 insertions, 8 deletions
diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index 37ed1bad..a4d7a958 100644
--- a/Propellor/Attr.hs
+++ b/Propellor/Attr.hs
@@ -4,7 +4,6 @@ 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
diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 131079ea..a9a8619c 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -1,8 +1,10 @@
module Propellor.Property.Dns (
module Propellor.Types.Dns,
+ primary,
secondary,
servingZones,
mkSOA,
+ rootAddressesFrom,
writeZoneFile,
nextSerialNumber,
adjustSerialNumber,
@@ -22,6 +24,23 @@ import qualified Data.Map as M
import qualified Data.Set as S
import Data.List
+-- | Primary dns server for a domain.
+--
+-- TODO: Does not yet add it to named.conf.local.
+primary :: [Host] -> Domain -> SOA -> Property
+primary hosts domain soa = withwarnings (check needupdate baseprop)
+ `requires` Apt.serviceInstalledRunning "bind9"
+ `onChange` Service.reloaded "bind9"
+ where
+ (zone, warnings) = genZone hosts domain soa
+ zonefile = "/etc/bind/propellor/db." ++ domain
+ needupdate = (/= Just zone) <$> readZonePropellorFile zonefile
+ baseprop = property ("dns primary for " ++ domain) $ makeChange $ do
+ writeZoneFile zone zonefile
+ withwarnings p = adjustProperty p $ \satisfy -> do
+ mapM_ warningMessage warnings
+ satisfy
+
namedconf :: FilePath
namedconf = "/etc/bind/named.conf.local"
@@ -56,7 +75,7 @@ confStanza c =
(map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") (confMasters c)) ++
[ "\t};" ]
--- | Rewrites the whole named.conf.local file to serve the specificed
+-- | Rewrites the whole named.conf.local file to serve the specified
-- zones.
servingZones :: [NamedConf] -> Property
servingZones zs = hasContent namedconf (concatMap confStanza zs)
@@ -66,6 +85,10 @@ servingZones zs = hasContent namedconf (concatMap confStanza zs)
-- | Generates a SOA with some fairly sane numbers in it.
--
+-- The Domain is the domain to use in the SOA record. Typically
+-- something like ns1.example.com. Not the domain that this is the SOA
+-- record for.
+--
-- The SerialNumber can be whatever serial number was used by the domain
-- before propellor started managing it. Or 0 if the domain has only ever
-- been managed by propellor.
@@ -73,19 +96,22 @@ servingZones zs = hasContent namedconf (concatMap confStanza zs)
-- You do not need to increment the SerialNumber when making changes!
-- Propellor will automatically add the number of commits in the git
-- repository to the SerialNumber.
-mkSOA :: Domain -> SerialNumber -> [Record] -> SOA
-mkSOA d sn rs = SOA
+mkSOA :: Domain -> SerialNumber -> [Record] -> [Record] -> SOA
+mkSOA d sn rs1 rs2 = SOA
{ sDomain = AbsDomain d
, sSerial = sn
, sRefresh = hours 4
, sRetry = hours 1
, sExpire = 2419200 -- 4 weeks
, sTTL = hours 8
- , sRecord = rs
+ , sRecord = rs1 ++ rs2
}
where
hours n = n * 60 * 60
+rootAddressesFrom :: [Host] -> HostName -> [Record]
+rootAddressesFrom hosts hn = map Address (hostAddresses hn hosts)
+
dValue :: BindDomain -> String
dValue (RelDomain d) = d
dValue (AbsDomain d) = d ++ "."
@@ -137,7 +163,8 @@ writeZoneFile z f = do
offset <- serialNumberOffset
let z' = nextSerialNumber
(adjustSerialNumber z (+ offset))
- (succ oldserial)
+ oldserial
+ createDirectoryIfMissing True (takeDirectory f)
writeFile f (genZoneFile z')
writeZonePropellorFile f z'
diff --git a/Propellor/Types.hs b/Propellor/Types.hs
index ad822a8b..0e412e82 100644
--- a/Propellor/Types.hs
+++ b/Propellor/Types.hs
@@ -21,6 +21,7 @@ module Propellor.Types
, GpgKeyId
, SshKeyType(..)
, module Propellor.Types.OS
+ , module Propellor.Types.Dns
) where
import Data.Monoid
@@ -31,6 +32,7 @@ import "MonadCatchIO-transformers" Control.Monad.CatchIO
import Propellor.Types.Attr
import Propellor.Types.OS
+import Propellor.Types.Dns
data Host = Host [Property] SetAttr
diff --git a/config-joey.hs b/config-joey.hs
index 289d3240..e4eed9f1 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -39,6 +39,16 @@ hosts = -- (o) `
, standardSystem "clam.kitenet.net" Unstable "amd64"
& ipv4 "162.248.143.249"
& ipv6 "2002:5044:5531::1"
+
+ & Dns.primary hosts "olduse.net" $
+ Dns.mkSOA "ns1.kitenet.net" 100
+ (Dns.rootAddressesFrom hosts "branchable.com")
+ [ NS "ns1.kitenet.net"
+ , NS "ns6.gandi.net"
+ , NS "ns2.kitenet.net"
+ , MX 0 "kitenet.net"
+ , TXT "v=spf1 a -all"
+ ]
& cleanCloudAtCost
& Apt.unattendedUpgrades
@@ -242,7 +252,7 @@ myDnsSecondary =
]
where
master = hostAddresses "wren.kitenet.net" hosts
- branchablemaster = hostAddresses "pell.branchable.com" hosts
+ branchablemaster = hostAddresses "branchable.com" hosts
main :: IO ()
main = defaultMain hosts
@@ -274,7 +284,11 @@ monsters = -- but do want to track their public keys etc.
& ipv4 "80.68.85.49"
& ipv6 "2001:41c8:125:49::10"
& cname "kite.kitenet.net"
- , host "pell.branchable.com"
+ , host "branchable.com"
& ipv4 "66.228.46.55"
& ipv6 "2600:3c03::f03c:91ff:fedf:c0e5"
+ & cname "www.olduse.net"
+ & cname "git.olduse.net"
+ , host "virgil.koldfront.dk"
+ & cname "article.olduse.net"
]