This commit is contained in:
Joey Hess 2015-01-04 12:44:05 -04:00
parent a1f61e09b8
commit 8172f243d7
6 changed files with 109 additions and 17 deletions

View File

@ -64,6 +64,7 @@ addDNS r = pureInfoProperty (rdesc r) $ mempty { _dns = S.singleton r }
rdesc (NS d) = unwords ["NS", ddesc d]
rdesc (TXT s) = unwords ["TXT", s]
rdesc (SRV x y z d) = unwords ["SRV", show x, show y, show z, ddesc d]
rdesc (INCLUDE f) = unwords ["$INCLUDE", f]
ddesc (AbsDomain domain) = domain
ddesc (RelDomain domain) = domain

View File

@ -3,7 +3,7 @@ module Propellor.PrivData.Paths where
import System.FilePath
privDataDir :: FilePath
privDataDir = "privdata.joey"
privDataDir = "privdata"
privDataFile :: FilePath
privDataFile = privDataDir </> "privdata.gpg"

View File

@ -26,8 +26,7 @@ propertyList :: Desc -> [Property] -> Property
propertyList desc ps = Property desc (ensureProperties ps) (combineInfos ps)
-- | Combines a list of properties, resulting in one property that
-- ensures each in turn. Does not stop on failure; does propigate
-- overall success/failure.
-- ensures each in turn. Stops if a property fails.
combineProperties :: Desc -> [Property] -> Property
combineProperties desc ps = Property desc (go ps NoChange) (combineInfos ps)
where

View File

