From f3f7bb19bb6f30f48ae6d7e272bc59b7fa8efd10 Mon Sep 17 00:00:00 2001 From: Félix Sipma Date: Tue, 15 Sep 2015 21:23:27 +0200 Subject: 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 --- src/Propellor/Info.hs | 3 +- src/Propellor/Property/Dns.hs | 87 ++++++++++++++++++++------------------- src/Propellor/Property/Unbound.hs | 28 +------------ src/Propellor/Types/Dns.hs | 26 ++++++++++++ 4 files changed, 74 insertions(+), 70 deletions(-) (limited to 'src') 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 -- cgit v1.2.3