{-| Implementation of command-line functions.
This module holds the common command-line related functions for the
-binaries, separated into this module since "Ganeti.HTools.Utils" is
+binaries, separated into this module since "Ganeti.Utils" is
used in many other places and this is more IO oriented.
-}
{-
-Copyright (C) 2009, 2010, 2011 Google Inc.
+Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
module Ganeti.HTools.CLI
( Options(..)
, OptType
- , parseOpts
+ , defaultOptions
+ , Ganeti.HTools.CLI.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
, oPrintNodes
, oQuiet
, oRapiMaster
- , oReplay
, oSaveCluster
, oSelInst
, oShowHelp
, oShowVer
+ , oShowComp
, oStdSpec
, oTieredSpec
, oVerbose
+ , genericOpts
) 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
import qualified Ganeti.HTools.Node as Node
-import qualified Ganeti.Constants as C
+import qualified Ganeti.Path as Path
import Ganeti.HTools.Types
-import Ganeti.HTools.Utils
-import Ganeti.HTools.Loader
-
--- * Constants
-
--- | The default value for the luxi socket.
---
--- This is re-exported from the "Ganeti.Constants" module.
-defaultLuxiSocket :: FilePath
-defaultLuxiSocket = C.masterSocket
+import Ganeti.BasicTypes
+import Ganeti.Common as Common
+import Ganeti.Utils
-- * Data types
, 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
, optSaveCluster :: Maybe FilePath -- ^ Save cluster state to this file
, optShowCmds :: Maybe FilePath -- ^ Whether to show the command list
, optShowHelp :: Bool -- ^ Just show the help
+ , optShowComp :: Bool -- ^ Just show the completion info
, optShowInsts :: Bool -- ^ Whether to show the instance map
, 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 = "."
, optSaveCluster = Nothing
, optShowCmds = Nothing
, optShowHelp = False
+ , optShowComp = False
, optShowInsts = False
, optShowNodes = Nothing
, optShowVer = False
, optStdSpec = Nothing
+ , optTestCount = Nothing
, optTieredSpec = Nothing
, optReplay = Nothing
, optVerbose = 1
}
-- | Abrreviation for the option type.
-type OptType = OptDescr (Options -> Result Options)
+type OptType = GenericOptType Options
+
+instance StandardOptions Options where
+ helpRequested = optShowHelp
+ verRequested = optShowVer
+ compRequested = optShowComp
+ requestHelp o = o { optShowHelp = True }
+ requestVer o = o { optShowVer = True }
+ requestComp o = o { optShowComp = True }
-- * Helper functions
parseISpecString :: String -> String -> Result RSpec
parseISpecString descr inp = do
let sp = sepSplit ',' inp
+ err = Bad ("Invalid " ++ descr ++ " specification: '" ++ inp ++
+ "', expected disk,ram,cpu")
+ when (length sp /= 3) err
prs <- mapM (\(fn, val) -> fn val) $
- zip [ annotateResult (descr ++ " specs memory") . parseUnit
- , annotateResult (descr ++ " specs disk") . parseUnit
+ zip [ annotateResult (descr ++ " specs disk") . parseUnit
+ , annotateResult (descr ++ " specs memory") . parseUnit
, tryRead (descr ++ " specs cpus")
] sp
case prs of
[dsk, ram, cpu] -> return $ RSpec cpu ram dsk
- _ -> Bad $ "Invalid " ++ descr ++ " specification: '" ++ inp ++
- "', expected disk,ram,cpu"
+ _ -> err
+
+-- | Disk template choices.
+optComplDiskTemplate :: OptCompletion
+optComplDiskTemplate = OptComplChoices $
+ map diskTemplateToRaw [minBound..maxBound]
-- * Command line options
oDataFile :: OptType
-oDataFile = Option "t" ["text-data"]
- (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
- "the cluster data FILE"
+oDataFile =
+ (Option "t" ["text-data"]
+ (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
+ "the cluster data FILE",
+ OptComplFile)
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"
+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",
+ OptComplNone)
oDiskTemplate :: OptType
-oDiskTemplate = Option "" ["disk-template"]
- (ReqArg (\ t opts -> do
- dt <- diskTemplateFromRaw t
- return $ opts { optDiskTemplate = Just dt })
- "TEMPLATE") "select the desired disk template"
+oDiskTemplate =
+ (Option "" ["disk-template"]
+ (reqWithConversion diskTemplateFromRaw
+ (\dt opts -> Ok opts { optDiskTemplate = Just dt })
+ "TEMPLATE") "select the desired disk template",
+ optComplDiskTemplate)
+
+oSpindleUse :: OptType
+oSpindleUse =
+ (Option "" ["spindle-use"]
+ (reqWithConversion (tryRead "parsing spindle-use")
+ (\su opts -> do
+ 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]",
+ OptComplFloat)
oSelInst :: OptType
-oSelInst = Option "" ["select-instances"]
- (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
- "only select given instances for any moves"
+oSelInst =
+ (Option "" ["select-instances"]
+ (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
+ "only select given instances for any moves",
+ OptComplManyInstances)
oInstMoves :: OptType
-oInstMoves = Option "" ["no-instance-moves"]
- (NoArg (\ opts -> Ok opts { optInstMoves = False}))
- "disallow instance (primary node) moves from the list of allowed,\
- \ instance changes, thus allowing only slower, but sometimes\
- \ safer, drbd secondary changes"
+oInstMoves =
+ (Option "" ["no-instance-moves"]
+ (NoArg (\ opts -> Ok opts { optInstMoves = False}))
+ "disallow instance (primary node) moves from the list of allowed,\
+ \ instance changes, thus allowing only slower, but sometimes\
+ \ safer, drbd secondary changes",
+ OptComplNone)
oDynuFile :: OptType
-oDynuFile = Option "U" ["dynu-file"]
- (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
- "Import dynamic utilisation data from the given FILE"
+oDynuFile =
+ (Option "U" ["dynu-file"]
+ (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
+ "Import dynamic utilisation data from the given FILE",
+ OptComplFile)
oEvacMode :: OptType
-oEvacMode = Option "E" ["evac-mode"]
- (NoArg (\opts -> Ok opts { optEvacMode = True }))
- "enable evacuation mode, where the algorithm only moves \
- \ instances away from offline and drained nodes"
+oEvacMode =
+ (Option "E" ["evac-mode"]
+ (NoArg (\opts -> Ok opts { optEvacMode = True }))
+ "enable evacuation mode, where the algorithm only moves \
+ \ instances away from offline and drained nodes",
+ OptComplNone)
oExInst :: OptType
-oExInst = Option "" ["exclude-instances"]
- (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
- "exclude given instances from any moves"
+oExInst =
+ (Option "" ["exclude-instances"]
+ (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
+ "exclude given instances from any moves",
+ OptComplManyInstances)
oExTags :: OptType
-oExTags = Option "" ["exclusion-tags"]
- (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
- "TAG,...") "Enable instance exclusion based on given tag prefix"
+oExTags =
+ (Option "" ["exclusion-tags"]
+ (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
+ "TAG,...") "Enable instance exclusion based on given tag prefix",
+ OptComplString)
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)"
+oExecJobs =
+ (Option "X" ["exec"]
+ (NoArg (\ opts -> Ok opts { optExecJobs = True}))
+ "execute the suggested moves via Luxi (only available when using\
+ \ it for data gathering)",
+ OptComplNone)
oGroup :: OptType
-oGroup = Option "G" ["group"]
- (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
- "the ID of the group to balance"
+oGroup =
+ (Option "G" ["group"]
+ (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
+ "the ID of the group to balance",
+ OptComplOneGroup)
+
+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",
+ OptComplFile)
oLuxiSocket :: OptType
-oLuxiSocket = Option "L" ["luxi"]
- (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
- fromMaybe defaultLuxiSocket) "SOCKET")
- "collect data via Luxi, optionally using the given SOCKET path"
+oLuxiSocket =
+ (Option "L" ["luxi"]
+ (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
+ fromMaybe Path.defaultLuxiSocket) "SOCKET")
+ "collect data via Luxi, optionally using the given SOCKET path",
+ OptComplFile)
oMachineReadable :: OptType
-oMachineReadable = Option "" ["machine-readable"]
- (OptArg (\ f opts -> do
- flag <- parseYesNo True f
- return $ opts { optMachineReadable = flag }) "CHOICE")
- "enable machine readable output (pass either 'yes' or 'no' to\
- \ explicitely control the flag, or without an argument defaults to\
- \ yes"
+oMachineReadable =
+ (Option "" ["machine-readable"]
+ (OptArg (\ f opts -> do
+ flag <- parseYesNo True f
+ return $ opts { optMachineReadable = flag }) "CHOICE")
+ "enable machine readable output (pass either 'yes' or 'no' to\
+ \ explicitly control the flag, or without an argument defaults to\
+ \ yes",
+ optComplYesNo)
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]"
+oMaxCpu =
+ (Option "" ["max-cpu"]
+ (reqWithConversion (tryRead "parsing max-cpu")
+ (\mcpu opts -> do
+ 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]",
+ OptComplFloat)
oMaxSolLength :: OptType
-oMaxSolLength = Option "l" ["max-length"]
- (ReqArg (\ i opts -> Ok opts { optMaxLength = read i }) "N")
- "cap the solution at this many balancing or allocation \
- \ rounds (useful for very unbalanced clusters or empty \
- \ clusters)"
+oMaxSolLength =
+ (Option "l" ["max-length"]
+ (reqWithConversion (tryRead "max solution length")
+ (\i opts -> Ok opts { optMaxLength = i }) "N")
+ "cap the solution at this many balancing or allocation \
+ \ rounds (useful for very unbalanced clusters or empty \
+ \ clusters)",
+ OptComplInteger)
oMinDisk :: OptType
-oMinDisk = Option "" ["min-disk"]
- (ReqArg (\ n opts -> Ok opts { optMdsk = read n }) "RATIO")
- "minimum free disk space for nodes (between 0 and 1) [0]"
+oMinDisk =
+ (Option "" ["min-disk"]
+ (reqWithConversion (tryRead "min free disk space")
+ (\n opts -> Ok opts { optMdsk = n }) "RATIO")
+ "minimum free disk space for nodes (between 0 and 1) [0]",
+ OptComplFloat)
oMinGain :: OptType
-oMinGain = Option "g" ["min-gain"]
- (ReqArg (\ g opts -> Ok opts { optMinGain = read g }) "DELTA")
- "minimum gain to aim for in a balancing step before giving up"
+oMinGain =
+ (Option "g" ["min-gain"]
+ (reqWithConversion (tryRead "min gain")
+ (\g opts -> Ok opts { optMinGain = g }) "DELTA")
+ "minimum gain to aim for in a balancing step before giving up",
+ OptComplFloat)
oMinGainLim :: OptType
-oMinGainLim = Option "" ["min-gain-limit"]
- (ReqArg (\ g opts -> Ok opts { optMinGainLim = read g }) "SCORE")
- "minimum cluster score for which we start checking the min-gain"
+oMinGainLim =
+ (Option "" ["min-gain-limit"]
+ (reqWithConversion (tryRead "min gain limit")
+ (\g opts -> Ok opts { optMinGainLim = g }) "SCORE")
+ "minimum cluster score for which we start checking the min-gain",
+ OptComplFloat)
oMinScore :: OptType
-oMinScore = Option "e" ["min-score"]
- (ReqArg (\ e opts -> Ok opts { optMinScore = read e }) "EPSILON")
- "mininum score to aim for"
+oMinScore =
+ (Option "e" ["min-score"]
+ (reqWithConversion (tryRead "min score")
+ (\e opts -> Ok opts { optMinScore = e }) "EPSILON")
+ "mininum score to aim for",
+ OptComplFloat)
oNoHeaders :: OptType
-oNoHeaders = Option "" ["no-headers"]
- (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
- "do not show a header line"
+oNoHeaders =
+ (Option "" ["no-headers"]
+ (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
+ "do not show a header line",
+ OptComplNone)
+
+oNoSimulation :: OptType
+oNoSimulation =
+ (Option "" ["no-simulation"]
+ (NoArg (\opts -> Ok opts {optNoSimulation = True}))
+ "do not perform rebalancing simulation",
+ OptComplNone)
oNodeSim :: OptType
-oNodeSim = Option "" ["simulate"]
- (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
- "simulate an empty cluster, given as 'num_nodes,disk,ram,cpu'"
+oNodeSim =
+ (Option "" ["simulate"]
+ (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
+ "simulate an empty cluster, given as\
+ \ 'alloc_policy,num_nodes,disk,ram,cpu'",
+ OptComplString)
oOfflineNode :: OptType
-oOfflineNode = Option "O" ["offline"]
- (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
- "set node as offline"
+oOfflineNode =
+ (Option "O" ["offline"]
+ (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
+ "set node as offline",
+ OptComplOneNode)
oOutputDir :: OptType
-oOutputDir = Option "d" ["output-dir"]
- (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
- "directory in which to write output files"
+oOutputDir =
+ (Option "d" ["output-dir"]
+ (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
+ "directory in which to write output files",
+ OptComplDir)
oPrintCommands :: OptType
-oPrintCommands = Option "C" ["print-commands"]
- (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
- fromMaybe "-")
- "FILE")
- "print the ganeti command list for reaching the solution,\
- \ if an argument is passed then write the commands to a\
- \ file named as such"
+oPrintCommands =
+ (Option "C" ["print-commands"]
+ (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
+ fromMaybe "-")
+ "FILE")
+ "print the ganeti command list for reaching the solution,\
+ \ if an argument is passed then write the commands to a\
+ \ file named as such",
+ OptComplNone)
oPrintInsts :: OptType
-oPrintInsts = Option "" ["print-instances"]
- (NoArg (\ opts -> Ok opts { optShowInsts = True }))
- "print the final instance map"
+oPrintInsts =
+ (Option "" ["print-instances"]
+ (NoArg (\ opts -> Ok opts { optShowInsts = True }))
+ "print the final instance map",
+ OptComplNone)
oPrintNodes :: OptType
-oPrintNodes = Option "p" ["print-nodes"]
- (OptArg ((\ f opts ->
- let (prefix, realf) = case f of
- '+':rest -> (["+"], rest)
- _ -> ([], f)
- splitted = prefix ++ sepSplit ',' realf
- in Ok opts { optShowNodes = Just splitted }) .
- fromMaybe []) "FIELDS")
- "print the final node list"
+oPrintNodes =
+ (Option "p" ["print-nodes"]
+ (OptArg ((\ f opts ->
+ let (prefix, realf) = case f of
+ '+':rest -> (["+"], rest)
+ _ -> ([], f)
+ splitted = prefix ++ sepSplit ',' realf
+ in Ok opts { optShowNodes = Just splitted }) .
+ fromMaybe []) "FIELDS")
+ "print the final node list",
+ OptComplNone)
oQuiet :: OptType
-oQuiet = Option "q" ["quiet"]
- (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
- "decrease the verbosity level"
+oQuiet =
+ (Option "q" ["quiet"]
+ (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
+ "decrease the verbosity level",
+ OptComplNone)
oRapiMaster :: OptType
-oRapiMaster = Option "m" ["master"]
- (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
- "collect data via RAPI at the given ADDRESS"
+oRapiMaster =
+ (Option "m" ["master"]
+ (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
+ "collect data via RAPI at the given ADDRESS",
+ OptComplHost)
oSaveCluster :: OptType
-oSaveCluster = Option "S" ["save"]
- (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
- "Save cluster state at the end of the processing to FILE"
-
-oShowHelp :: OptType
-oShowHelp = Option "h" ["help"]
- (NoArg (\ opts -> Ok opts { optShowHelp = True}))
- "show help"
-
-oShowVer :: OptType
-oShowVer = Option "V" ["version"]
- (NoArg (\ opts -> Ok opts { optShowVer = True}))
- "show the version of the program"
+oSaveCluster =
+ (Option "S" ["save"]
+ (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
+ "Save cluster state at the end of the processing to FILE",
+ OptComplNone)
oStdSpec :: OptType
-oStdSpec = Option "" ["standard-alloc"]
- (ReqArg (\ inp opts -> do
- tspec <- parseISpecString "standard" inp
- return $ opts { optStdSpec = Just tspec } )
- "STDSPEC")
- "enable standard specs allocation, given as 'disk,ram,cpu'"
+oStdSpec =
+ (Option "" ["standard-alloc"]
+ (ReqArg (\ inp opts -> do
+ tspec <- parseISpecString "standard" inp
+ return $ opts { optStdSpec = Just tspec } )
+ "STDSPEC")
+ "enable standard specs allocation, given as 'disk,ram,cpu'",
+ OptComplString)
oTieredSpec :: OptType
-oTieredSpec = Option "" ["tiered-alloc"]
- (ReqArg (\ inp opts -> do
- tspec <- parseISpecString "tiered" inp
- return $ opts { optTieredSpec = Just tspec } )
- "TSPEC")
- "enable tiered specs allocation, given as 'disk,ram,cpu'"
-
-oReplay :: OptType
-oReplay = Option "" ["replay"]
- (ReqArg (\ stat opts -> Ok opts { optReplay = Just stat } ) "STATE")
- "Pre-seed the random number generator with STATE"
+oTieredSpec =
+ (Option "" ["tiered-alloc"]
+ (ReqArg (\ inp opts -> do
+ tspec <- parseISpecString "tiered" inp
+ return $ opts { optTieredSpec = Just tspec } )
+ "TSPEC")
+ "enable tiered specs allocation, given as 'disk,ram,cpu'",
+ OptComplString)
oVerbose :: OptType
-oVerbose = Option "v" ["verbose"]
- (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
- "increase the verbosity level"
+oVerbose =
+ (Option "v" ["verbose"]
+ (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
+ "increase the verbosity level",
+ OptComplNone)
+
+-- | Generic options.
+genericOpts :: [GenericOptType Options]
+genericOpts = [ oShowVer
+ , oShowHelp
+ , oShowComp
+ ]
-- * Functions
--- | Helper for parsing a yes\/no command line flag.
-parseYesNo :: Bool -- ^ Default whalue (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'"
-
--- | Usage info.
-usageHelp :: String -> [OptType] -> String
-usageHelp progname =
- usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
- progname Version.version progname)
-
--- | Command line parser, using the 'Options' structure.
+-- | Wrapper over 'Common.parseOpts' with our custom options.
parseOpts :: [String] -- ^ The command line arguments
-> String -- ^ The program name
-> [OptType] -- ^ The supported command line options
+ -> [ArgCompletion] -- ^ The supported command line arguments
-> IO (Options, [String]) -- ^ The resulting options and leftover
-- arguments
-parseOpts 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
+parseOpts = Common.parseOpts defaultOptions
+
-- | A shell script template for autogenerated scripts.
shTemplate :: String
hPutStrLn stderr (msg ++ " status:")
hPutStrLn stderr $ fn fields
-
-- | Optionally print the instance list.
maybePrintInsts :: Bool -- ^ Whether to print the instance list
-> String -- ^ Type of the instance map (e.g. initial)
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 -- ^ Prefix to printed variables
+ -> [(String, String)] -- ^ List of (key, value) pairs to be printed
+ -> 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 -- ^ Prefix to printed variable
+ -> Bool -- ^ Whether output should be machine readable;
+ -- note: if not, there is nothing to print
+ -> 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_cpu = optMcpu opts
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
+ unless (null offline_wrong) .
+ 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