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 From 1f4904881019efe275ba0e80b6beb5a2355e0b23 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 15 Sep 2015 21:22:23 -0400 Subject: documentation --- debian/changelog | 4 ++++ src/Propellor/Property/Dns.hs | 4 +++- src/Propellor/Types/Dns.hs | 3 +++ 3 files changed, 10 insertions(+), 1 deletion(-) (limited to 'src') diff --git a/debian/changelog b/debian/changelog index 791cc04b..8969a5d1 100644 --- a/debian/changelog +++ b/debian/changelog @@ -13,6 +13,10 @@ propellor (2.8.0) UNRELEASED; urgency=medium Thanks, Mario Lang * Added Propellor.Property.Unbound for the caching DNS server. Thanks, Félix Sipma. + * Added PTR to Dns.Record. While this is ignored by + Propellor.Property.Dns for now, since reverse DNS setup is not + implemented there yet, it can be used in other places, eg Unbound. + Thanks, Félix Sipma. * PrivData converted to newtype (API change). * Stopped stripping trailing newlines when setting PrivData; this was previously done to avoid mistakes when pasting eg passwords diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs index da063e0e..056733cd 100644 --- a/src/Propellor/Property/Dns.hs +++ b/src/Propellor/Property/Dns.hs @@ -28,7 +28,9 @@ import qualified Data.Map as M import qualified Data.Set as S import Data.List --- | Primary dns server for a domain. +-- | Primary dns server for a domain, using bind. +-- +-- Currently, this only configures bind to serve forward DNS, not reverse DNS. -- -- Most of the content of the zone file is configured by setting properties -- of hosts. For example, diff --git a/src/Propellor/Types/Dns.hs b/src/Propellor/Types/Dns.hs index 1c83854e..4a0dd805 100644 --- a/src/Propellor/Types/Dns.hs +++ b/src/Propellor/Types/Dns.hs @@ -96,12 +96,15 @@ data Record | PTR ReverseIP deriving (Read, Show, Eq, Ord, Typeable) +-- | An in-addr.arpa record corresponding to an IPAddr. 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" +-- | Converts an IP address (particularly IPv6) to canonical, fully +-- expanded form. canonicalIP :: IPAddr -> IPAddr canonicalIP (IPv4 addr) = IPv4 addr canonicalIP (IPv6 addr) = IPv6 $ intercalate ":" $ map canonicalGroup $ split ":" $ replaceImplicitGroups addr -- cgit v1.2.3 From ec2ac2b4d7a1783e6deca2f73a57faabb4b25cd7 Mon Sep 17 00:00:00 2001 From: Félix Sipma Date: Wed, 16 Sep 2015 10:00:44 +0200 Subject: Types.Dns: simplify canonicalGroup Signed-off-by: Félix Sipma --- src/Propellor/Types/Dns.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) (limited to 'src') diff --git a/src/Propellor/Types/Dns.hs b/src/Propellor/Types/Dns.hs index 4a0dd805..3497b3ed 100644 --- a/src/Propellor/Types/Dns.hs +++ b/src/Propellor/Types/Dns.hs @@ -109,12 +109,11 @@ 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 + canonicalGroup g + | l <= 4 = replicate (4 - l) '0' ++ g + | otherwise = error $ "IPv6 group " ++ g ++ "as more than 4 hex digits" + where + l = length g emptyGroups n = iterate (++ ":") "" !! n numberOfImplicitGroups a = 8 - length (split ":" $ replace "::" "" a) replaceImplicitGroups a = concat $ aux $ split "::" a -- cgit v1.2.3 From 19834cdd911629876e173cbd2e8e4889f117e7ed Mon Sep 17 00:00:00 2001 From: Félix Sipma Date: Wed, 16 Sep 2015 22:39:37 +0200 Subject: Unbound: cachingServer property Signed-off-by: Félix Sipma --- src/Propellor/Property/Unbound.hs | 87 ++++++++++++++++++++++++++++----------- 1 file changed, 64 insertions(+), 23 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Unbound.hs b/src/Propellor/Property/Unbound.hs index 205c9ddb..68703dfd 100644 --- a/src/Propellor/Property/Unbound.hs +++ b/src/Propellor/Property/Unbound.hs @@ -4,18 +4,32 @@ module Propellor.Property.Unbound ( installed , restarted , reloaded - , genAddressNoTtl - , genAddress - , genMX - , genPTR - , 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 (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"] @@ -31,6 +45,45 @@ 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" + +cachingDnsServer :: [UnboundSection] -> [UnboundZone] -> [UnboundHost] -> Property NoInfo +cachingDnsServer sections zones hosts = + config `hasContent` (comment : otherSections ++ serverSection) + 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 @@ -40,22 +93,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 $ reverseIP ip ++ ". " ++ "PTR" ++ " " ++ dValue dom - -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 -- cgit v1.2.3 From 8cea12ce1a799175a7922b642591e1352826d17e Mon Sep 17 00:00:00 2001 From: Félix Sipma Date: Thu, 17 Sep 2015 09:13:13 +0200 Subject: Unbound: restart unbound when config in cachingDnsServer is modified Signed-off-by: Félix Sipma --- src/Propellor/Property/Unbound.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src') diff --git a/src/Propellor/Property/Unbound.hs b/src/Propellor/Property/Unbound.hs index 68703dfd..6edb8b8b 100644 --- a/src/Propellor/Property/Unbound.hs +++ b/src/Propellor/Property/Unbound.hs @@ -54,6 +54,7 @@ config = "/etc/unbound/unbound.conf.d/propellor.conf" 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) -- cgit v1.2.3 From 83db452c16c73b64e9742885880316a8760b057c Mon Sep 17 00:00:00 2001 From: Félix Sipma Date: Thu, 17 Sep 2015 09:12:45 +0200 Subject: Unbound: add example for cachingDnsServer Signed-off-by: Félix Sipma --- src/Propellor/Property/Unbound.hs | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) (limited to 'src') diff --git a/src/Propellor/Property/Unbound.hs b/src/Propellor/Property/Unbound.hs index 6edb8b8b..94e41104 100644 --- a/src/Propellor/Property/Unbound.hs +++ b/src/Propellor/Property/Unbound.hs @@ -51,6 +51,35 @@ 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) -- cgit v1.2.3 From 75556f0a093bee38575da56f2422b9821c4897f0 Mon Sep 17 00:00:00 2001 From: Félix Sipma Date: Fri, 18 Sep 2015 10:33:11 +0200 Subject: Unbound: improve haddock formatting Signed-off-by: Félix Sipma --- src/Propellor/Property/Unbound.hs | 48 +++++++++++++++++++-------------------- 1 file changed, 24 insertions(+), 24 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Unbound.hs b/src/Propellor/Property/Unbound.hs index 94e41104..b982f370 100644 --- a/src/Propellor/Property/Unbound.hs +++ b/src/Propellor/Property/Unbound.hs @@ -56,30 +56,30 @@ config = "/etc/unbound/unbound.conf.d/propellor.conf" -- -- 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 +-- > [ ("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) -- cgit v1.2.3 From 266fbe7f20dbefc4709b323bc316f4ae33206ec6 Mon Sep 17 00:00:00 2001 From: Jelmer Vernooij Date: Sun, 20 Sep 2015 14:25:37 +0000 Subject: Add aiccu module. --- src/Propellor/Property/Aiccu.hs | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 src/Propellor/Property/Aiccu.hs (limited to 'src') diff --git a/src/Propellor/Property/Aiccu.hs b/src/Propellor/Property/Aiccu.hs new file mode 100644 index 00000000..c6c1569a --- /dev/null +++ b/src/Propellor/Property/Aiccu.hs @@ -0,0 +1,27 @@ +module Propellor.Property.Aiccu where + +import Propellor +import qualified Propellor.Property.Apt as Apt + +confPath :: FilePath +confPath = "/etc/aiccu.conf" + +config :: String -> String -> PrivData -> [String] +config u t p = [ "protocol tic" + , "server tic.sixxs.net" + , "username " ++ u + , "password " ++ (privDataVal p) + , "ipv6_interface sixxs" + , "tunnel_id " ++ t + , "daemonize true" + , "automatic true" + , "requiretls true" + , "makebeats true" + ] + +hasConfig :: String -> String -> Property HasInfo +hasConfig t u = withSomePrivData [(Password (u++"/"++t)), (Password u)] (Context "aiccu") $ property "aiccu configured" . writeConfig + where writeConfig :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result + writeConfig getpassword = getpassword $ go + go (Password u, p) = makeChange $ writeFile confPath (unlines $ config u t p) + go (f, _) = error $ "Unexpected type of privdata: " ++ show f -- cgit v1.2.3 From ca5f973c2b745b75da57d4b3953d50604165fcd0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 20 Sep 2015 14:37:41 -0400 Subject: reformat and fix warning about 2 definitions of 'u' --- src/Propellor/Property/Aiccu.hs | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Aiccu.hs b/src/Propellor/Property/Aiccu.hs index c6c1569a..e6d4f7fe 100644 --- a/src/Propellor/Property/Aiccu.hs +++ b/src/Propellor/Property/Aiccu.hs @@ -7,21 +7,23 @@ confPath :: FilePath confPath = "/etc/aiccu.conf" config :: String -> String -> PrivData -> [String] -config u t p = [ "protocol tic" - , "server tic.sixxs.net" - , "username " ++ u - , "password " ++ (privDataVal p) - , "ipv6_interface sixxs" - , "tunnel_id " ++ t - , "daemonize true" - , "automatic true" - , "requiretls true" - , "makebeats true" - ] +config u t p = + [ "protocol tic" + , "server tic.sixxs.net" + , "username " ++ u + , "password " ++ (privDataVal p) + , "ipv6_interface sixxs" + , "tunnel_id " ++ t + , "daemonize true" + , "automatic true" + , "requiretls true" + , "makebeats true" + ] hasConfig :: String -> String -> Property HasInfo hasConfig t u = withSomePrivData [(Password (u++"/"++t)), (Password u)] (Context "aiccu") $ property "aiccu configured" . writeConfig - where writeConfig :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result - writeConfig getpassword = getpassword $ go - go (Password u, p) = makeChange $ writeFile confPath (unlines $ config u t p) - go (f, _) = error $ "Unexpected type of privdata: " ++ show f + where + writeConfig :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result + writeConfig getpassword = getpassword $ go + go (Password u', p) = makeChange $ writeFile confPath (unlines $ config u' t p) + go (f, _) = error $ "Unexpected type of privdata: " ++ show f -- cgit v1.2.3 From 9aa06bcaa93cb2f2a9debe360cd64a9e930c6cdf Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 20 Sep 2015 14:41:45 -0400 Subject: fix example after recent changes --- src/Propellor/PrivData.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs index a28fb195..5df9fe0d 100644 --- a/src/Propellor/PrivData.hs +++ b/src/Propellor/PrivData.hs @@ -58,7 +58,7 @@ import Utility.FileSystemEncoding -- -- > withPrivData (PrivFile pemfile) (Context "joeyh.name") $ \getdata -> -- > property "joeyh.name ssl cert" $ getdata $ \privdata -> --- > liftIO $ writeFile pemfile privdata +-- > liftIO $ writeFile pemfile (privDataVal privdata) -- > where pemfile = "/etc/ssl/certs/web.pem" -- -- Note that if the value is not available, the action is not run -- cgit v1.2.3 From 2f4340bb1b235f6aec9a6a28233ee28d82b499a3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 20 Sep 2015 14:49:15 -0400 Subject: a few improvements --- src/Propellor/Property/Aiccu.hs | 32 ++++++++++++++++++++++++++------ 1 file changed, 26 insertions(+), 6 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Aiccu.hs b/src/Propellor/Property/Aiccu.hs index e6d4f7fe..e3070c90 100644 --- a/src/Propellor/Property/Aiccu.hs +++ b/src/Propellor/Property/Aiccu.hs @@ -1,12 +1,29 @@ -module Propellor.Property.Aiccu where +module Propellor.Property.Aiccu ( + installed, + reloaded, + confPath, + UserName, + TunnelId, + hasConfig, +) where import Propellor import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.Service as Service +import qualified Propellor.Property.File as File + +installed :: Property NoInfo +installed = Apt.installed ["aiccu"] + +reloaded :: Property NoInfo +reloaded = Service.reloaded "aiccu" confPath :: FilePath confPath = "/etc/aiccu.conf" -config :: String -> String -> PrivData -> [String] +type TunnelId = String + +config :: UserName -> TunnelId -> PrivData -> [File.Line] config u t p = [ "protocol tic" , "server tic.sixxs.net" @@ -20,10 +37,13 @@ config u t p = , "makebeats true" ] -hasConfig :: String -> String -> Property HasInfo -hasConfig t u = withSomePrivData [(Password (u++"/"++t)), (Password u)] (Context "aiccu") $ property "aiccu configured" . writeConfig +-- | Configures an ipv6 tunnel using sixxs.net, with the given TunneId +-- and sixx.net UserName. +hasConfig :: TunnelId -> UserName -> Property HasInfo +hasConfig t u = withSomePrivData [(Password (u++"/"++t)), (Password u)] (Context "aiccu") $ + property "aiccu configured" . writeConfig where writeConfig :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result - writeConfig getpassword = getpassword $ go - go (Password u', p) = makeChange $ writeFile confPath (unlines $ config u' t p) + writeConfig getpassword = getpassword $ ensureProperty . go + go (Password u', p) = confPath `File.hasContent` config u' t p go (f, _) = error $ "Unexpected type of privdata: " ++ show f -- cgit v1.2.3 From 2080b5f57f5d88466a786a494fb3bf9cb4d44996 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 20 Sep 2015 14:51:12 -0400 Subject: reload daemon on conf file change --- src/Propellor/Property/Aiccu.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Aiccu.hs b/src/Propellor/Property/Aiccu.hs index e3070c90..7a1e6e18 100644 --- a/src/Propellor/Property/Aiccu.hs +++ b/src/Propellor/Property/Aiccu.hs @@ -40,9 +40,10 @@ config u t p = -- | Configures an ipv6 tunnel using sixxs.net, with the given TunneId -- and sixx.net UserName. hasConfig :: TunnelId -> UserName -> Property HasInfo -hasConfig t u = withSomePrivData [(Password (u++"/"++t)), (Password u)] (Context "aiccu") $ - property "aiccu configured" . writeConfig +hasConfig t u = prop `onChange` reloaded where + prop = withSomePrivData [(Password (u++"/"++t)), (Password u)] (Context "aiccu") $ + property "aiccu configured" . writeConfig writeConfig :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result writeConfig getpassword = getpassword $ ensureProperty . go go (Password u', p) = confPath `File.hasContent` config u' t p -- cgit v1.2.3 From 174fc58787ed585e047febb206d205daa447dee1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 20 Sep 2015 14:58:51 -0400 Subject: bug fix: used wrong username for config file in case where username/tunnelid was provided in privdata --- src/Propellor/Property/Aiccu.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/Aiccu.hs b/src/Propellor/Property/Aiccu.hs index 7a1e6e18..16d48832 100644 --- a/src/Propellor/Property/Aiccu.hs +++ b/src/Propellor/Property/Aiccu.hs @@ -46,5 +46,5 @@ hasConfig t u = prop `onChange` reloaded property "aiccu configured" . writeConfig writeConfig :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result writeConfig getpassword = getpassword $ ensureProperty . go - go (Password u', p) = confPath `File.hasContent` config u' t p + go (Password _, p) = confPath `File.hasContent` config u t p go (f, _) = error $ "Unexpected type of privdata: " ++ show f -- cgit v1.2.3 From 40908a6ff603caf70a0f8653a3f6fda13e05cd37 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 20 Sep 2015 15:03:51 -0400 Subject: make sure aiccu.conf is only readable by root, even if it had a different mode to start with --- src/Propellor/Property/Aiccu.hs | 2 +- src/Propellor/Property/File.hs | 10 +++++++++- 2 files changed, 10 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Aiccu.hs b/src/Propellor/Property/Aiccu.hs index 16d48832..519b8ce9 100644 --- a/src/Propellor/Property/Aiccu.hs +++ b/src/Propellor/Property/Aiccu.hs @@ -46,5 +46,5 @@ hasConfig t u = prop `onChange` reloaded property "aiccu configured" . writeConfig writeConfig :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result writeConfig getpassword = getpassword $ ensureProperty . go - go (Password _, p) = confPath `File.hasContent` config u t p + go (Password _, p) = confPath `File.hasContentProtected` config u t p go (f, _) = error $ "Unexpected type of privdata: " ++ show f diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index 4563fe79..a1d3037f 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -10,7 +10,15 @@ type Line = String -- | Replaces all the content of a file. hasContent :: FilePath -> [Line] -> Property NoInfo -f `hasContent` newcontent = fileProperty ("replace " ++ f) +f `hasContent` newcontent = fileProperty + ("replace " ++ f) + (\_oldcontent -> newcontent) f + +-- | Replaces all the content of a file, ensuring that its modes do not +-- allow it to be read or written by anyone other than the current user +hasContentProtected :: FilePath -> [Line] -> Property NoInfo +f `hasContentProtected` newcontent = fileProperty' writeFileProtected + ("replace " ++ f) (\_oldcontent -> newcontent) f -- | Ensures a file has contents that comes from PrivData. -- cgit v1.2.3 From 9f4b3e0ed4de04ba5fb754ea45402465faf30783 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 20 Sep 2015 15:05:50 -0400 Subject: aiccu's init script doesn't support reload; restart it --- src/Propellor/Property/Aiccu.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Aiccu.hs b/src/Propellor/Property/Aiccu.hs index 519b8ce9..e8aaa7bb 100644 --- a/src/Propellor/Property/Aiccu.hs +++ b/src/Propellor/Property/Aiccu.hs @@ -1,6 +1,6 @@ module Propellor.Property.Aiccu ( installed, - reloaded, + restarted, confPath, UserName, TunnelId, @@ -15,8 +15,8 @@ import qualified Propellor.Property.File as File installed :: Property NoInfo installed = Apt.installed ["aiccu"] -reloaded :: Property NoInfo -reloaded = Service.reloaded "aiccu" +restarted :: Property NoInfo +restarted = Service.restarted "aiccu" confPath :: FilePath confPath = "/etc/aiccu.conf" @@ -28,7 +28,7 @@ config u t p = [ "protocol tic" , "server tic.sixxs.net" , "username " ++ u - , "password " ++ (privDataVal p) + , "password " ++ privDataVal p , "ipv6_interface sixxs" , "tunnel_id " ++ t , "daemonize true" @@ -40,7 +40,7 @@ config u t p = -- | Configures an ipv6 tunnel using sixxs.net, with the given TunneId -- and sixx.net UserName. hasConfig :: TunnelId -> UserName -> Property HasInfo -hasConfig t u = prop `onChange` reloaded +hasConfig t u = prop `onChange` restarted where prop = withSomePrivData [(Password (u++"/"++t)), (Password u)] (Context "aiccu") $ property "aiccu configured" . writeConfig -- cgit v1.2.3