summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
authorJoey Hess2015-05-30 13:58:00 -0400
committerJoey Hess2015-05-30 13:58:00 -0400
commit433bf00a55e1fd7402a410793ba68976a775fac7 (patch)
tree69a0fb558e005b1844d12f15867a9fc034dc3afb /src/Propellor
parentaa7dcad9ba8d14013f26f6e8554901d56ef4cb5c (diff)
--spin now works when given a short hostname that only resolves to an ipv6 address.
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/CmdLine.hs18
-rw-r--r--src/Propellor/Spin.hs23
2 files changed, 25 insertions, 16 deletions
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