From 433bf00a55e1fd7402a410793ba68976a775fac7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 30 May 2015 13:58:00 -0400 Subject: --spin now works when given a short hostname that only resolves to an ipv6 address. --- src/Propellor/CmdLine.hs | 18 ++++++++++++------ src/Propellor/Spin.hs | 23 +++++++++++++---------- 2 files changed, 25 insertions(+), 16 deletions(-) (limited to 'src') diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 219fe026..d29ffbb7 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -7,7 +7,7 @@ import System.Environment (getArgs) import Data.List import System.Exit import System.PosixCompat -import qualified Network.BSD +import Network.Socket import Propellor import Propellor.Gpg @@ -165,9 +165,15 @@ updateFirst' cmdline next = ifM fetchOrigin , next ) +-- Gets the fully qualified domain name, given a string that might be +-- a short name to look up in the DNS. hostname :: String -> IO HostName -hostname s - | "." `isInfixOf` s = pure s - | otherwise = do - h <- Network.BSD.getHostByName s - return (Network.BSD.hostName h) +hostname s = go =<< catchDefaultIO [] dnslookup + where + dnslookup = getAddrInfo (Just canonname) (Just s) Nothing + canonname = defaultHints { addrFlags = [AI_CANONNAME] } + go (AddrInfo { addrCanonName = Just v } : _) = pure v + go _ + | "." `isInfixOf` s = pure s -- assume it's a fqdn + | otherwise = + error $ "cannot find host " ++ s ++ " in the DNS" diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index 986305d7..3ff1ec21 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -14,8 +14,7 @@ import System.Posix.Directory import Control.Concurrent.Async import qualified Data.ByteString as B import qualified Data.Set as S -import qualified Network.BSD as BSD -import Network.Socket (inet_ntoa) +import Network.Socket (getAddrInfo, defaultHints, AddrInfo(..), AddrInfoFlag(..), SockAddr) import Propellor import Propellor.Protocol @@ -98,17 +97,21 @@ spin target relay hst = do getSshTarget :: HostName -> Host -> IO String getSshTarget target hst | null configips = return target - | otherwise = go =<< tryIO (BSD.getHostByName target) + | otherwise = go =<< tryIO (dnslookup target) where go (Left e) = useip (show e) - go (Right hostentry) = ifM (anyM matchingconfig (BSD.hostAddresses hostentry)) - ( return target - , do - ips <- mapM inet_ntoa (BSD.hostAddresses hostentry) - useip ("DNS " ++ show ips ++ " vs configured " ++ show configips) - ) + go (Right addrinfos) = do + configaddrinfos <- catMaybes <$> mapM iptoaddr configips + if any (`elem` configaddrinfos) (map addrAddress addrinfos) + then return target + else useip ("DNS lookup did not return any of the expected addresses " ++ show configips) - matchingconfig a = flip elem configips <$> inet_ntoa a + dnslookup h = getAddrInfo (Just $ defaultHints { addrFlags = [AI_CANONNAME] }) (Just h) Nothing + + -- Convert a string containing an IP address into a SockAddr. + iptoaddr :: String -> IO (Maybe SockAddr) + iptoaddr ip = catchDefaultIO Nothing $ headMaybe . map addrAddress + <$> getAddrInfo (Just $ defaultHints { addrFlags = [AI_NUMERICHOST] }) (Just ip) Nothing useip why = case headMaybe configips of Nothing -> return target -- cgit v1.2.3