propellor

propellor config for hosts.
git clone git://git.ricketyspace.net/propellor.git
Log | Files | Refs | LICENSE

Dns.hs (19603B)


      1 module Propellor.Property.Dns (
      2 	module Propellor.Types.Dns,
      3 	primary,
      4 	signedPrimary,
      5 	secondary,
      6 	secondaryFor,
      7 	mkSOA,
      8 	writeZoneFile,
      9 	nextSerialNumber,
     10 	adjustSerialNumber,
     11 	serialNumberOffset,
     12 	WarningMessage,
     13 	genZone,
     14 ) where
     15 
     16 import Propellor.Base
     17 import Propellor.Types.Dns
     18 import Propellor.Types.Info
     19 import Propellor.Property.File
     20 import qualified Propellor.Property.Apt as Apt
     21 import qualified Propellor.Property.Ssh as Ssh
     22 import qualified Propellor.Property.Service as Service
     23 import Propellor.Property.Scheduled
     24 import Propellor.Property.DnsSec
     25 import Utility.Applicative
     26 
     27 import qualified Data.Map as M
     28 import qualified Data.Set as S
     29 import qualified Data.List.Split as Split (chunksOf)
     30 import Data.List
     31 
     32 -- | Primary dns server for a domain, using bind.
     33 --
     34 -- Currently, this only configures bind to serve forward DNS, not reverse DNS.
     35 --
     36 -- Most of the content of the zone file is configured by setting properties
     37 -- of hosts. For example,
     38 --
     39 -- > host "foo.example.com"
     40 -- >   & ipv4 "192.168.1.1"
     41 -- >   & alias "mail.exmaple.com"
     42 --
     43 -- Will cause that hostmame and its alias to appear in the zone file,
     44 -- with the configured IP address.
     45 --
     46 -- Also, if a host has a ssh public key configured, a SSHFP record will
     47 -- be automatically generated for it.
     48 --
     49 -- The [(BindDomain, Record)] list can be used for additional records
     50 -- that cannot be configured elsewhere. This often includes NS records,
     51 -- TXT records and perhaps CNAMEs pointing at hosts that propellor does
     52 -- not control.
     53 --
     54 -- The primary server is configured to only allow zone transfers to
     55 -- secondary dns servers. These are determined in two ways:
     56 --
     57 -- 1. By looking at the properties of other hosts, to find hosts that
     58 -- are configured as the secondary dns server.
     59 --
     60 -- 2. By looking for NS Records in the passed list of records.
     61 --
     62 -- In either case, the secondary dns server Host should have an ipv4 and/or
     63 -- ipv6 property defined.
     64 primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty (HasInfo + DebianLike) DebianLike
     65 primary hosts domain soa rs = setup <!> cleanup
     66   where
     67 	setup = setupPrimary zonefile id hosts domain soa rs
     68 		`onChange` Service.reloaded "bind9"
     69 	cleanup = cleanupPrimary zonefile domain
     70 		`onChange` Service.reloaded "bind9"
     71 
     72 	zonefile = "/etc/bind/propellor/db." ++ domain
     73 
     74 setupPrimary :: FilePath -> (FilePath -> FilePath) -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property (HasInfo + DebianLike)
     75 setupPrimary zonefile mknamedconffile hosts domain soa rs =
     76 	withwarnings baseprop
     77 		`requires` servingZones
     78   where
     79 	hostmap = hostMap hosts
     80 	-- Known hosts with hostname located in the domain.
     81 	indomain = M.elems $ M.filterWithKey (\hn _ -> inDomain domain $ AbsDomain $ hn) hostmap
     82 
     83 	(partialzone, zonewarnings) = genZone indomain hostmap domain soa
     84 	baseprop = primaryprop
     85 		`setInfoProperty` (toInfo (addNamedConf conf))
     86 	primaryprop :: Property DebianLike
     87 	primaryprop = property ("dns primary for " ++ domain) $ do
     88 		sshfps <- concat <$> mapM (genSSHFP domain) (M.elems hostmap)
     89 		let zone = partialzone
     90 			{ zHosts = zHosts partialzone ++ rs ++ sshfps }
     91 		ifM (liftIO $ needupdate zone)
     92 			( makeChange $ writeZoneFile zone zonefile
     93 			, noChange
     94 			)
     95 	withwarnings p = adjustPropertySatisfy p $ \a -> do
     96 		mapM_ warningMessage $ zonewarnings ++ secondarywarnings
     97 		a
     98 	conf = NamedConf
     99 		{ confDomain = domain
    100 		, confDnsServerType = Master
    101 		, confFile = mknamedconffile zonefile
    102 		, confMasters = []
    103 		, confAllowTransfer = nub $
    104 			concatMap (`hostAddresses` hosts) $
    105 				secondaries ++ nssecondaries
    106 		, confLines = []
    107 		}
    108 	secondaries = otherServers Secondary hosts domain
    109 	secondarywarnings = map (\h -> "No IP address defined for DNS seconary " ++ h) $
    110 		filter (\h -> null (hostAddresses h hosts)) secondaries
    111 	nssecondaries = mapMaybe (domainHostName <=< getNS) rootRecords
    112 	rootRecords = map snd $
    113 		filter (\(d, _r) -> d == RootDomain || d == AbsDomain domain) rs
    114 	needupdate zone = do
    115 		v <- readZonePropellorFile zonefile
    116 		return $ case v of
    117 			Nothing -> True
    118 			Just oldzone ->
    119 				-- compare everything except serial
    120 				let oldserial = sSerialĀ (zSOA oldzone)
    121 				    z = zone { zSOA = (zSOA zone) { sSerial = oldserial } }
    122 				in z /= oldzone || oldserial < sSerial (zSOA zone)
    123 
    124 
    125 cleanupPrimary :: FilePath -> Domain -> Property DebianLike
    126 cleanupPrimary zonefile domain = check (doesFileExist zonefile) $
    127 	go `requires` namedConfWritten
    128   where
    129 	desc = "removed dns primary for " ++ domain
    130 	go :: Property DebianLike
    131 	go = property desc (makeChange $ removeZoneFile zonefile)
    132 
    133 -- | Primary dns server for a domain, secured with DNSSEC.
    134 --
    135 -- This is like `primary`, except the resulting zone
    136 -- file is signed.
    137 -- The Zone Signing Key (ZSK) and Key Signing Key (KSK)
    138 -- used in signing it are taken from the PrivData.
    139 --
    140 -- As a side effect of signing the zone, a
    141 -- </var/cache/bind/dsset-domain.>
    142 -- file will be created. This file contains the DS records
    143 -- which need to be communicated to your domain registrar
    144 -- to make DNSSEC be used for your domain. Doing so is outside
    145 -- the scope of propellor (currently). See for example the tutorial
    146 -- <https://www.digitalocean.com/community/tutorials/how-to-setup-dnssec-on-an-authoritative-bind-dns-server--2>
    147 --
    148 -- The 'Recurrance' controls how frequently the signature
    149 -- should be regenerated, using a new random salt, to prevent
    150 -- zone walking attacks. `Weekly Nothing` is a reasonable choice.
    151 --
    152 -- To transition from 'primary' to 'signedPrimary', you can revert
    153 -- the 'primary' property, and add this property.
    154 --
    155 -- Note that DNSSEC zone files use a serial number based on the unix epoch.
    156 -- This is different from the serial number used by 'primary', so if you
    157 -- want to later disable DNSSEC you will need to adjust the serial number
    158 -- passed to mkSOA to ensure it is larger.
    159 signedPrimary :: Recurrance -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty (HasInfo + DebianLike) DebianLike
    160 signedPrimary recurrance hosts domain soa rs = setup <!> cleanup
    161   where
    162 	setup = combineProperties ("dns primary for " ++ domain ++ " (signed)")
    163 		(props
    164 			& setupPrimary zonefile signedZoneFile hosts domain soa rs'
    165 			& zoneSigned domain zonefile
    166 			& forceZoneSigned domain zonefile `period` recurrance
    167 		)
    168 		`onChange` Service.reloaded "bind9"
    169 
    170 	cleanup = cleanupPrimary zonefile domain
    171 		`onChange` revert (zoneSigned domain zonefile)
    172 		`onChange` Service.reloaded "bind9"
    173 
    174 	-- Include the public keys into the zone file.
    175 	rs' = include PubKSK : include PubZSK : rs
    176 	include k = (RootDomain, INCLUDE (keyFn domain k))
    177 
    178 	-- Put DNSSEC zone files in a different directory than is used for
    179 	-- the regular ones. This allows 'primary' to be reverted and
    180 	-- 'signedPrimary' enabled, without the reverted property stomping
    181 	-- on the new one's settings.
    182 	zonefile = "/etc/bind/propellor/dnssec/db." ++ domain
    183 
    184 -- | Secondary dns server for a domain.
    185 --
    186 -- The primary server is determined by looking at the properties of other
    187 -- hosts to find which one is configured as the primary.
    188 --
    189 -- Note that if a host is declared to be a primary and a secondary dns
    190 -- server for the same domain, the primary server config always wins.
    191 secondary :: [Host] -> Domain -> RevertableProperty (HasInfo + DebianLike) DebianLike
    192 secondary hosts domain = secondaryFor (otherServers Master hosts domain) hosts domain
    193 
    194 -- | This variant is useful if the primary server does not have its DNS
    195 -- configured via propellor.
    196 secondaryFor :: [HostName] -> [Host] -> Domain -> RevertableProperty (HasInfo + DebianLike) DebianLike
    197 secondaryFor masters hosts domain = setup <!> cleanup
    198   where
    199 	setup = pureInfoProperty desc (addNamedConf conf)
    200 		`requires` servingZones
    201 	cleanup = namedConfWritten
    202 
    203 	desc = "dns secondary for " ++ domain
    204 	conf = NamedConf
    205 		{ confDomain = domain
    206 		, confDnsServerType = Secondary
    207 		, confFile = "db." ++ domain
    208 		, confMasters = concatMap (`hostAddresses` hosts) masters
    209 		, confAllowTransfer = []
    210 		, confLines = []
    211 		}
    212 
    213 otherServers :: DnsServerType -> [Host] -> Domain -> [HostName]
    214 otherServers wantedtype hosts domain =
    215 	M.keys $ M.filter wanted $ hostMap hosts
    216   where
    217 	wanted h = case M.lookup domain (fromNamedConfMap $ fromInfo $ hostInfo h) of
    218 		Nothing -> False
    219 		Just conf -> confDnsServerType conf == wantedtype
    220 			&& confDomain conf == domain
    221 
    222 -- | Rewrites the whole named.conf.local file to serve the zones
    223 -- configured by `primary` and `secondary`, and ensures that bind9 is
    224 -- running.
    225 servingZones :: Property DebianLike
    226 servingZones = namedConfWritten
    227 	`onChange` Service.reloaded "bind9"
    228 	`requires` Apt.serviceInstalledRunning "bind9"
    229 
    230 namedConfWritten :: Property DebianLike
    231 namedConfWritten = property' "named.conf configured" $ \w -> do
    232 	zs <- getNamedConf
    233 	ensureProperty w $
    234 		hasContent namedConfFile $
    235 			concatMap confStanza $ M.elems zs
    236 
    237 confStanza :: NamedConf -> [Line]
    238 confStanza c =
    239 	[ "// automatically generated by propellor"
    240 	, "zone \"" ++ confDomain c ++ "\" {"
    241 	, cfgline "type" (if confDnsServerType c == Master then "master" else "slave")
    242 	, cfgline "file" ("\"" ++ confFile c ++ "\"")
    243 	] ++
    244 	mastersblock ++
    245 	allowtransferblock ++
    246 	(map (\l -> "\t" ++ l ++ ";") (confLines c)) ++
    247 	[ "};"
    248 	, ""
    249 	]
    250   where
    251 	cfgline f v = "\t" ++ f ++ " " ++ v ++ ";"
    252 	ipblock name l =
    253 		[ "\t" ++ name ++ " {" ] ++
    254 		(map (\ip -> "\t\t" ++ val ip ++ ";") l) ++
    255 		[ "\t};" ]
    256 	mastersblock
    257 		| null (confMasters c) = []
    258 		| otherwise = ipblock "masters" (confMasters c)
    259 	-- an empty block prohibits any transfers
    260 	allowtransferblock = ipblock "allow-transfer" (confAllowTransfer c)
    261 
    262 namedConfFile :: FilePath
    263 namedConfFile = "/etc/bind/named.conf.local"
    264 
    265 -- | Generates a SOA with some fairly sane numbers in it.
    266 --
    267 -- The Domain is the domain to use in the SOA record. Typically
    268 -- something like ns1.example.com. So, not the domain that this is the SOA
    269 -- record for.
    270 --
    271 -- The SerialNumber can be whatever serial number was used by the domain
    272 -- before propellor started managing it. Or 0 if the domain has only ever
    273 -- been managed by propellor.
    274 --
    275 -- You do not need to increment the SerialNumber when making changes!
    276 -- Propellor will automatically add the number of commits in the git
    277 -- repository to the SerialNumber.
    278 mkSOA :: Domain -> SerialNumber -> SOA
    279 mkSOA d sn = SOA
    280 	{ sDomain = AbsDomain d
    281 	, sSerial = sn
    282 	, sRefresh = hours 4
    283 	, sRetry = hours 1
    284 	, sExpire = 2419200 -- 4 weeks
    285 	, sNegativeCacheTTL = hours 8
    286 	}
    287   where
    288 	hours n = n * 60 * 60
    289 
    290 dValue :: BindDomain -> String
    291 dValue (RelDomain d) = d
    292 dValue (AbsDomain d) = d ++ "."
    293 dValue (RootDomain) = "@"
    294 
    295 rField :: Record -> Maybe String
    296 rField (Address (IPv4 _)) = Just "A"
    297 rField (Address (IPv6 _)) = Just "AAAA"
    298 rField (CNAME _) = Just "CNAME"
    299 rField (MX _ _) = Just "MX"
    300 rField (NS _) = Just "NS"
    301 rField (TXT _) = Just "TXT"
    302 rField (SRV _ _ _ _) = Just "SRV"
    303 rField (SSHFP _ _ _) = Just "SSHFP"
    304 rField (INCLUDE _) = Just "$INCLUDE"
    305 rField (PTR _) = Nothing
    306 
    307 rValue :: Record -> Maybe String
    308 rValue (Address (IPv4 addr)) = Just addr
    309 rValue (Address (IPv6 addr)) = Just addr
    310 rValue (CNAME d) = Just $ dValue d
    311 rValue (MX pri d) = Just $ val pri ++ " " ++ dValue d
    312 rValue (NS d) = Just $ dValue d
    313 rValue (SRV priority weight port target) = Just $ unwords
    314 	[ val priority
    315 	, val weight
    316 	, val port
    317 	, dValue target
    318 	]
    319 rValue (SSHFP x y s) = Just $ unwords
    320 	[ val x
    321 	, val y
    322 	, s
    323 	]
    324 rValue (INCLUDE f) = Just f
    325 rValue (TXT s) = Just $ zoneFileString s
    326 rValue (PTR _) = Nothing
    327 
    328 -- Bind has a limit on the length of a string in its zone file,
    329 -- but a string can be split into sections that are glued together
    330 -- inside parens to configure a longer value.
    331 --
    332 -- This adds quotes around each substring.
    333 zoneFileString :: String -> String
    334 zoneFileString s = concat
    335 	[ [op, w]
    336 	, (intercalate "\n\t" $
    337 		map (\x -> [q] ++ filter (/= q) x ++ [q]) $
    338 		Split.chunksOf 255 s)
    339 	, [w, cp]
    340 	]
    341   where
    342 	op = '('
    343 	cp = ')'
    344 	w = ' '
    345 	q = '"'
    346 
    347 -- | Adjusts the serial number of the zone to always be larger
    348 -- than the serial number in the Zone record,
    349 -- and always be larger than the passed SerialNumber.
    350 nextSerialNumber :: Zone -> SerialNumber -> Zone
    351 nextSerialNumber z serial = adjustSerialNumber z $ \sn -> succ $ max sn serial
    352 
    353 adjustSerialNumber :: Zone -> (SerialNumber -> SerialNumber) -> Zone
    354 adjustSerialNumber (Zone d soa l) f = Zone d soa' l
    355   where
    356 	soa' = soa { sSerial = f (sSerial soa) }
    357 
    358 -- | Count the number of git commits made to the current branch.
    359 serialNumberOffset :: IO SerialNumber
    360 serialNumberOffset = fromIntegral . length . lines
    361 	<$> readProcess "git" ["log", "--pretty=%H"]
    362 
    363 -- | Write a Zone out to a to a file.
    364 --
    365 -- The serial number in the Zone automatically has the serialNumberOffset
    366 -- added to it. Also, just in case, the old serial number used in the zone
    367 -- file is checked, and if it is somehow larger, its succ is used.
    368 writeZoneFile :: Zone -> FilePath -> IO ()
    369 writeZoneFile z f = do
    370 	oldserial <- oldZoneFileSerialNumber f
    371 	offset <- serialNumberOffset
    372 	let z' = nextSerialNumber
    373 		(adjustSerialNumber z (+ offset))
    374 		oldserial
    375 	createDirectoryIfMissing True (takeDirectory f)
    376 	writeFile f (genZoneFile z')
    377 	writeZonePropellorFile f z'
    378 
    379 removeZoneFile :: FilePath -> IO ()
    380 removeZoneFile f = do
    381 	nukeFile f
    382 	nukeFile (zonePropellorFile f)
    383 
    384 -- | Next to the zone file, is a ".propellor" file, which contains
    385 -- the serialized Zone. This saves the bother of parsing
    386 -- the horrible bind zone file format.
    387 zonePropellorFile :: FilePath -> FilePath
    388 zonePropellorFile f = f ++ ".propellor"
    389 
    390 oldZoneFileSerialNumber :: FilePath -> IO SerialNumber
    391 oldZoneFileSerialNumber = maybe 0 (sSerial . zSOA) <$$> readZonePropellorFile
    392 
    393 writeZonePropellorFile :: FilePath -> Zone -> IO ()
    394 writeZonePropellorFile f z = writeFile (zonePropellorFile f) (show z)
    395 
    396 readZonePropellorFile :: FilePath -> IO (Maybe Zone)
    397 readZonePropellorFile f = catchDefaultIO Nothing $
    398 	readish <$> readFileStrict (zonePropellorFile f)
    399 
    400 -- | Generating a zone file.
    401 genZoneFile :: Zone -> String
    402 genZoneFile (Zone zdomain soa rs) = unlines $
    403 	header : genSOA soa ++ mapMaybe (genRecord zdomain) rs
    404   where
    405 	header = com $ "BIND zone file for " ++ zdomain ++ ". Generated by propellor, do not edit."
    406 
    407 genRecord :: Domain -> (BindDomain, Record) -> Maybe String
    408 genRecord zdomain (domain, record) = case (rField record, rValue record) of
    409 	(Nothing, _) -> Nothing
    410 	(_, Nothing) -> Nothing
    411 	(Just rfield, Just rvalue) -> Just $ intercalate "\t" $ case record of
    412 		INCLUDE _ -> [ rfield, rvalue ]
    413 		_ ->
    414 			[ domainHost zdomain domain
    415 			, "IN"
    416 			, rfield
    417 			, rvalue
    418 			]
    419 
    420 genSOA :: SOA -> [String]
    421 genSOA soa =
    422 	-- "@ IN SOA ns1.example.com. root ("
    423 	[ intercalate "\t"
    424 		[ dValue RootDomain
    425 		, "IN"
    426 		, "SOA"
    427 		, dValue (sDomain soa)
    428 		, "root"
    429 		, "("
    430 		]
    431 	, headerline sSerial "Serial"
    432 	, headerline sRefresh "Refresh"
    433 	, headerline sRetry "Retry"
    434 	, headerline sExpire "Expire"
    435 	, headerline sNegativeCacheTTL "Negative Cache TTL"
    436 	, inheader ")"
    437 	]
    438   where
    439 	headerline r comment = inheader $ show (r soa) ++ "\t\t" ++ com comment
    440 	inheader l = "\t\t\t" ++ l
    441 
    442 -- | Comment line in a zone file.
    443 com :: String -> String
    444 com s = "; " ++ s
    445 
    446 type WarningMessage = String
    447 
    448 -- | Generates a Zone for a particular Domain from the DNS properies of all
    449 -- hosts that propellor knows about that are in that Domain.
    450 --
    451 -- Does not include SSHFP records.
    452 genZone :: [Host] -> M.Map HostName Host -> Domain -> SOA -> (Zone, [WarningMessage])
    453 genZone inzdomain hostmap zdomain soa =
    454 	let (warnings, zhosts) = partitionEithers $ concatMap concat
    455 		[ map hostips inzdomain
    456 		, map hostrecords inzdomain
    457 		, map addcnames (M.elems hostmap)
    458 		]
    459 	in (Zone zdomain soa (simplify zhosts), warnings)
    460   where
    461 	-- Each host with a hostname located in the zdomain
    462 	-- should have 1 or more IPAddrs in its Info.
    463 	--
    464 	-- If a host lacks any IPAddr, it's probably a misconfiguration,
    465 	-- so warn.
    466 	hostips :: Host -> [Either WarningMessage (BindDomain, Record)]
    467 	hostips h
    468 		| null l = [Left $ "no IP address defined for host " ++ hostName h]
    469 		| otherwise = map Right l
    470 	  where
    471 		info = hostInfo h
    472 		l = zip (repeat $ AbsDomain $ hostName h)
    473 			(map Address $ getAddresses info)
    474 
    475 	-- Any host, whether its hostname is in the zdomain or not,
    476 	-- may have cnames which are in the zdomain. The cname may even be
    477 	-- the same as the root of the zdomain, which is a nice way to
    478 	-- specify IP addresses for a SOA record.
    479 	--
    480 	-- Add Records for those.. But not actually, usually, cnames!
    481 	-- Why not? Well, using cnames doesn't allow doing some things,
    482 	-- including MX and round robin DNS, and certianly CNAMES
    483 	-- shouldn't be used in SOA records.
    484 	--
    485 	-- We typically know the host's IPAddrs anyway.
    486 	-- So we can just use the IPAddrs.
    487 	addcnames :: Host -> [Either WarningMessage (BindDomain, Record)]
    488 	addcnames h = concatMap gen $ filter (inDomain zdomain) $
    489 		mapMaybe getCNAME $ S.toList $ getDnsInfo info
    490 	  where
    491 		info = hostInfo h
    492 		gen c = case getAddresses info of
    493 			[] -> [ret (CNAME c)]
    494 			l -> map (ret . Address) l
    495 		  where
    496 			ret record = Right (c, record)
    497 
    498 	-- Adds any other DNS records for a host located in the zdomain.
    499 	hostrecords :: Host -> [Either WarningMessage (BindDomain, Record)]
    500 	hostrecords h = map Right l
    501 	  where
    502 		info = hostInfo h
    503 		l = zip (repeat $ AbsDomain $ hostName h)
    504 			(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (getDnsInfo info))
    505 
    506 	-- Simplifies the list of hosts. Remove duplicate entries.
    507 	-- Also, filter out any CHAMES where the same domain has an
    508 	-- IP address, since that's not legal.
    509 	simplify :: [(BindDomain, Record)] -> [(BindDomain, Record)]
    510 	simplify l = nub $ filter (not . dupcname ) l
    511 	  where
    512 		dupcname (d, CNAME _) | any (matchingaddr d) l = True
    513 		dupcname _ = False
    514 		matchingaddr d (d', (Address _)) | d == d' = True
    515 		matchingaddr _ _ = False
    516 
    517 inDomain :: Domain -> BindDomain -> Bool
    518 inDomain domain (AbsDomain d) = domain == d || ('.':domain) `isSuffixOf` d
    519 inDomain _ _ = False -- can't tell, so assume not
    520 
    521 -- | Gets the hostname of the second domain, relative to the first domain,
    522 -- suitable for using in a zone file.
    523 domainHost :: Domain -> BindDomain -> String
    524 domainHost _ (RelDomain d) = d
    525 domainHost _ RootDomain = "@"
    526 domainHost base (AbsDomain d)
    527 	| dotbase `isSuffixOf` d = take (length d - length dotbase) d
    528 	| base == d = "@"
    529 	| otherwise = d
    530   where
    531 	dotbase = '.':base
    532 
    533 addNamedConf :: NamedConf -> NamedConfMap
    534 addNamedConf conf = NamedConfMap (M.singleton domain conf)
    535   where
    536 	domain = confDomain conf
    537 
    538 getNamedConf :: Propellor (M.Map Domain NamedConf)
    539 getNamedConf = asks $ fromNamedConfMap . fromInfo . hostInfo
    540 
    541 -- | Generates SSHFP records for hosts in the domain (or with CNAMES
    542 -- in the domain) that have configured ssh public keys.
    543 --
    544 -- This is done using ssh-keygen, so sadly needs IO.
    545 genSSHFP :: Domain -> Host -> Propellor [(BindDomain, Record)]
    546 genSSHFP domain h = concatMap mk . concat <$> (gen =<< get)
    547   where
    548 	get = fromHost [h] hostname Ssh.getHostPubKey
    549 	gen = liftIO . mapM genSSHFP' . M.elems . fromMaybe M.empty
    550 	mk r = mapMaybe (\d -> if inDomain domain d then Just (d, r) else Nothing)
    551 		(AbsDomain hostname : cnames)
    552 	cnames = mapMaybe getCNAME $ S.toList $ getDnsInfo info
    553 	hostname = hostName h
    554 	info = hostInfo h
    555 
    556 genSSHFP' :: String -> IO [Record]
    557 genSSHFP' pubkey = withTmpFile "sshfp" $ \tmp tmph -> do
    558 		hPutStrLn tmph pubkey
    559 		hClose tmph
    560 		s <- catchDefaultIO "" $
    561 			readProcess "ssh-keygen" ["-r", "dummy", "-f", tmp]
    562 		return $ mapMaybe (parse . words) $ lines s
    563   where
    564 	parse ("dummy":"IN":"SSHFP":x:y:s:[]) = do
    565 		x' <- readish x
    566 		y' <- readish y
    567 		return $ SSHFP x' y' s
    568 	parse _ = Nothing