diff --git a/htools/Ganeti/Daemon.hs b/htools/Ganeti/Daemon.hs index 84568f975bca53e7f86a477c9bf8cf69dbe9ff9b..155afa47eb330dc84526e36051c6121a984278ee 100644 --- a/htools/Ganeti/Daemon.hs +++ b/htools/Ganeti/Daemon.hs @@ -33,7 +33,9 @@ module Ganeti.Daemon , oNoUserChecks , oDebug , oPort + , oBindAddress , parseArgs + , parseAddress , writePidFile , genericMain ) where @@ -41,6 +43,7 @@ module Ganeti.Daemon import Control.Monad import qualified Data.Version import Data.Word +import qualified Network.Socket as Socket import System.Console.GetOpt import System.Exit import System.Environment @@ -59,6 +62,7 @@ import Ganeti.BasicTypes import Ganeti.HTools.Utils import qualified Ganeti.HTools.Version as Version(version) import qualified Ganeti.Constants as C +import qualified Ganeti.Ssconf as Ssconf -- * Data types @@ -70,6 +74,7 @@ data DaemonOptions = DaemonOptions , optPort :: Maybe Word16 -- ^ Override for the network port , optDebug :: Bool -- ^ Enable debug messages , optNoUserChecks :: Bool -- ^ Ignore user checks + , optBindAddress :: Maybe String -- ^ Override for the bind address } -- | Default values for the command line options. @@ -81,6 +86,7 @@ defaultOptions = DaemonOptions , optPort = Nothing , optDebug = False , optNoUserChecks = False + , optBindAddress = Nothing } -- | Abrreviation for the option type. @@ -130,6 +136,12 @@ oPort def = Option "p" ["port"] (\port opts -> Ok opts { optPort = Just port }) "PORT") ("Network port (default: " ++ show def ++ ")") +oBindAddress :: OptType +oBindAddress = Option "b" ["bind"] + (ReqArg (\addr opts -> Ok opts { optBindAddress = Just addr }) + "ADDR") + "Bind address (default depends on cluster configuration)" + -- | Usage info. usageHelp :: String -> [OptType] -> String usageHelp progname = @@ -194,6 +206,46 @@ setupDaemonEnv cwd umask = do _ <- createSession return () +-- | Computes the default bind address for a given family. +defaultBindAddr :: Int -- ^ The port we want + -> Socket.Family -- ^ The cluster IP family + -> Result (Socket.Family, Socket.SockAddr) +defaultBindAddr port Socket.AF_INET = + Ok $ (Socket.AF_INET, + Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY) +defaultBindAddr port Socket.AF_INET6 = + Ok $ (Socket.AF_INET6, + Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0) +defaultBindAddr _ fam = Bad $ "Unsupported address family: " ++ show fam + +-- | Default hints for the resolver +resolveAddrHints :: Maybe Socket.AddrInfo +resolveAddrHints = + Just Socket.defaultHints { Socket.addrFlags = [Socket.AI_NUMERICHOST, + Socket.AI_NUMERICSERV] } + +-- | Resolves a numeric address. +resolveAddr :: Int -> String -> IO (Result (Socket.Family, Socket.SockAddr)) +resolveAddr port str = do + resolved <- Socket.getAddrInfo resolveAddrHints (Just str) (Just (show port)) + return $ case resolved of + [] -> Bad "Invalid results from lookup?" + best:_ -> Ok $ (Socket.addrFamily best, Socket.addrAddress best) + +-- | Based on the options, compute the socket address to use for the +-- daemon. +parseAddress :: DaemonOptions -- ^ Command line options + -> Int -- ^ Default port for this daemon + -> IO (Result (Socket.Family, Socket.SockAddr)) +parseAddress opts defport = do + let port = maybe defport fromIntegral $ optPort opts + def_family <- Ssconf.getPrimaryIPFamily Nothing + ainfo <- case optBindAddress opts of + Nothing -> return (def_family >>= defaultBindAddr port) + Just saddr -> catch (resolveAddr port saddr) + (annotateIOError $ "Invalid address " ++ saddr) + return ainfo + -- | Run an I/O action as a daemon. -- -- WARNING: this only works in single-threaded mode (either using the