summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFélix Sipma2015-09-15 21:23:27 +0200
committerJoey Hess2015-09-15 21:17:05 -0400
commitf3f7bb19bb6f30f48ae6d7e272bc59b7fa8efd10 (patch)
treea09592824d8862cff4562e038842f8c1f7db19c0
parent00e824fd0460d5275fc6c6730dd701623f3492c3 (diff)
add PTR record type to Propellor.Types.DNS.Record
- add canonicalIP and reverseIP to Propellor.Types.Dns - remove corresponding canonical and revIP from Propellor.Property.Unbound - Propellor.Property.Dns: convert rValue, rField and genRecord to return Maybe String Signed-off-by: Félix Sipma <felix.sipma@no-log.org>
-rw-r--r--src/Propellor/Info.hs3
-rw-r--r--src/Propellor/Property/Dns.hs87
-rw-r--r--src/Propellor/Property/Unbound.hs28
-rw-r--r--src/Propellor/Types/Dns.hs26
4 files changed, 74 insertions, 70 deletions
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index 74614a1b..fed62ff9 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -74,13 +74,14 @@ addDNS r = pureInfoProperty (rdesc r) (toDnsInfo (S.singleton r))
rdesc (SRV x y z d) = unwords ["SRV", show x, show y, show z, ddesc d]
rdesc (SSHFP x y s) = unwords ["SSHFP", show x, show y, s]
rdesc (INCLUDE f) = unwords ["$INCLUDE", f]
+ rdesc (PTR x) = unwords ["PTR", x]
ddesc (AbsDomain domain) = domain
ddesc (RelDomain domain) = domain
ddesc RootDomain = "@"
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 = M.fromList . concat .
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index d854ec52..da063e0e 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -69,14 +69,14 @@ primary hosts domain soa rs = setup <!> cleanup
zonefile = "/etc/bind/propellor/db." ++ domain
setupPrimary :: FilePath -> (FilePath -> FilePath) -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property HasInfo
-setupPrimary zonefile mknamedconffile hosts domain soa rs =
+setupPrimary zonefile mknamedconffile hosts domain soa rs =
withwarnings baseprop
`requires` servingZones
where
hostmap = hostMap hosts
-- Known hosts with hostname located in the domain.
indomain = M.elems $ M.filterWithKey (\hn _ -> inDomain domain $ AbsDomain $ hn) hostmap
-
+
(partialzone, zonewarnings) = genZone indomain hostmap domain soa
baseprop = infoProperty ("dns primary for " ++ domain) satisfy
(mempty `addInfo` addNamedConf conf) []
@@ -153,18 +153,18 @@ cleanupPrimary zonefile domain = check (doesFileExist zonefile) $
signedPrimary :: Recurrance -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty
signedPrimary recurrance hosts domain soa rs = setup <!> cleanup
where
- setup = combineProperties ("dns primary for " ++ domain ++ " (signed)")
+ setup = combineProperties ("dns primary for " ++ domain ++ " (signed)")
(props
& setupPrimary zonefile signedZoneFile hosts domain soa rs'
& zoneSigned domain zonefile
& forceZoneSigned domain zonefile `period` recurrance
)
`onChange` Service.reloaded "bind9"
-
+
cleanup = cleanupPrimary zonefile domain
`onChange` toProp (revert (zoneSigned domain zonefile))
`onChange` Service.reloaded "bind9"
-
+
-- Include the public keys into the zone file.
rs' = include PubKSK : include PubZSK : rs
include k = (RootDomain, INCLUDE (keyFn domain k))
@@ -243,7 +243,7 @@ confStanza c =
]
where
cfgline f v = "\t" ++ f ++ " " ++ v ++ ";"
- ipblock name l =
+ ipblock name l =
[ "\t" ++ name ++ " {" ] ++
(map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") l) ++
[ "\t};" ]
@@ -286,38 +286,40 @@ dValue (RelDomain d) = d
dValue (AbsDomain d) = d ++ "."
dValue (RootDomain) = "@"
-rField :: Record -> String
-rField (Address (IPv4 _)) = "A"
-rField (Address (IPv6 _)) = "AAAA"
-rField (CNAME _) = "CNAME"
-rField (MX _ _) = "MX"
-rField (NS _) = "NS"
-rField (TXT _) = "TXT"
-rField (SRV _ _ _ _) = "SRV"
-rField (SSHFP _ _ _) = "SSHFP"
-rField (INCLUDE _) = "$INCLUDE"
-
-rValue :: Record -> String
-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
-rValue (SRV priority weight port target) = unwords
+rField :: Record -> Maybe String
+rField (Address (IPv4 _)) = Just "A"
+rField (Address (IPv6 _)) = Just "AAAA"
+rField (CNAME _) = Just "CNAME"
+rField (MX _ _) = Just "MX"
+rField (NS _) = Just "NS"
+rField (TXT _) = Just "TXT"
+rField (SRV _ _ _ _) = Just "SRV"
+rField (SSHFP _ _ _) = Just "SSHFP"
+rField (INCLUDE _) = Just "$INCLUDE"
+rField (PTR _) = Nothing
+
+rValue :: Record -> Maybe String
+rValue (Address (IPv4 addr)) = Just addr
+rValue (Address (IPv6 addr)) = Just addr
+rValue (CNAME d) = Just $ dValue d
+rValue (MX pri d) = Just $ show pri ++ " " ++ dValue d
+rValue (NS d) = Just $ dValue d
+rValue (SRV priority weight port target) = Just $ unwords
[ show priority
, show weight
, show port
, dValue target
]
-rValue (SSHFP x y s) = unwords
+rValue (SSHFP x y s) = Just $ unwords
[ show x
, show y
, s
]
-rValue (INCLUDE f) = f
-rValue (TXT s) = [q] ++ filter (/= q) s ++ [q]
+rValue (INCLUDE f) = Just f
+rValue (TXT s) = Just $ [q] ++ filter (/= q) s ++ [q]
where
q = '"'
+rValue (PTR _) = Nothing
-- | Adjusts the serial number of the zone to always be larger
-- than the serial number in the Zone record,
@@ -375,27 +377,28 @@ readZonePropellorFile f = catchDefaultIO Nothing $
-- | Generating a zone file.
genZoneFile :: Zone -> String
genZoneFile (Zone zdomain soa rs) = unlines $
- header : genSOA soa ++ map (genRecord zdomain) rs
+ header : genSOA soa ++ mapMaybe (genRecord zdomain) rs
where
header = com $ "BIND zone file for " ++ zdomain ++ ". Generated by propellor, do not edit."
-genRecord :: Domain -> (BindDomain, Record) -> String
-genRecord _ (_, record@(INCLUDE _)) = intercalate "\t"
- [ rField record
- , rValue record
- ]
-genRecord zdomain (domain, record) = intercalate "\t"
- [ domainHost zdomain domain
- , "IN"
- , rField record
- , rValue record
- ]
+genRecord :: Domain -> (BindDomain, Record) -> Maybe String
+genRecord zdomain (domain, record) = case (rField record, rValue record) of
+ (Nothing, _) -> Nothing
+ (_, Nothing) -> Nothing
+ (Just rfield, Just rvalue) -> Just $ intercalate "\t" $ case record of
+ INCLUDE _ -> [ rfield, rvalue ]
+ _ ->
+ [ domainHost zdomain domain
+ , "IN"
+ , rfield
+ , rvalue
+ ]
genSOA :: SOA -> [String]
-genSOA soa =
+genSOA soa =
-- "@ IN SOA ns1.example.com. root ("
[ intercalate "\t"
- [ dValue RootDomain
+ [ dValue RootDomain
, "IN"
, "SOA"
, dValue (sDomain soa)
@@ -468,7 +471,7 @@ genZone inzdomain hostmap zdomain soa =
l -> map (ret . Address) l
where
ret record = Right (c, record)
-
+
-- Adds any other DNS records for a host located in the zdomain.
hostrecords :: Host -> [Either WarningMessage (BindDomain, Record)]
hostrecords h = map Right l
diff --git a/src/Propellor/Property/Unbound.hs b/src/Propellor/Property/Unbound.hs
index 950f669e..205c9ddb 100644
--- a/src/Propellor/Property/Unbound.hs
+++ b/src/Propellor/Property/Unbound.hs
@@ -8,8 +8,6 @@ module Propellor.Property.Unbound
, genAddress
, genMX
, genPTR
- , revIP
- , canonical
, genZoneStatic
, genZoneTransparent
) where
@@ -18,9 +16,6 @@ import Propellor
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
-import Data.List
-import Data.String.Utils (split, replace)
-
installed :: Property NoInfo
installed = Apt.installed ["unbound"]
@@ -51,28 +46,7 @@ genMX :: BindDomain -> BindDomain -> Int -> String
genMX dom dest priority = localData $ dValue dom ++ " " ++ "MX" ++ " " ++ show priority ++ " " ++ dValue dest
genPTR :: BindDomain -> IPAddr -> String
-genPTR dom ip = localData $ revIP ip ++ ". " ++ "PTR" ++ " " ++ dValue dom
-
-revIP :: IPAddr -> String
-revIP (IPv4 addr) = intercalate "." (reverse $ split "." addr) ++ ".in-addr.arpa"
-revIP addr@(IPv6 _) = reverse (intersperse '.' $ replace ":" "" $ fromIPAddr $ canonical addr) ++ ".ip6.arpa"
-
-canonical :: IPAddr -> IPAddr
-canonical (IPv4 addr) = IPv4 addr
-canonical (IPv6 addr) = IPv6 $ intercalate ":" $ map canonicalGroup $ split ":" $ replaceImplicitGroups addr
- where
- canonicalGroup g = case length g of
- 0 -> "0000"
- 1 -> "000" ++ g
- 2 -> "00" ++ g
- 3 -> "0" ++ g
- _ -> g
- emptyGroups n = iterate (++ ":") "" !! n
- numberOfImplicitGroups a = 8 - length (split ":" $ replace "::" "" a)
- replaceImplicitGroups a = concat $ aux $ split "::" a
- where
- aux [] = []
- aux (x : xs) = x : emptyGroups (numberOfImplicitGroups a) : xs
+genPTR dom ip = localData $ reverseIP ip ++ ". " ++ "PTR" ++ " " ++ dValue dom
localData :: String -> String
localData conf = " local-data: \"" ++ conf ++ "\""
diff --git a/src/Propellor/Types/Dns.hs b/src/Propellor/Types/Dns.hs
index d78c78fd..1c83854e 100644
--- a/src/Propellor/Types/Dns.hs
+++ b/src/Propellor/Types/Dns.hs
@@ -10,6 +10,8 @@ import Data.Word
import Data.Monoid
import qualified Data.Map as M
import qualified Data.Set as S
+import Data.List
+import Data.String.Utils (split, replace)
type Domain = String
@@ -91,8 +93,32 @@ data Record
| SRV Word16 Word16 Word16 BindDomain
| SSHFP Int Int String
| INCLUDE FilePath
+ | PTR ReverseIP
deriving (Read, Show, Eq, Ord, Typeable)
+type ReverseIP = String
+
+reverseIP :: IPAddr -> ReverseIP
+reverseIP (IPv4 addr) = intercalate "." (reverse $ split "." addr) ++ ".in-addr.arpa"
+reverseIP addr@(IPv6 _) = reverse (intersperse '.' $ replace ":" "" $ fromIPAddr $ canonicalIP addr) ++ ".ip6.arpa"
+
+canonicalIP :: IPAddr -> IPAddr
+canonicalIP (IPv4 addr) = IPv4 addr
+canonicalIP (IPv6 addr) = IPv6 $ intercalate ":" $ map canonicalGroup $ split ":" $ replaceImplicitGroups addr
+ where
+ canonicalGroup g = case length g of
+ 0 -> "0000"
+ 1 -> "000" ++ g
+ 2 -> "00" ++ g
+ 3 -> "0" ++ g
+ _ -> g
+ emptyGroups n = iterate (++ ":") "" !! n
+ numberOfImplicitGroups a = 8 - length (split ":" $ 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