( Options(..)
, OptType
, parseOpts
+ , parseOptsInner
+ , parseYesNo
, parseISpecString
, shTemplate
, defaultLuxiSocket
, maybePrintNodes
, maybePrintInsts
, maybeShowWarnings
+ , printKeys
+ , printFinal
, setNodeStatus
-- * The options
, oDataFile
, oDiskMoves
, oDiskTemplate
+ , oSpindleUse
, oDynuFile
, oEvacMode
, oExInst
, oExTags
, oExecJobs
, oGroup
+ , oIAllocSrc
, oInstMoves
, oLuxiSocket
, oMachineReadable
, oMinGainLim
, oMinScore
, oNoHeaders
+ , oNoSimulation
, oNodeSim
, oOfflineNode
, oOutputDir
, oShowHelp
, oShowVer
, oStdSpec
+ , oTestCount
, oTieredSpec
, oVerbose
) where
import Control.Monad
+import Data.Char (toUpper)
import Data.Maybe (fromMaybe)
import qualified Data.Version
import System.Console.GetOpt
import System.IO
import System.Info
import System.Exit
-import Text.Printf (printf, hPrintf)
+import Text.Printf (printf)
import qualified Ganeti.HTools.Version as Version(version)
import qualified Ganeti.HTools.Container as Container
, optDiskMoves :: Bool -- ^ Allow disk moves
, optInstMoves :: Bool -- ^ Allow instance moves
, optDiskTemplate :: Maybe DiskTemplate -- ^ Override for the disk template
+ , optSpindleUse :: Maybe Int -- ^ Override for the spindle usage
, optDynuFile :: Maybe FilePath -- ^ Optional file with dynamic use data
, optEvacMode :: Bool -- ^ Enable evacuation mode
, optExInst :: [String] -- ^ Instances to be excluded
, optExTags :: Maybe [String] -- ^ Tags to use for exclusion
, optExecJobs :: Bool -- ^ Execute the commands via Luxi
, optGroup :: Maybe GroupID -- ^ The UUID of the group to process
+ , optIAllocSrc :: Maybe FilePath -- ^ The iallocation spec
, optSelInst :: [String] -- ^ Instances to be excluded
, optLuxi :: Maybe FilePath -- ^ Collect data from Luxi
, optMachineReadable :: Bool -- ^ Output machine-readable format
, optMaster :: String -- ^ Collect data from RAPI
, optMaxLength :: Int -- ^ Stop after this many steps
- , optMcpu :: Double -- ^ Max cpu ratio for nodes
+ , optMcpu :: Maybe Double -- ^ Override max cpu ratio for nodes
, optMdsk :: Double -- ^ Max disk usage ratio for nodes
, optMinGain :: Score -- ^ Min gain we aim for in a step
, optMinGainLim :: Score -- ^ Limit below which we apply mingain
, optMinScore :: Score -- ^ The minimum score we aim for
, optNoHeaders :: Bool -- ^ Do not show a header line
+ , optNoSimulation :: Bool -- ^ Skip the rebalancing dry-run
, optNodeSim :: [String] -- ^ Cluster simulation mode
, optOffline :: [String] -- ^ Names of offline nodes
, optOutPath :: FilePath -- ^ Path to the output directory
, optShowNodes :: Maybe [String] -- ^ Whether to show node status
, optShowVer :: Bool -- ^ Just show the program version
, optStdSpec :: Maybe RSpec -- ^ Requested standard specs
+ , optTestCount :: Maybe Int -- ^ Optional test count override
, optTieredSpec :: Maybe RSpec -- ^ Requested specs for tiered mode
, optReplay :: Maybe String -- ^ Unittests: RNG state
, optVerbose :: Int -- ^ Verbosity level
, optDiskMoves = True
, optInstMoves = True
, optDiskTemplate = Nothing
+ , optSpindleUse = Nothing
, optDynuFile = Nothing
, optEvacMode = False
, optExInst = []
, optExTags = Nothing
, optExecJobs = False
, optGroup = Nothing
+ , optIAllocSrc = Nothing
, optSelInst = []
, optLuxi = Nothing
, optMachineReadable = False
, optMaster = ""
, optMaxLength = -1
- , optMcpu = defVcpuRatio
+ , optMcpu = Nothing
, optMdsk = defReservedDiskRatio
, optMinGain = 1e-2
, optMinGainLim = 1e-1
, optMinScore = 1e-9
, optNoHeaders = False
+ , optNoSimulation = False
, optNodeSim = []
, optOffline = []
, optOutPath = "."
, optShowNodes = Nothing
, optShowVer = False
, optStdSpec = Nothing
+ , optTestCount = Nothing
, optTieredSpec = Nothing
, optReplay = Nothing
, optVerbose = 1
return $ opts { optDiskTemplate = Just dt })
"TEMPLATE") "select the desired disk template"
+oSpindleUse :: OptType
+oSpindleUse = Option "" ["spindle-use"]
+ (ReqArg (\ n opts -> do
+ su <- tryRead "parsing spindle-use" n
+ when (su < 0) $
+ fail "Invalid value of the spindle-use\
+ \ (expected >= 0)"
+ return $ opts { optSpindleUse = Just su })
+ "SPINDLES") "select how many virtual spindle instances use\
+ \ [default read from cluster]"
+
oSelInst :: OptType
oSelInst = Option "" ["select-instances"]
(ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
(ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
"the ID of the group to balance"
+oIAllocSrc :: OptType
+oIAllocSrc = Option "I" ["ialloc-src"]
+ (ReqArg (\ f opts -> Ok opts { optIAllocSrc = Just f }) "FILE")
+ "Specify an iallocator spec as the cluster data source"
+
oLuxiSocket :: OptType
oLuxiSocket = Option "L" ["luxi"]
(OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
oMaxCpu :: OptType
oMaxCpu = Option "" ["max-cpu"]
- (ReqArg (\ n opts -> Ok opts { optMcpu = read n }) "RATIO")
- "maximum virtual-to-physical cpu ratio for nodes (from 1\
- \ upwards) [64]"
+ (ReqArg (\ n opts -> do
+ mcpu <- tryRead "parsing max-cpu" n
+ when (mcpu <= 0) $
+ fail "Invalid value of the max-cpu ratio,\
+ \ expected >0"
+ return $ opts { optMcpu = Just mcpu }) "RATIO")
+ "maximum virtual-to-physical cpu ratio for nodes (from 0\
+ \ upwards) [default read from cluster]"
oMaxSolLength :: OptType
oMaxSolLength = Option "l" ["max-length"]
(NoArg (\ opts -> Ok opts { optNoHeaders = True }))
"do not show a header line"
+oNoSimulation :: OptType
+oNoSimulation = Option "" ["no-simulation"]
+ (NoArg (\opts -> Ok opts {optNoSimulation = True}))
+ "do not perform rebalancing simulation"
+
oNodeSim :: OptType
oNodeSim = Option "" ["simulate"]
(ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
"STDSPEC")
"enable standard specs allocation, given as 'disk,ram,cpu'"
+oTestCount :: OptType
+oTestCount = Option "" ["test-count"]
+ (ReqArg (\ inp opts -> do
+ tcount <- tryRead "parsing test count" inp
+ return $ opts { optTestCount = Just tcount } )
+ "COUNT")
+ "override the target test count"
+
oTieredSpec :: OptType
oTieredSpec = Option "" ["tiered-alloc"]
(ReqArg (\ inp opts -> do
-- * Functions
-- | Helper for parsing a yes\/no command line flag.
-parseYesNo :: Bool -- ^ Default whalue (when we get a @Nothing@)
+parseYesNo :: Bool -- ^ Default value (when we get a @Nothing@)
-> Maybe String -- ^ Parameter value
-> Result Bool -- ^ Resulting boolean value
parseYesNo v Nothing = return v
parseYesNo _ (Just "yes") = return True
parseYesNo _ (Just "no") = return False
-parseYesNo _ (Just s) = fail $ "Invalid choice '" ++ s ++
- "', pass one of 'yes' or 'no'"
+parseYesNo _ (Just s) = fail ("Invalid choice '" ++ s ++
+ "', pass one of 'yes' or 'no'")
-- | Usage info.
usageHelp :: String -> [OptType] -> String
usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
progname Version.version progname)
+-- | Show the program version info.
+versionInfo :: String -> String
+versionInfo progname =
+ printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
+ progname Version.version compilerName
+ (Data.Version.showVersion compilerVersion)
+ os arch
+
-- | Command line parser, using the 'Options' structure.
parseOpts :: [String] -- ^ The command line arguments
-> String -- ^ The program name
-> IO (Options, [String]) -- ^ The resulting options and leftover
-- arguments
parseOpts argv progname options =
+ case parseOptsInner argv progname options of
+ Left (code, msg) -> do
+ hPutStr (if code == 0 then stdout else stderr) msg
+ exitWith (if code == 0 then ExitSuccess else ExitFailure code)
+ Right result ->
+ return result
+
+-- | Inner parse options. The arguments are similar to 'parseOpts',
+-- but it returns either a 'Left' composed of exit code and message,
+-- or a 'Right' for the success case.
+parseOptsInner :: [String] -> String -> [OptType]
+ -> Either (Int, String) (Options, [String])
+parseOptsInner argv progname options =
case getOpt Permute options argv of
(o, n, []) ->
- do
- 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
- when (optShowVer po) $ do
- printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
- progname Version.version
- compilerName (Data.Version.showVersion compilerVersion)
- os arch :: IO ()
- exitWith ExitSuccess
- return (po, args)
- (_, _, errs) -> do
- hPutStrLn stderr $ "Command line error: " ++ concat errs
- hPutStrLn stderr $ usageHelp progname options
- exitWith $ ExitFailure 2
+ let (pr, args) = (foldM (flip id) defaultOptions o, n)
+ in case pr of
+ Bad msg -> Left (1, "Error while parsing command\
+ \line arguments:\n" ++ msg ++ "\n")
+ Ok po ->
+ select (Right (po, args))
+ [ (optShowHelp po, Left (0, usageHelp progname options))
+ , (optShowVer po, Left (0, versionInfo progname))
+ ]
+ (_, _, errs) ->
+ Left (2, "Command line error: " ++ concat errs ++ "\n" ++
+ usageHelp progname options)
-- | A shell script template for autogenerated scripts.
shTemplate :: String
hPutStrLn stderr "Warning: cluster has inconsistent data:"
hPutStrLn stderr . unlines . map (printf " - %s") $ fix_msgs
+-- | Format a list of key, value as a shell fragment.
+printKeys :: String -> [(String, String)] -> IO ()
+printKeys prefix = mapM_ (\(k, v) ->
+ printf "%s_%s=%s\n" prefix (map toUpper k) (ensureQuoted v))
+
+-- | Prints the final @OK@ marker in machine readable output.
+printFinal :: String -> Bool -> IO ()
+printFinal prefix True =
+ -- this should be the final entry
+ printKeys prefix [("OK", "1")]
+
+printFinal _ False = return ()
+
+-- | Potentially set the node as offline based on passed offline list.
+setNodeOffline :: [Ndx] -> Node.Node -> Node.Node
+setNodeOffline offline_indices n =
+ if Node.idx n `elem` offline_indices
+ then Node.setOffline n True
+ else n
+
-- | Set node properties based on command line options.
setNodeStatus :: Options -> Node.List -> IO Node.List
setNodeStatus opts fixed_nl = do
m_dsk = optMdsk opts
unless (null offline_wrong) $ do
- hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
- (commaJoin (map lrContent offline_wrong)) :: IO ()
- exitWith $ ExitFailure 1
-
- let nm = Container.map (\n -> if Node.idx n `elem` offline_indices
- then Node.setOffline n True
- else n) fixed_nl
- nlf = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
- nm
- return nlf
+ exitErr $ printf "wrong node name(s) set as offline: %s\n"
+ (commaJoin (map lrContent offline_wrong))
+ let setMCpuFn = case m_cpu of
+ Nothing -> id
+ Just new_mcpu -> flip Node.setMcpu new_mcpu
+ let nm = Container.map (setNodeOffline offline_indices .
+ flip Node.setMdsk m_dsk .
+ setMCpuFn) fixed_nl
+ return nm
projects / ganeti-local / blobdiff