From 04f2fe947e72802c06e8463a1c3986927560237e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 4 Jan 2015 21:15:01 -0400 Subject: reorg --- src/Propellor/Property/Dns.hs | 50 +++++++++++++++++++++---------------------- 1 file changed, 25 insertions(+), 25 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs index 7b1fbcc5..f3f9cc40 100644 --- a/src/Propellor/Property/Dns.hs +++ b/src/Propellor/Property/Dns.hs @@ -417,31 +417,6 @@ com s = "; " ++ s type WarningMessage = String --- | Generates SSHFP records for hosts that have configured --- ssh public keys. --- --- This is done using ssh-keygen, so sadly needs IO. -genSSHFP :: Host -> Propellor [(BindDomain, Record)] -genSSHFP h = map (\r -> (AbsDomain hostname, r)) . concat <$> (gen =<< get) - where - hostname = hostName h - get = fromHost [h] hostname Ssh.getPubKey - gen = liftIO . mapM genSSHFP' . M.elems . fromMaybe M.empty - -genSSHFP' :: String -> IO [Record] -genSSHFP' pubkey = withTmpFile "sshfp" $ \tmp tmph -> do - hPutStrLn tmph pubkey - hClose tmph - s <- catchDefaultIO "" $ - readProcess "ssh-keygen" ["-r", "dummy", "-f", tmp] - return $ mapMaybe (parse . words) $ lines s - where - parse ("dummy":"IN":"SSHFP":x:y:s:[]) = do - x' <- readish x - y' <- readish y - return $ SSHFP x' y' s - parse _ = Nothing - -- | Generates a Zone for a particular Domain from the DNS properies of all -- hosts that propellor knows about that are in that Domain. -- @@ -534,3 +509,28 @@ addNamedConf conf = mempty { _namedconf = NamedConfMap (M.singleton domain conf) getNamedConf :: Propellor (M.Map Domain NamedConf) getNamedConf = asks $ fromNamedConfMap . _namedconf . hostInfo + +-- | Generates SSHFP records for hosts that have configured +-- ssh public keys. +-- +-- This is done using ssh-keygen, so sadly needs IO. +genSSHFP :: Host -> Propellor [(BindDomain, Record)] +genSSHFP h = map (\r -> (AbsDomain hostname, r)) . concat <$> (gen =<< get) + where + hostname = hostName h + get = fromHost [h] hostname Ssh.getPubKey + gen = liftIO . mapM genSSHFP' . M.elems . fromMaybe M.empty + +genSSHFP' :: String -> IO [Record] +genSSHFP' pubkey = withTmpFile "sshfp" $ \tmp tmph -> do + hPutStrLn tmph pubkey + hClose tmph + s <- catchDefaultIO "" $ + readProcess "ssh-keygen" ["-r", "dummy", "-f", tmp] + return $ mapMaybe (parse . words) $ lines s + where + parse ("dummy":"IN":"SSHFP":x:y:s:[]) = do + x' <- readish x + y' <- readish y + return $ SSHFP x' y' s + parse _ = Nothing -- cgit v1.2.3