Merge branch 'joeyconfig'

debian/changelog

@@ -13,6 +13,8 @@ propellor (2.5.0) UNRELEASED; urgency=medium
   * Fix Postfix.satellite bug; the default relayhost was set to the
     domain, not to smtp.domain as documented.
   * Mount /proc inside a chroot before provisioning it, to work around #787227
+  * --spin now works when given a short hostname that only resolves to an
+    ipv6 address.
 
  -- Joey Hess <id@joeyh.name>  Thu, 07 May 2015 12:08:34 -0400
 

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"

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