Add version of getFQDN accepting preferences

Still the best way to get the "canonical name" of a host
is to look up its host name and reverse look up the IP
address obtained. Obviously, that the result depends
on the protocol family used. So accept hints on which
family to prefer.

Note that getFQDN is exported on higher branches, so we
keep its type stable to avoid semantic merge conflicts.

Signed-off-by: Klaus Aehlig <aehlig@google.com>
Reviewed-by: Helga Velroyen <helgav@google.com>

diff --git a/src/Ganeti/Daemon.hs b/src/Ganeti/Daemon.hs
index d6a98db..80cbc76 100644 (file)
--- a/src/Ganeti/Daemon.hs
+++ b/src/Ganeti/Daemon.hs
@@ -308,10 +308,10 @@ vClusterHostNameEnvVar :: String
 vClusterHostNameEnvVar = "GANETI_HOSTNAME"
 
 -- | Get the real full qualified host name.
-getFQDN' :: IO String
-getFQDN' = do
+getFQDN' :: Maybe Socket.AddrInfo -> IO String
+getFQDN' hints = do
   hostname <- getHostName
-  addrInfos <- Socket.getAddrInfo Nothing (Just hostname) Nothing
+  addrInfos <- Socket.getAddrInfo hints (Just hostname) Nothing
   let address = listToMaybe addrInfos >>= (Just . Socket.addrAddress)
   case address of
     Just a -> do
@@ -319,9 +319,10 @@ getFQDN' = do
       return (fromMaybe hostname fqdn)
     Nothing -> return hostname
 
--- | Return the full qualified host name, honoring the vcluster setup.
-getFQDN :: IO String
-getFQDN = do
+-- | Return the full qualified host name, honoring the vcluster setup
+-- and hints on the preferred socket type or protocol.
+getFQDNwithHints :: Maybe Socket.AddrInfo -> IO String
+getFQDNwithHints hints = do
   let ioErrorToNothing :: IOError -> IO (Maybe String)
       ioErrorToNothing _ = return Nothing
   vcluster_node <- Control.Exception.catch
@@ -329,7 +330,11 @@ getFQDN = do
                      ioErrorToNothing
   case vcluster_node of
     Just node_name -> return node_name
-    Nothing -> getFQDN'
+    Nothing -> getFQDN' hints
+
+-- | Return the full qualified host name, honoring the vcluster setup.
+getFQDN :: IO String
+getFQDN = getFQDNwithHints Nothing
 
 -- | Returns if the current node is the master node.
 isMaster :: IO Bool