| {-| Implementation of command-line functions. |
| |
| This module holds the common command-line related functions for the |
| 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, 2012, 2013 Google Inc. |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
| modification, are permitted provided that the following conditions are |
| met: |
| |
| 1. Redistributions of source code must retain the above copyright notice, |
| this list of conditions and the following disclaimer. |
| |
| 2. Redistributions in binary form must reproduce the above copyright |
| notice, this list of conditions and the following disclaimer in the |
| documentation and/or other materials provided with the distribution. |
| |
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS |
| IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED |
| TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR |
| PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR |
| CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, |
| EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, |
| PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR |
| PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF |
| LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING |
| NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS |
| SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
| |
| -} |
| |
| module Ganeti.HTools.CLI |
| ( Options(..) |
| , OptType |
| , defaultOptions |
| , Ganeti.HTools.CLI.parseOpts |
| , parseOptsInner |
| , parseYesNo |
| , parseISpecString |
| , shTemplate |
| , maybePrintNodes |
| , maybePrintInsts |
| , maybeShowWarnings |
| , printKeys |
| , printFinal |
| , setNodeStatus |
| -- * The options |
| , oDataFile |
| , oDiskMoves |
| , oDiskTemplate |
| , oSpindleUse |
| , oDynuFile |
| , oMonD |
| , oMonDDataFile |
| , oEvacMode |
| , oRestrictedMigrate |
| , oExInst |
| , oExTags |
| , oExecJobs |
| , oForce |
| , oFullEvacuation |
| , oGroup |
| , oIAllocSrc |
| , oIgnoreDyn |
| , oIgnoreNonRedundant |
| , oIndependentGroups |
| , oAcceptExisting |
| , oInstMoves |
| , oJobDelay |
| , genOLuxiSocket |
| , oLuxiSocket |
| , oMachineReadable |
| , oMaxCpu |
| , oMaxSolLength |
| , oMinDisk |
| , oMinGain |
| , oMinGainLim |
| , oMinScore |
| , oNoHeaders |
| , oNoSimulation |
| , oNodeSim |
| , oNodeTags |
| , oOfflineMaintenance |
| , oOfflineNode |
| , oOneStepOnly |
| , oOutputDir |
| , oPrintCommands |
| , oPrintInsts |
| , oPrintMoves |
| , oPrintNodes |
| , oQuiet |
| , oRapiMaster |
| , oSaveCluster |
| , oSelInst |
| , oShowHelp |
| , oShowVer |
| , oShowComp |
| , oSkipNonRedundant |
| , oStdSpec |
| , oTieredSpec |
| , oVerbose |
| , oPriority |
| , genericOpts |
| ) where |
| |
| import Control.Monad |
| import Data.Char (toUpper) |
| import Data.Maybe (fromMaybe) |
| import System.Console.GetOpt |
| import System.IO |
| import Text.Printf (printf) |
| |
| import qualified Ganeti.HTools.Container as Container |
| import qualified Ganeti.HTools.Node as Node |
| import qualified Ganeti.Path as Path |
| import Ganeti.HTools.Types |
| import Ganeti.BasicTypes |
| import Ganeti.Common as Common |
| import Ganeti.Types |
| import Ganeti.Utils |
| |
| -- * Data types |
| |
| -- | Command line options structure. |
| data Options = Options |
| { optDataFile :: Maybe FilePath -- ^ Path to the cluster data file |
| , 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 |
| , optIgnoreDynu :: Bool -- ^ Do not use dynamic use data |
| , optIndependentGroups :: Bool -- ^ consider groups independently |
| , optAcceptExisting :: Bool -- ^ accept existing N+1 violations |
| , optMonD :: Bool -- ^ Query MonDs |
| , optMonDFile :: Maybe FilePath -- ^ Optional file with data provided |
| -- by MonDs |
| , optEvacMode :: Bool -- ^ Enable evacuation mode |
| , optRestrictedMigrate :: Bool -- ^ Disallow replace-primary moves |
| , optExInst :: [String] -- ^ Instances to be excluded |
| , optExTags :: Maybe [String] -- ^ Tags to use for exclusion |
| , optExecJobs :: Bool -- ^ Execute the commands via Luxi |
| , optForce :: Bool -- ^ Force the execution |
| , optFullEvacuation :: Bool -- ^ Fully evacuate nodes to be rebooted |
| , optGroup :: Maybe GroupID -- ^ The UUID of the group to process |
| , optIAllocSrc :: Maybe FilePath -- ^ The iallocation spec |
| , optIgnoreNonRedundant :: Bool -- ^ Ignore non-redundant instances |
| , optSelInst :: [String] -- ^ Instances to be excluded |
| , optLuxi :: Maybe FilePath -- ^ Collect data from Luxi |
| , optJobDelay :: Double -- ^ Delay before executing first job |
| , optMachineReadable :: Bool -- ^ Output machine-readable format |
| , optMaster :: String -- ^ Collect data from RAPI |
| , optMaxLength :: Int -- ^ Stop after this many steps |
| , 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 |
| , optNodeTags :: Maybe [String] -- ^ List of node tags to restrict to |
| , optOffline :: [String] -- ^ Names of offline nodes |
| , optOfflineMaintenance :: Bool -- ^ Pretend all instances are offline |
| , optOneStepOnly :: Bool -- ^ Only do the first step |
| , optOutPath :: FilePath -- ^ Path to the output directory |
| , optPrintMoves :: Bool -- ^ Whether to show the instance moves |
| , 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 |
| , optSkipNonRedundant :: Bool -- ^ Skip nodes with non-redundant instance |
| , 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 |
| , optPriority :: Maybe OpSubmitPriority -- ^ OpCode submit priority |
| } deriving Show |
| |
| -- | Default values for the command line options. |
| defaultOptions :: Options |
| defaultOptions = Options |
| { optDataFile = Nothing |
| , optDiskMoves = True |
| , optInstMoves = True |
| , optIndependentGroups = False |
| , optAcceptExisting = False |
| , optDiskTemplate = Nothing |
| , optSpindleUse = Nothing |
| , optIgnoreDynu = False |
| , optDynuFile = Nothing |
| , optMonD = False |
| , optMonDFile = Nothing |
| , optEvacMode = False |
| , optRestrictedMigrate = False |
| , optExInst = [] |
| , optExTags = Nothing |
| , optExecJobs = False |
| , optForce = False |
| , optFullEvacuation = False |
| , optGroup = Nothing |
| , optIAllocSrc = Nothing |
| , optIgnoreNonRedundant = False |
| , optSelInst = [] |
| , optLuxi = Nothing |
| , optJobDelay = 10 |
| , optMachineReadable = False |
| , optMaster = "" |
| , optMaxLength = -1 |
| , optMcpu = Nothing |
| , optMdsk = defReservedDiskRatio |
| , optMinGain = 1e-2 |
| , optMinGainLim = 1e-1 |
| , optMinScore = 1e-9 |
| , optNoHeaders = False |
| , optNoSimulation = False |
| , optNodeSim = [] |
| , optNodeTags = Nothing |
| , optSkipNonRedundant = False |
| , optOffline = [] |
| , optOfflineMaintenance = False |
| , optOneStepOnly = False |
| , optOutPath = "." |
| , optPrintMoves = False |
| , optSaveCluster = Nothing |
| , optShowCmds = Nothing |
| , optShowHelp = False |
| , optShowComp = False |
| , optShowInsts = False |
| , optShowNodes = Nothing |
| , optShowVer = False |
| , optStdSpec = Nothing |
| , optTestCount = Nothing |
| , optTieredSpec = Nothing |
| , optReplay = Nothing |
| , optVerbose = 1 |
| , optPriority = Nothing |
| } |
| |
| -- | Abbreviation for the option type. |
| 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 || length sp > 4) err |
| prs <- mapM (\(fn, val) -> fn val) $ |
| zip [ annotateResult (descr ++ " specs disk") . parseUnit |
| , annotateResult (descr ++ " specs memory") . parseUnit |
| , tryRead (descr ++ " specs cpus") |
| , tryRead (descr ++ " specs spindles") |
| ] sp |
| case prs of |
| {- Spindles are optional, so that they are not needed when exclusive storage |
| is disabled. When exclusive storage is disabled, spindles are ignored, |
| so the actual value doesn't matter. We use 1 as a default so that in |
| case someone forgets and exclusive storage is enabled, we don't run into |
| weird situations. -} |
| [dsk, ram, cpu] -> return $ RSpec cpu ram dsk 1 |
| [dsk, ram, cpu, spn] -> return $ RSpec cpu ram dsk spn |
| _ -> 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", |
| 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", |
| OptComplNone) |
| |
| oMonD :: OptType |
| oMonD = |
| (Option "" ["mond"] |
| (NoArg (\ opts -> Ok opts {optMonD = True})) |
| "Query MonDs", |
| OptComplNone) |
| |
| oMonDDataFile :: OptType |
| oMonDDataFile = |
| (Option "" ["mond-data"] |
| (ReqArg (\ f opts -> Ok opts { optMonDFile = Just f }) "FILE") |
| "Import data provided by MonDs from the given FILE", |
| OptComplFile) |
| |
| oDiskTemplate :: OptType |
| 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", |
| 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", |
| 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", |
| OptComplFile) |
| |
| oIgnoreDyn :: OptType |
| oIgnoreDyn = |
| (Option "" ["ignore-dynu"] |
| (NoArg (\ opts -> Ok opts {optIgnoreDynu = True})) |
| "Ignore any dynamic utilisation information", |
| OptComplNone) |
| |
| oIndependentGroups :: OptType |
| oIndependentGroups = |
| (Option "" ["independent-groups"] |
| (NoArg (\ opts -> Ok opts {optIndependentGroups = True})) |
| "Consider groups independently", |
| OptComplNone) |
| |
| oAcceptExisting :: OptType |
| oAcceptExisting = |
| (Option "" ["accept-existing-errors"] |
| (NoArg (\ opts -> Ok opts {optAcceptExisting = True})) |
| "Accept existing N+1 violations; just don't add new ones", |
| OptComplNone) |
| |
| 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", |
| OptComplNone) |
| |
| oRestrictedMigrate :: OptType |
| oRestrictedMigrate = |
| (Option "" ["restricted-migration"] |
| (NoArg (\opts -> Ok opts { optRestrictedMigrate = True })) |
| "disallow replace-primary moves (aka frf-moves); in evacuation mode, this\ |
| \ will ensure that the only migrations are off the drained nodes", |
| OptComplNone) |
| |
| oExInst :: OptType |
| 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", |
| 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)", |
| OptComplNone) |
| |
| oForce :: OptType |
| oForce = |
| (Option "f" ["force"] |
| (NoArg (\ opts -> Ok opts {optForce = True})) |
| "force the execution of this program, even if warnings would\ |
| \ otherwise prevent it", |
| OptComplNone) |
| |
| oFullEvacuation :: OptType |
| oFullEvacuation = |
| (Option "" ["full-evacuation"] |
| (NoArg (\ opts -> Ok opts { optFullEvacuation = True})) |
| "fully evacuate the nodes to be rebooted", |
| OptComplNone) |
| |
| oGroup :: OptType |
| oGroup = |
| (Option "G" ["group"] |
| (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID") |
| "the target node group (name or UUID)", |
| 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) |
| |
| oIgnoreNonRedundant :: OptType |
| oIgnoreNonRedundant = |
| (Option "" ["ignore-non-redundant"] |
| (NoArg (\ opts -> Ok opts { optIgnoreNonRedundant = True })) |
| "Pretend that there are no non-redundant instances in the cluster", |
| OptComplNone) |
| |
| oJobDelay :: OptType |
| oJobDelay = |
| (Option "" ["job-delay"] |
| (reqWithConversion (tryRead "job delay") |
| (\d opts -> Ok opts { optJobDelay = d }) "SECONDS") |
| "insert this much delay before the execution of repair jobs\ |
| \ to allow the tool to continue processing instances", |
| OptComplFloat) |
| |
| genOLuxiSocket :: String -> OptType |
| genOLuxiSocket defSocket = |
| (Option "L" ["luxi"] |
| (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) . |
| fromMaybe defSocket) "SOCKET") |
| ("collect data via Luxi, optionally using the given SOCKET path [" ++ |
| defSocket ++ "]"), |
| OptComplFile) |
| |
| oLuxiSocket :: IO OptType |
| oLuxiSocket = liftM genOLuxiSocket Path.defaultLuxiSocket |
| |
| 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\ |
| \ explicitly control the flag, or without an argument defaults to\ |
| \ yes)", |
| optComplYesNo) |
| |
| oMaxCpu :: OptType |
| 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"] |
| (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"] |
| (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"] |
| (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"] |
| (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"] |
| (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", |
| 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\ |
| \ 'alloc_policy,num_nodes,disk,ram,cpu'", |
| OptComplString) |
| |
| oNodeTags :: OptType |
| oNodeTags = |
| (Option "" ["node-tags"] |
| (ReqArg (\ f opts -> Ok opts { optNodeTags = Just $ sepSplit ',' f }) |
| "TAG,...") "Restrict to nodes with the given tags", |
| OptComplString) |
| |
| oOfflineMaintenance :: OptType |
| oOfflineMaintenance = |
| (Option "" ["offline-maintenance"] |
| (NoArg (\ opts -> Ok opts {optOfflineMaintenance = True})) |
| "Schedule offline maintenance, i.e., pretend that all instance are\ |
| \ offline.", |
| OptComplNone) |
| |
| oOfflineNode :: OptType |
| oOfflineNode = |
| (Option "O" ["offline"] |
| (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE") |
| "set node as offline", |
| OptComplOneNode) |
| |
| oOneStepOnly :: OptType |
| oOneStepOnly = |
| (Option "" ["one-step-only"] |
| (NoArg (\ opts -> Ok opts {optOneStepOnly = True})) |
| "Only do the first step", |
| OptComplNone) |
| |
| oOutputDir :: OptType |
| 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", |
| OptComplNone) |
| |
| oPrintInsts :: OptType |
| oPrintInsts = |
| (Option "" ["print-instances"] |
| (NoArg (\ opts -> Ok opts { optShowInsts = True })) |
| "print the final instance map", |
| OptComplNone) |
| |
| oPrintMoves :: OptType |
| oPrintMoves = |
| (Option "" ["print-moves"] |
| (NoArg (\ opts -> Ok opts { optPrintMoves = True })) |
| "print the moves of the instances", |
| 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", |
| OptComplNone) |
| |
| oQuiet :: OptType |
| 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", |
| 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", |
| OptComplNone) |
| |
| oSkipNonRedundant :: OptType |
| oSkipNonRedundant = |
| (Option "" ["skip-non-redundant"] |
| (NoArg (\ opts -> Ok opts { optSkipNonRedundant = True })) |
| "Skip nodes that host a non-redundant instance", |
| 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'", |
| 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'", |
| OptComplString) |
| |
| oVerbose :: OptType |
| oVerbose = |
| (Option "v" ["verbose"] |
| (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 })) |
| "increase the verbosity level", |
| OptComplNone) |
| |
| oPriority :: OptType |
| oPriority = |
| (Option "" ["priority"] |
| (ReqArg (\ inp opts -> do |
| prio <- parseSubmitPriority inp |
| Ok opts { optPriority = Just prio }) "PRIO") |
| "set the priority of submitted jobs", |
| OptComplChoices (map fmtSubmitPriority [minBound..maxBound])) |
| |
| -- | Generic options. |
| genericOpts :: [GenericOptType Options] |
| genericOpts = [ oShowVer |
| , oShowHelp |
| , oShowComp |
| ] |
| |
| -- * Functions |
| |
| -- | 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 = Common.parseOpts defaultOptions |
| |
| |
| -- | A shell script template for autogenerated scripts. |
| shTemplate :: String |
| shTemplate = |
| printf "#!/bin/sh\n\n\ |
| \# Auto-generated script for executing cluster rebalancing\n\n\ |
| \# To stop, touch the file /tmp/stop-htools\n\n\ |
| \set -e\n\n\ |
| \check() {\n\ |
| \ if [ -f /tmp/stop-htools ]; then\n\ |
| \ echo 'Stop requested, exiting'\n\ |
| \ exit 0\n\ |
| \ fi\n\ |
| \}\n\n" |
| |
| -- | Optionally print the node list. |
| maybePrintNodes :: Maybe [String] -- ^ The field list |
| -> String -- ^ Informational message |
| -> ([String] -> String) -- ^ Function to generate the listing |
| -> IO () |
| maybePrintNodes Nothing _ _ = return () |
| maybePrintNodes (Just fields) msg fn = do |
| hPutStrLn stderr "" |
| 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) |
| -> String -- ^ The instance data |
| -> IO () |
| maybePrintInsts do_print msg instdata = |
| when do_print $ do |
| hPutStrLn stderr "" |
| hPutStrLn stderr $ msg ++ " instance map:" |
| hPutStr stderr instdata |
| |
| -- | Function to display warning messages from parsing the cluster |
| -- state. |
| maybeShowWarnings :: [String] -- ^ The warning messages |
| -> IO () |
| maybeShowWarnings fix_msgs = |
| unless (null fix_msgs) $ do |
| 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 |
| let offline_passed = optOffline opts |
| all_nodes = Container.elems fixed_nl |
| offline_lkp = map (lookupName (map Node.name all_nodes)) offline_passed |
| offline_wrong = filter (not . goodLookupResult) offline_lkp |
| offline_names = map lrContent offline_lkp |
| offline_indices = map Node.idx $ |
| filter (\n -> Node.name n `elem` offline_names) |
| all_nodes |
| m_cpu = optMcpu opts |
| m_dsk = optMdsk opts |
| |
| 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 |
