( Options(..)
, OptType
, parseOpts
- , parseEnv
, shTemplate
- , loadExternalData
- , defaultLuxiSocket
-- * The options
, oPrintNodes
+ , oPrintInsts
, oPrintCommands
, oOneline
, oNoHeaders
, oNodeSim
, oRapiMaster
, oLuxiSocket
+ , oExecJobs
, oMaxSolLength
, oVerbose
, oQuiet
, oINodes
, oMaxCpu
, oMinDisk
+ , oDiskMoves
+ , oDynuFile
+ , oTieredSpec
, oShowVer
, oShowHelp
) where
-import Control.Exception
-import Data.Maybe (isJust, fromJust, fromMaybe)
+import Data.Maybe (fromMaybe)
import qualified Data.Version
import Monad
import System.Console.GetOpt
-import System.Posix.Env
import System.IO
import System.Info
import System
-import Text.Printf (printf, hPrintf)
+import Text.Printf (printf)
import qualified Ganeti.HTools.Version as Version(version)
-import qualified Ganeti.HTools.Luxi as Luxi
-import qualified Ganeti.HTools.Rapi as Rapi
-import qualified Ganeti.HTools.Simu as Simu
-import qualified Ganeti.HTools.Text as Text
-import qualified Ganeti.HTools.Loader as Loader
-import qualified Ganeti.HTools.Instance as Instance
-import qualified Ganeti.HTools.Node as Node
-import qualified Ganeti.HTools.Cluster as Cluster
-
import Ganeti.HTools.Types
+import Ganeti.HTools.Utils
-- | The default value for the luxi socket
defaultLuxiSocket :: FilePath
-- | Command line options structure.
data Options = Options
- { optShowNodes :: Bool -- ^ Whether to show node status
- , optShowCmds :: Maybe FilePath -- ^ Whether to show the command list
- , optOneline :: Bool -- ^ Switch output to a single line
- , optOutPath :: FilePath -- ^ Path to the output directory
- , optNoHeaders :: Bool -- ^ Do not show a header line
- , optNodeFile :: FilePath -- ^ Path to the nodes file
- , optNodeSet :: Bool -- ^ The nodes have been set by options
- , optInstFile :: FilePath -- ^ Path to the instances file
- , optInstSet :: Bool -- ^ The insts have been set by options
- , optNodeSim :: Maybe String -- ^ Cluster simulation mode
- , optMaxLength :: Int -- ^ Stop after this many steps
- , optMaster :: String -- ^ Collect data from RAPI
- , optLuxi :: Maybe FilePath -- ^ Collect data from Luxi
- , optOffline :: [String] -- ^ Names of offline nodes
- , optIMem :: Int -- ^ Instance memory
- , optIDsk :: Int -- ^ Instance disk
- , optIVCPUs :: Int -- ^ Instance VCPUs
- , optINodes :: Int -- ^ Nodes required for an instance
- , optMinScore :: Cluster.Score -- ^ The minimum score we aim for
- , optMcpu :: Double -- ^ Max cpu ratio for nodes
- , optMdsk :: Double -- ^ Max disk usage ratio for nodes
- , optVerbose :: Int -- ^ Verbosity level
- , optShowVer :: Bool -- ^ Just show the program version
- , optShowHelp :: Bool -- ^ Just show the help
+ { optShowNodes :: Maybe [String] -- ^ Whether to show node status
+ , optShowInsts :: Bool -- ^ Whether to show the instance map
+ , optShowCmds :: Maybe FilePath -- ^ Whether to show the command list
+ , optOneline :: Bool -- ^ Switch output to a single line
+ , optOutPath :: FilePath -- ^ Path to the output directory
+ , optNoHeaders :: Bool -- ^ Do not show a header line
+ , optNodeFile :: FilePath -- ^ Path to the nodes file
+ , optNodeSet :: Bool -- ^ The nodes have been set by options
+ , optInstFile :: FilePath -- ^ Path to the instances file
+ , optInstSet :: Bool -- ^ The insts have been set by options
+ , optNodeSim :: Maybe String -- ^ Cluster simulation mode
+ , optMaxLength :: Int -- ^ Stop after this many steps
+ , optMaster :: String -- ^ Collect data from RAPI
+ , optLuxi :: Maybe FilePath -- ^ Collect data from Luxi
+ , optExecJobs :: Bool -- ^ Execute the commands via Luxi
+ , optOffline :: [String] -- ^ Names of offline nodes
+ , optINodes :: Int -- ^ Nodes required for an instance
+ , optISpec :: RSpec -- ^ Requested instance specs
+ , optTieredSpec :: Maybe RSpec -- ^ Requested specs for tiered mode
+ , optMinScore :: Score -- ^ The minimum score we aim for
+ , optMcpu :: Double -- ^ Max cpu ratio for nodes
+ , optMdsk :: Double -- ^ Max disk usage ratio for nodes
+ , optDiskMoves :: Bool -- ^ Allow disk moves
+ , optDynuFile :: Maybe FilePath -- ^ Optional file with dynamic use data
+ , optVerbose :: Int -- ^ Verbosity level
+ , optShowVer :: Bool -- ^ Just show the program version
+ , optShowHelp :: Bool -- ^ Just show the help
} deriving Show
-- | Default values for the command line options.
defaultOptions :: Options
defaultOptions = Options
- { optShowNodes = False
- , optShowCmds = Nothing
- , optOneline = False
- , optNoHeaders = False
- , optOutPath = "."
- , optNodeFile = "nodes"
- , optNodeSet = False
- , optInstFile = "instances"
- , optInstSet = False
- , optNodeSim = Nothing
- , optMaxLength = -1
- , optMaster = ""
- , optLuxi = Nothing
- , optOffline = []
- , optIMem = 4096
- , optIDsk = 102400
- , optIVCPUs = 1
- , optINodes = 2
- , optMinScore = 1e-9
- , optMcpu = -1
- , optMdsk = -1
- , optVerbose = 1
- , optShowVer = False
- , optShowHelp = False
+ { optShowNodes = Nothing
+ , optShowInsts = False
+ , optShowCmds = Nothing
+ , optOneline = False
+ , optNoHeaders = False
+ , optOutPath = "."
+ , optNodeFile = "nodes"
+ , optNodeSet = False
+ , optInstFile = "instances"
+ , optInstSet = False
+ , optNodeSim = Nothing
+ , optMaxLength = -1
+ , optMaster = ""
+ , optLuxi = Nothing
+ , optExecJobs = False
+ , optOffline = []
+ , optINodes = 2
+ , optISpec = RSpec 1 4096 102400
+ , optTieredSpec = Nothing
+ , optMinScore = 1e-9
+ , optMcpu = -1
+ , optMdsk = -1
+ , optDiskMoves = True
+ , optDynuFile = Nothing
+ , optVerbose = 1
+ , optShowVer = False
+ , optShowHelp = False
}
-- | Abrreviation for the option type
-type OptType = OptDescr (Options -> Options)
+type OptType = OptDescr (Options -> Result Options)
oPrintNodes :: OptType
oPrintNodes = Option "p" ["print-nodes"]
- (NoArg (\ opts -> opts { optShowNodes = True }))
+ (OptArg ((\ f opts ->
+ let splitted = sepSplit ',' f
+ in Ok opts { optShowNodes = Just splitted }) .
+ fromMaybe []) "FIELDS")
"print the final node list"
+oPrintInsts :: OptType
+oPrintInsts = Option "" ["print-instances"]
+ (NoArg (\ opts -> Ok opts { optShowInsts = True }))
+ "print the final instance map"
+
oPrintCommands :: OptType
oPrintCommands = Option "C" ["print-commands"]
- (OptArg ((\ f opts -> opts { optShowCmds = Just f }) .
+ (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
fromMaybe "-")
"FILE")
"print the ganeti command list for reaching the solution,\
oOneline :: OptType
oOneline = Option "o" ["oneline"]
- (NoArg (\ opts -> opts { optOneline = True }))
+ (NoArg (\ opts -> Ok opts { optOneline = True }))
"print the ganeti command list for reaching the solution"
oNoHeaders :: OptType
oNoHeaders = Option "" ["no-headers"]
- (NoArg (\ opts -> opts { optNoHeaders = True }))
+ (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
"do not show a header line"
oOutputDir :: OptType
oOutputDir = Option "d" ["output-dir"]
- (ReqArg (\ d opts -> opts { optOutPath = d }) "PATH")
+ (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
"directory in which to write output files"
oNodeFile :: OptType
oNodeFile = Option "n" ["nodes"]
- (ReqArg (\ f o -> o { optNodeFile = f, optNodeSet = True }) "FILE")
+ (ReqArg (\ f o -> Ok o { optNodeFile = f,
+ optNodeSet = True }) "FILE")
"the node list FILE"
oInstFile :: OptType
oInstFile = Option "i" ["instances"]
- (ReqArg (\ f o -> o { optInstFile = f, optInstSet = True }) "FILE")
+ (ReqArg (\ f o -> Ok o { optInstFile = f,
+ optInstSet = True }) "FILE")
"the instance list FILE"
oNodeSim :: OptType
oNodeSim = Option "" ["simulate"]
- (ReqArg (\ f o -> o { optNodeSim = Just f }) "SPEC")
- "simulate an empty cluster, given as 'num_nodes,disk,memory,cpus'"
+ (ReqArg (\ f o -> Ok o { optNodeSim = Just f }) "SPEC")
+ "simulate an empty cluster, given as 'num_nodes,disk,ram,cpu'"
oRapiMaster :: OptType
oRapiMaster = Option "m" ["master"]
- (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
+ (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
"collect data via RAPI at the given ADDRESS"
oLuxiSocket :: OptType
oLuxiSocket = Option "L" ["luxi"]
- (OptArg ((\ f opts -> opts { optLuxi = Just f }) .
+ (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
fromMaybe defaultLuxiSocket) "SOCKET")
"collect data via Luxi, optionally using the given SOCKET path"
+oExecJobs :: OptType
+oExecJobs = Option "X" ["exec"]
+ (NoArg (\ opts -> Ok opts { optExecJobs = True}))
+ "execute the suggested moves via Luxi (only available when using\
+ \ it for data gathering"
+
oVerbose :: OptType
oVerbose = Option "v" ["verbose"]
- (NoArg (\ opts -> opts { optVerbose = optVerbose opts + 1 }))
+ (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
"increase the verbosity level"
oQuiet :: OptType
oQuiet = Option "q" ["quiet"]
- (NoArg (\ opts -> opts { optVerbose = optVerbose opts - 1 }))
+ (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
"decrease the verbosity level"
oOfflineNode :: OptType
oOfflineNode = Option "O" ["offline"]
- (ReqArg (\ n o -> o { optOffline = n:optOffline o }) "NODE")
+ (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
"set node as offline"
oMaxSolLength :: OptType
oMaxSolLength = Option "l" ["max-length"]
- (ReqArg (\ i opts -> opts { optMaxLength = read i::Int }) "N")
+ (ReqArg (\ i opts -> Ok opts { optMaxLength = read i }) "N")
"cap the solution at this many moves (useful for very\
\ unbalanced clusters)"
oMinScore :: OptType
oMinScore = Option "e" ["min-score"]
- (ReqArg (\ e opts -> opts { optMinScore = read e }) "EPSILON")
+ (ReqArg (\ e opts -> Ok opts { optMinScore = read e }) "EPSILON")
" mininum score to aim for"
oIMem :: OptType
oIMem = Option "" ["memory"]
- (ReqArg (\ m opts -> opts { optIMem = read m }) "MEMORY")
+ (ReqArg (\ m opts ->
+ let ospec = optISpec opts
+ nspec = ospec { rspecMem = read m }
+ in Ok opts { optISpec = nspec }) "MEMORY")
"memory size for instances"
oIDisk :: OptType
oIDisk = Option "" ["disk"]
- (ReqArg (\ d opts -> opts { optIDsk = read d }) "DISK")
+ (ReqArg (\ d opts ->
+ let ospec = optISpec opts
+ nspec = ospec { rspecDsk = read d }
+ in Ok opts { optISpec = nspec }) "DISK")
"disk size for instances"
oIVcpus :: OptType
oIVcpus = Option "" ["vcpus"]
- (ReqArg (\ p opts -> opts { optIVCPUs = read p }) "NUM")
+ (ReqArg (\ p opts ->
+ let ospec = optISpec opts
+ nspec = ospec { rspecCpu = read p }
+ in Ok opts { optISpec = nspec }) "NUM")
"number of virtual cpus for instances"
oINodes :: OptType
oINodes = Option "" ["req-nodes"]
- (ReqArg (\ n opts -> opts { optINodes = read n }) "NODES")
+ (ReqArg (\ n opts -> Ok opts { optINodes = read n }) "NODES")
"number of nodes for the new instances (1=plain, 2=mirrored)"
oMaxCpu :: OptType
oMaxCpu = Option "" ["max-cpu"]
- (ReqArg (\ n opts -> opts { optMcpu = read n }) "RATIO")
+ (ReqArg (\ n opts -> Ok opts { optMcpu = read n }) "RATIO")
"maximum virtual-to-physical cpu ratio for nodes"
oMinDisk :: OptType
oMinDisk = Option "" ["min-disk"]
- (ReqArg (\ n opts -> opts { optMdsk = read n }) "RATIO")
+ (ReqArg (\ n opts -> Ok opts { optMdsk = read n }) "RATIO")
"minimum free disk space for nodes (between 0 and 1)"
+oDiskMoves :: OptType
+oDiskMoves = Option "" ["no-disk-moves"]
+ (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
+ "disallow disk moves from the list of allowed instance changes,\
+ \ thus allowing only the 'cheap' failover/migrate operations"
+
+oDynuFile :: OptType
+oDynuFile = Option "U" ["dynu-file"]
+ (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
+ "Import dynamic utilisation data from the given FILE"
+
+oTieredSpec :: OptType
+oTieredSpec = Option "" ["tiered-alloc"]
+ (ReqArg (\ inp opts -> do
+ let sp = sepSplit ',' inp
+ prs <- mapM (tryRead "tiered specs") sp
+ tspec <-
+ case prs of
+ [dsk, ram, cpu] -> return $ RSpec cpu ram dsk
+ _ -> Bad $ "Invalid specification: " ++ inp
+ return $ opts { optTieredSpec = Just tspec } )
+ "TSPEC")
+ "enable tiered specs allocation, given as 'disk,ram,cpu'"
+
oShowVer :: OptType
oShowVer = Option "V" ["version"]
- (NoArg (\ opts -> opts { optShowVer = True}))
+ (NoArg (\ opts -> Ok opts { optShowVer = True}))
"show the version of the program"
oShowHelp :: OptType
oShowHelp = Option "h" ["help"]
- (NoArg (\ opts -> opts { optShowHelp = True}))
+ (NoArg (\ opts -> Ok opts { optShowHelp = True}))
"show help"
-- | Usage info
case getOpt Permute options argv of
(o, n, []) ->
do
- let resu@(po, _) = (foldl (flip id) defaultOptions o, n)
+ let (pr, args) = (foldM (flip id) defaultOptions o, n)
+ po <- (case pr of
+ Bad msg -> do
+ hPutStrLn stderr "Error while parsing command\
+ \line arguments:"
+ hPutStrLn stderr msg
+ exitWith $ ExitFailure 1
+ Ok val -> return val)
when (optShowHelp po) $ do
putStr $ usageHelp progname options
exitWith ExitSuccess
compilerName (Data.Version.showVersion compilerVersion)
os arch
exitWith ExitSuccess
- return resu
- (_, _, errs) ->
- ioError (userError (concat errs ++ usageHelp progname options))
-
--- | Parse the environment and return the node\/instance names.
---
--- This also hardcodes here the default node\/instance file names.
-parseEnv :: () -> IO (String, String)
-parseEnv () = do
- a <- getEnvDefault "HTOOLS_NODES" "nodes"
- b <- getEnvDefault "HTOOLS_INSTANCES" "instances"
- return (a, b)
+ return (po, args)
+ (_, _, errs) -> do
+ hPutStrLn stderr $ "Command line error: " ++ concat errs
+ hPutStrLn stderr $ usageHelp progname options
+ exitWith $ ExitFailure 2
-- | A shell script template for autogenerated scripts.
shTemplate :: String
\ exit 0\n\
\ fi\n\
\}\n\n"
-
--- | Error beautifier
-wrapIO :: IO (Result a) -> IO (Result a)
-wrapIO act =
- handle (\e -> return $ Bad $ show e)
- act
-
--- | External tool data loader from a variety of sources.
-loadExternalData :: Options
- -> IO (Node.List, Instance.List, String)
-loadExternalData opts = do
- (env_node, env_inst) <- parseEnv ()
- let nodef = if optNodeSet opts then optNodeFile opts
- else env_node
- instf = if optInstSet opts then optInstFile opts
- else env_inst
- mhost = optMaster opts
- lsock = optLuxi opts
- simdata = optNodeSim opts
- setRapi = mhost /= ""
- setLuxi = isJust lsock
- setSim = isJust simdata
- setFiles = optNodeSet opts || optInstSet opts
- allSet = filter id [setRapi, setLuxi, setFiles]
- when (length allSet > 1) $
- do
- hPutStrLn stderr "Error: Only one of the rapi, luxi, and data\
- \ files options should be given."
- exitWith $ ExitFailure 1
-
- input_data <-
- case () of
- _ | setRapi -> wrapIO $ Rapi.loadData mhost
- | setLuxi -> wrapIO $ Luxi.loadData $ fromJust lsock
- | setSim -> Simu.loadData $ fromJust simdata
- | otherwise -> wrapIO $ Text.loadData nodef instf
-
- let ldresult = input_data >>= Loader.mergeData
- (loaded_nl, il, csf) <-
- (case ldresult of
- Ok x -> return x
- Bad s -> do
- hPrintf stderr "Error: failed to load data. Details:\n%s\n" s
- exitWith $ ExitFailure 1
- )
- let (fix_msgs, fixed_nl) = Loader.checkData loaded_nl il
-
- unless (null fix_msgs || optVerbose opts == 0) $ do
- hPutStrLn stderr "Warning: cluster has inconsistent data:"
- hPutStrLn stderr . unlines . map (printf " - %s") $ fix_msgs
-
- return (fixed_nl, il, csf)