Merge branch 'joeyconfig'

1 files changed, 93 insertions, 48 deletions

diff --git a/src/Propellor/Property/Unbound.hs b/src/Propellor/Property/Unbound.hs
index 950f669e..b982f370 100644
--- a/src/Propellor/Property/Unbound.hs
+++ b/src/Propellor/Property/Unbound.hs
@@ -4,24 +4,33 @@ module Propellor.Property.Unbound
 	( installed
 	, restarted
 	, reloaded
-	, genAddressNoTtl
-	, genAddress
-	, genMX
-	, genPTR
-	, revIP
-	, canonical
-	, genZoneStatic
-	, genZoneTransparent
+	, cachingDnsServer
 	) where
 
 import Propellor
+import Propellor.Property.File
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Service as Service
 
-import Data.List
-import Data.String.Utils (split, replace)
+import Data.List (find)
 
 
+type ConfSection = String
+
+type UnboundSetting = (UnboundKey, UnboundValue)
+
+type UnboundSection = (ConfSection, [UnboundSetting])
+
+type UnboundZone = (BindDomain, ZoneType)
+
+type UnboundHost = (BindDomain, Record)
+
+type UnboundKey = String
+
+type UnboundValue = String
+
+type ZoneType = String
+
 installed :: Property NoInfo
 installed = Apt.installed ["unbound"]
 
@@ -36,6 +45,75 @@ dValue (RelDomain d) = d
 dValue (AbsDomain d) = d ++ "."
 dValue (RootDomain) = "@"
 
+sectionHeader :: ConfSection -> String
+sectionHeader header = header ++ ":"
+
+config :: FilePath
+config = "/etc/unbound/unbound.conf.d/propellor.conf"
+
+-- | Provided a [UnboundSection], a [UnboundZone] and a [UnboundHost],
+-- cachingDnsServer ensure unbound is configured accordingly.
+--
+-- Example property:
+--
+-- > cachingDnsServer
+-- >      [ ("remote-control", [("control-enable", "no")]
+-- >      , ("server",
+-- >      	[ ("interface", "0.0.0.0")
+-- >      	, ("access-control", "192.168.1.0/24 allow")
+-- >      	, ("do-tcp", "no")
+-- >      	])
+-- >      [ (AbsDomain "example.com", "transparent")
+-- >      , (AbsDomain $ reverseIP $ IPv4 "192.168.1", "static")
+-- >      ]
+-- >      [ (AbsDomain "example.com", Address $ IPv4 "192.168.1.2")
+-- >      , (AbsDomain "myhost.example.com", Address $ IPv4 "192.168.1.2")
+-- >      , (AbsDomain "myrouter.example.com", Address $ IPv4 "192.168.1.1")
+-- >      , (AbsDomain "www.example.com", Address $ IPv4 "192.168.1.2")
+-- >      , (AbsDomain "example.com", MX 10 "mail.example.com")
+-- >      , (AbsDomain "mylaptop.example.com", Address $ IPv4 "192.168.1.2")
+-- >      -- ^ connected via ethernet
+-- >      , (AbsDomain "mywifi.example.com", Address $ IPv4 "192.168.2.1")
+-- >      , (AbsDomain "mylaptop.example.com", Address $ IPv4 "192.168.2.2")
+-- >      -- ^ connected via wifi, use round robin
+-- >      , (AbsDomain "myhost.example.com", PTR $ reverseIP $ IPv4 "192.168.1.2")
+-- >      , (AbsDomain "myrouter.example.com", PTR $ reverseIP $ IPv4 "192.168.1.1")
+-- >      , (AbsDomain "mylaptop.example.com", PTR $ reverseIP $ IPv4 "192.168.1.2")
+-- >      ]
+cachingDnsServer :: [UnboundSection] -> [UnboundZone] -> [UnboundHost] -> Property NoInfo
+cachingDnsServer sections zones hosts =
+	config `hasContent` (comment : otherSections ++ serverSection)
+	`onChange` restarted
+  where
+	comment = "# deployed with propellor, do not modify"
+	serverSection = genSection (fromMaybe ("server", []) $ find ((== "server") . fst) sections)
+		++ map genZone zones
+		++ map (uncurry genRecord') hosts
+	otherSections = foldr ((++) . genSection) [] sections
+
+genSection :: UnboundSection -> [Line]
+genSection (section, settings) = sectionHeader section : map genSetting settings
+
+genSetting :: UnboundSetting -> Line
+genSetting (key, value) = "    " ++ key ++ ": " ++ value
+
+genZone :: UnboundZone -> Line
+genZone (dom, zt) = "    local-zone: \"" ++ dValue dom ++ "\" " ++ zt
+
+genRecord' :: BindDomain -> Record -> Line
+genRecord' dom r = "    local-data: \"" ++ fromMaybe "" (genRecord dom r) ++ "\""
+
+genRecord :: BindDomain -> Record -> Maybe String
+genRecord dom (Address addr) = Just $ genAddressNoTtl dom addr
+genRecord dom (MX priority dest) = Just $ genMX dom priority dest
+genRecord dom (PTR revip) = Just $ genPTR dom revip
+genRecord _ (CNAME _) = Nothing
+genRecord _ (NS _) = Nothing
+genRecord _ (TXT _) = Nothing
+genRecord _ (SRV _ _ _ _) = Nothing
+genRecord _ (SSHFP _ _ _) = Nothing
+genRecord _ (INCLUDE _) = Nothing
+
 genAddressNoTtl :: BindDomain -> IPAddr -> String
 genAddressNoTtl dom = genAddress dom Nothing
 
@@ -45,43 +123,10 @@ genAddress dom ttl addr = case addr of
 	IPv6 _ -> genAddress' "AAAA" dom ttl addr
 
 genAddress' :: String -> BindDomain -> Maybe Int -> IPAddr -> String
-genAddress' recordtype dom ttl addr = localData $ dValue dom ++ " " ++ maybe "" (\ttl' -> show ttl' ++ " ") ttl ++ "IN " ++ recordtype ++ " " ++ fromIPAddr addr
-
-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
-
-localData :: String -> String
-localData conf = "    local-data: \"" ++ conf ++ "\""
-
-genZoneStatic :: BindDomain -> String
-genZoneStatic dom = localZone (dValue dom) "static"
+genAddress' recordtype dom ttl addr = dValue dom ++ " " ++ maybe "" (\ttl' -> show ttl' ++ " ") ttl ++ "IN " ++ recordtype ++ " " ++ fromIPAddr addr
 
-genZoneTransparent :: BindDomain -> String
-genZoneTransparent dom = localZone (dValue dom) "transparent"
+genMX :: BindDomain -> Int -> BindDomain -> String
+genMX dom priority dest = dValue dom ++ " " ++ "MX" ++ " " ++ show priority ++ " " ++ dValue dest
 
-localZone :: String -> String -> String
-localZone zone confzone = "    local-zone: \"" ++ zone ++ "\" " ++ confzone
+genPTR :: BindDomain -> ReverseIP -> String
+genPTR dom revip = revip ++ ". " ++ "PTR" ++ " " ++ dValue dom