@ -56,18 +56,18 @@ import Data.List
primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty
primary hosts domain soa rs = RevertableProperty setup cleanup
where
setup = withwarnings (check needupdate baseprop)
`requires` servingZones
setup = setupPrimary hosts domain soa rs
`onChange` Service.reloaded "bind9"
cleanup = cleanupPrimary domain
`onChange` Service.reloaded "bind9"
cleanup = check (doesFileExist zonefile) $
property ("removed dns primary for " ++ domain)
(makeChange $ removeZoneFile zonefile)
`requires` namedConfWritten
`onChange` Service.reloaded "bind9"
setupPrimary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property
setupPrimary hosts domain soa rs = withwarnings (check needupdate baseprop)
`requires` servingZones
where
(partialzone, zonewarnings) = genZone hosts domain soa
zone = partialzone { zHosts = zHosts partialzone ++ rs }
zonefile = "/etc/bind/propellor/db." ++ domain
zonefile = zoneFile domain
baseprop = Property ("dns primary for " ++ domain)
(makeChange $ writeZoneFile zone zonefile)
(addNamedConf conf)
@ -100,6 +100,18 @@ primary hosts domain soa rs = RevertableProperty setup cleanup
z = zone { zSOA = (zSOA zone) { sSerial = oldserial } }
in z /= oldzone || oldserial < sSerial (zSOA zone)
cleanupPrimary :: Domain -> Property
cleanupPrimary domain = check (doesFileExist zonefile) $
property ("removed dns primary for " ++ domain)
(makeChange $ removeZoneFile zonefile)
`requires` namedConfWritten
where
zonefile = zoneFile domain
zoneFile :: Domain -> FilePath
zoneFile domain = "/etc/bind/propellor/db." ++ domain
-- | Primary dns server for a domain, secured with DNSSEC.
--
-- This is like `primary`, except the resulting zone
@ -121,8 +133,24 @@ primary hosts domain soa rs = RevertableProperty setup cleanup
signedPrimary :: Recurrance -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty
signedPrimary recurrance hosts domain soa rs = RevertableProperty setup cleanup
where
setup = undefined
cleanup = undefined
-- TODO put signed zone file in named.conf.
-- TODO enable dnssec options.
-- dnssec-enable yes; dnssec-validation yes; dnssec-lookaside auto;
-- TODO if keys change, resign zone file.
-- TODO write to entirely different files than does primary,
-- so that primary can be reverted and signedPrimary enabled,
-- or vice-versa, without conflicts.
setup = setupPrimary hosts domain soa rs'
`onChange` toProp (zoneSigned domain (zoneFile domain))
`onChange` Service.reloaded "bind9"
cleanup = cleanupPrimary domain
`onChange` toProp (revert (zoneSigned domain (zoneFile domain)))
`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))
-- | Secondary dns server for a domain.
--
@ -243,6 +271,7 @@ rField (MX _ _) = "MX"
rField (NS _) = "NS"
rField (TXT _) = "TXT"
rField (SRV _ _ _ _) = "SRV"
rField (INCLUDE _) = "$INCLUDE"
rValue :: Record -> String
rValue (Address (IPv4 addr)) = addr
@ -256,6 +285,7 @@ rValue (SRV priority weight port target) = unwords
, show port
, dValue target
]
rValue (INCLUDE f) = f
rValue (TXT s) = [q] ++ filter (/= q) s ++ [q]
where
q = '"'

View File

@ -1,7 +1,7 @@
module Propellor.Property.DnsSec where
import Propellor
import Propellor.Property.File
import qualified Propellor.Property.File as File
-- | Puts the DNSSEC key files in place from PrivData.
--
@ -14,10 +14,13 @@ keysInstalled domain = RevertableProperty setup cleanup
map installkey keys
cleanup = propertyList "DNSSEC keys removed" $
map (notPresent . keyFn domain) keys
map (File.notPresent . keyFn domain) keys
installkey k = (if isPublic k then hasPrivContentExposedFrom else hasPrivContentFrom)
(keysrc k) (keyFn domain k) (Context domain)
installkey k = writer (keysrc k) (keyFn domain k) (Context domain)
where
writer
| isPublic k = File.hasPrivContentExposedFrom
| otherwise = File.hasPrivContentFrom
keys = [ PubZSK, PrivZSK, PubKSK, PrivKSK ]
@ -30,6 +33,64 @@ keysInstalled domain = RevertableProperty setup cleanup
else "dnssec-keygen -f KSK -a RSASHA256 -b 4096 -n ZONE " ++ domain
]
-- | Uses dnssec-signzone to sign a domain's zone file.
--
-- signedPrimary uses this, so this property does not normally need to be
-- used directly.
zoneSigned :: Domain -> FilePath -> RevertableProperty
zoneSigned domain zonefile = RevertableProperty setup cleanup
where
setup = check needupdate (forceZoneSigned domain zonefile)
`requires` toProp (keysInstalled domain)
cleanup = combineProperties ("removed signed zone for " ++ domain)
[ File.notPresent signedzonefile
, File.notPresent dssetfile
, toProp (revert (keysInstalled domain))
]
signedzonefile = dir </> domain ++ ".signed"
dssetfile = dir </> "-" ++ domain ++ "."
dir = takeDirectory zonefile
-- Need to update the signed zone if the zone file
-- has a newer timestamp.
needupdate = do
v <- catchMaybeIO $ getModificationTime signedzonefile
case v of
Nothing -> return True
Just t1 -> do
t2 <- getModificationTime zonefile
return (t2 >= t1)
forceZoneSigned :: Domain -> FilePath -> Property
forceZoneSigned domain zonefile = property ("zone signed for " ++ domain) $ liftIO $ do
salt <- take 16 <$> saltSha1
let p = proc "dnssec-signzone"
[ "-A"
, "-3", salt
, "-N", "keep"
, "-o", domain
, zonefile
-- the ordering of these key files does not matter
, keyFn domain PubZSK
, keyFn domain PubKSK
]
-- Run in the same directory as the zonefile, so it will
-- write the dsset file there.
(_, _, _, h) <- createProcess $
p { cwd = Just (takeDirectory zonefile) }
ifM (checkSuccessProcess h)
( return MadeChange
, return FailedChange
)
saltSha1 :: IO String
saltSha1 = readProcess "sh"
[ "-c"
, "head -c 1024 /dev/urandom | sha1sum | cut -d ' ' -f 1"
]
-- | The file used for a given key.
keyFn :: Domain -> DnsSecKey -> FilePath
keyFn domain k = "/etc/bind/propellor" </>

View File

@ -62,6 +62,7 @@ data Record
| NS BindDomain
| TXT String
| SRV Word16 Word16 Word16 BindDomain
| INCLUDE FilePath
deriving (Read, Show, Eq, Ord)
getIPAddr :: Record -> Maybe IPAddr