1 {-| Implementation of command-line functions.
3 This module holds the common command-line related functions for the
4 binaries, separated into this module since "Ganeti.Utils" is
5 used in many other places and this is more IO oriented.
11 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
13 This program is free software; you can redistribute it and/or modify
14 it under the terms of the GNU General Public License as published by
15 the Free Software Foundation; either version 2 of the License, or
16 (at your option) any later version.
18 This program is distributed in the hope that it will be useful, but
19 WITHOUT ANY WARRANTY; without even the implied warranty of
20 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 General Public License for more details.
23 You should have received a copy of the GNU General Public License
24 along with this program; if not, write to the Free Software
25 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
30 module Ganeti.HTools.CLI
34 , Ganeti.HTools.CLI.parseOpts
89 import Data.Char (toUpper)
90 import Data.Maybe (fromMaybe)
91 import System.Console.GetOpt
93 import Text.Printf (printf)
95 import qualified Ganeti.HTools.Container as Container
96 import qualified Ganeti.HTools.Node as Node
97 import qualified Ganeti.Path as Path
98 import Ganeti.HTools.Types
99 import Ganeti.BasicTypes
100 import Ganeti.Common as Common
105 -- | Command line options structure.
106 data Options = Options
107 { optDataFile :: Maybe FilePath -- ^ Path to the cluster data file
108 , optDiskMoves :: Bool -- ^ Allow disk moves
109 , optInstMoves :: Bool -- ^ Allow instance moves
110 , optDiskTemplate :: Maybe DiskTemplate -- ^ Override for the disk template
111 , optSpindleUse :: Maybe Int -- ^ Override for the spindle usage
112 , optDynuFile :: Maybe FilePath -- ^ Optional file with dynamic use data
113 , optEvacMode :: Bool -- ^ Enable evacuation mode
114 , optExInst :: [String] -- ^ Instances to be excluded
115 , optExTags :: Maybe [String] -- ^ Tags to use for exclusion
116 , optExecJobs :: Bool -- ^ Execute the commands via Luxi
117 , optGroup :: Maybe GroupID -- ^ The UUID of the group to process
118 , optIAllocSrc :: Maybe FilePath -- ^ The iallocation spec
119 , optSelInst :: [String] -- ^ Instances to be excluded
120 , optLuxi :: Maybe FilePath -- ^ Collect data from Luxi
121 , optMachineReadable :: Bool -- ^ Output machine-readable format
122 , optMaster :: String -- ^ Collect data from RAPI
123 , optMaxLength :: Int -- ^ Stop after this many steps
124 , optMcpu :: Maybe Double -- ^ Override max cpu ratio for nodes
125 , optMdsk :: Double -- ^ Max disk usage ratio for nodes
126 , optMinGain :: Score -- ^ Min gain we aim for in a step
127 , optMinGainLim :: Score -- ^ Limit below which we apply mingain
128 , optMinScore :: Score -- ^ The minimum score we aim for
129 , optNoHeaders :: Bool -- ^ Do not show a header line
130 , optNoSimulation :: Bool -- ^ Skip the rebalancing dry-run
131 , optNodeSim :: [String] -- ^ Cluster simulation mode
132 , optOffline :: [String] -- ^ Names of offline nodes
133 , optOutPath :: FilePath -- ^ Path to the output directory
134 , optSaveCluster :: Maybe FilePath -- ^ Save cluster state to this file
135 , optShowCmds :: Maybe FilePath -- ^ Whether to show the command list
136 , optShowHelp :: Bool -- ^ Just show the help
137 , optShowComp :: Bool -- ^ Just show the completion info
138 , optShowInsts :: Bool -- ^ Whether to show the instance map
139 , optShowNodes :: Maybe [String] -- ^ Whether to show node status
140 , optShowVer :: Bool -- ^ Just show the program version
141 , optStdSpec :: Maybe RSpec -- ^ Requested standard specs
142 , optTestCount :: Maybe Int -- ^ Optional test count override
143 , optTieredSpec :: Maybe RSpec -- ^ Requested specs for tiered mode
144 , optReplay :: Maybe String -- ^ Unittests: RNG state
145 , optVerbose :: Int -- ^ Verbosity level
148 -- | Default values for the command line options.
149 defaultOptions :: Options
150 defaultOptions = Options
151 { optDataFile = Nothing
152 , optDiskMoves = True
153 , optInstMoves = True
154 , optDiskTemplate = Nothing
155 , optSpindleUse = Nothing
156 , optDynuFile = Nothing
157 , optEvacMode = False
159 , optExTags = Nothing
160 , optExecJobs = False
162 , optIAllocSrc = Nothing
165 , optMachineReadable = False
169 , optMdsk = defReservedDiskRatio
171 , optMinGainLim = 1e-1
173 , optNoHeaders = False
174 , optNoSimulation = False
178 , optSaveCluster = Nothing
179 , optShowCmds = Nothing
180 , optShowHelp = False
181 , optShowComp = False
182 , optShowInsts = False
183 , optShowNodes = Nothing
185 , optStdSpec = Nothing
186 , optTestCount = Nothing
187 , optTieredSpec = Nothing
188 , optReplay = Nothing
192 -- | Abrreviation for the option type.
193 type OptType = GenericOptType Options
195 instance StandardOptions Options where
196 helpRequested = optShowHelp
197 verRequested = optShowVer
198 compRequested = optShowComp
199 requestHelp o = o { optShowHelp = True }
200 requestVer o = o { optShowVer = True }
201 requestComp o = o { optShowComp = True }
203 -- * Helper functions
205 parseISpecString :: String -> String -> Result RSpec
206 parseISpecString descr inp = do
207 let sp = sepSplit ',' inp
208 err = Bad ("Invalid " ++ descr ++ " specification: '" ++ inp ++
209 "', expected disk,ram,cpu")
210 when (length sp /= 3) err
211 prs <- mapM (\(fn, val) -> fn val) $
212 zip [ annotateResult (descr ++ " specs disk") . parseUnit
213 , annotateResult (descr ++ " specs memory") . parseUnit
214 , tryRead (descr ++ " specs cpus")
217 [dsk, ram, cpu] -> return $ RSpec cpu ram dsk
220 -- | Disk template choices.
221 optComplDiskTemplate :: OptCompletion
222 optComplDiskTemplate = OptComplChoices $
223 map diskTemplateToRaw [minBound..maxBound]
225 -- * Command line options
229 (Option "t" ["text-data"]
230 (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
231 "the cluster data FILE",
234 oDiskMoves :: OptType
236 (Option "" ["no-disk-moves"]
237 (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
238 "disallow disk moves from the list of allowed instance changes,\
239 \ thus allowing only the 'cheap' failover/migrate operations",
242 oDiskTemplate :: OptType
244 (Option "" ["disk-template"]
245 (reqWithConversion diskTemplateFromRaw
246 (\dt opts -> Ok opts { optDiskTemplate = Just dt })
247 "TEMPLATE") "select the desired disk template",
248 optComplDiskTemplate)
250 oSpindleUse :: OptType
252 (Option "" ["spindle-use"]
253 (reqWithConversion (tryRead "parsing spindle-use")
256 fail "Invalid value of the spindle-use (expected >= 0)"
257 return $ opts { optSpindleUse = Just su })
258 "SPINDLES") "select how many virtual spindle instances use\
259 \ [default read from cluster]",
264 (Option "" ["select-instances"]
265 (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
266 "only select given instances for any moves",
267 OptComplManyInstances)
269 oInstMoves :: OptType
271 (Option "" ["no-instance-moves"]
272 (NoArg (\ opts -> Ok opts { optInstMoves = False}))
273 "disallow instance (primary node) moves from the list of allowed,\
274 \ instance changes, thus allowing only slower, but sometimes\
275 \ safer, drbd secondary changes",
280 (Option "U" ["dynu-file"]
281 (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
282 "Import dynamic utilisation data from the given FILE",
287 (Option "E" ["evac-mode"]
288 (NoArg (\opts -> Ok opts { optEvacMode = True }))
289 "enable evacuation mode, where the algorithm only moves \
290 \ instances away from offline and drained nodes",
295 (Option "" ["exclude-instances"]
296 (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
297 "exclude given instances from any moves",
298 OptComplManyInstances)
302 (Option "" ["exclusion-tags"]
303 (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
304 "TAG,...") "Enable instance exclusion based on given tag prefix",
310 (NoArg (\ opts -> Ok opts { optExecJobs = True}))
311 "execute the suggested moves via Luxi (only available when using\
312 \ it for data gathering)",
317 (Option "G" ["group"]
318 (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
319 "the ID of the group to balance",
322 oIAllocSrc :: OptType
324 (Option "I" ["ialloc-src"]
325 (ReqArg (\ f opts -> Ok opts { optIAllocSrc = Just f }) "FILE")
326 "Specify an iallocator spec as the cluster data source",
329 genOLuxiSocket :: String -> OptType
330 genOLuxiSocket defSocket =
332 (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
333 fromMaybe defSocket) "SOCKET")
334 ("collect data via Luxi, optionally using the given SOCKET path [" ++
338 oLuxiSocket :: IO OptType
339 oLuxiSocket = liftM genOLuxiSocket Path.defaultLuxiSocket
341 oMachineReadable :: OptType
343 (Option "" ["machine-readable"]
344 (OptArg (\ f opts -> do
345 flag <- parseYesNo True f
346 return $ opts { optMachineReadable = flag }) "CHOICE")
347 "enable machine readable output (pass either 'yes' or 'no' to\
348 \ explicitly control the flag, or without an argument defaults to\
354 (Option "" ["max-cpu"]
355 (reqWithConversion (tryRead "parsing max-cpu")
358 fail "Invalid value of the max-cpu ratio, expected >0"
359 return $ opts { optMcpu = Just mcpu }) "RATIO")
360 "maximum virtual-to-physical cpu ratio for nodes (from 0\
361 \ upwards) [default read from cluster]",
364 oMaxSolLength :: OptType
366 (Option "l" ["max-length"]
367 (reqWithConversion (tryRead "max solution length")
368 (\i opts -> Ok opts { optMaxLength = i }) "N")
369 "cap the solution at this many balancing or allocation \
370 \ rounds (useful for very unbalanced clusters or empty \
376 (Option "" ["min-disk"]
377 (reqWithConversion (tryRead "min free disk space")
378 (\n opts -> Ok opts { optMdsk = n }) "RATIO")
379 "minimum free disk space for nodes (between 0 and 1) [0]",
384 (Option "g" ["min-gain"]
385 (reqWithConversion (tryRead "min gain")
386 (\g opts -> Ok opts { optMinGain = g }) "DELTA")
387 "minimum gain to aim for in a balancing step before giving up",
390 oMinGainLim :: OptType
392 (Option "" ["min-gain-limit"]
393 (reqWithConversion (tryRead "min gain limit")
394 (\g opts -> Ok opts { optMinGainLim = g }) "SCORE")
395 "minimum cluster score for which we start checking the min-gain",
400 (Option "e" ["min-score"]
401 (reqWithConversion (tryRead "min score")
402 (\e opts -> Ok opts { optMinScore = e }) "EPSILON")
403 "mininum score to aim for",
406 oNoHeaders :: OptType
408 (Option "" ["no-headers"]
409 (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
410 "do not show a header line",
413 oNoSimulation :: OptType
415 (Option "" ["no-simulation"]
416 (NoArg (\opts -> Ok opts {optNoSimulation = True}))
417 "do not perform rebalancing simulation",
422 (Option "" ["simulate"]
423 (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
424 "simulate an empty cluster, given as\
425 \ 'alloc_policy,num_nodes,disk,ram,cpu'",
428 oOfflineNode :: OptType
430 (Option "O" ["offline"]
431 (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
432 "set node as offline",
435 oOutputDir :: OptType
437 (Option "d" ["output-dir"]
438 (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
439 "directory in which to write output files",
442 oPrintCommands :: OptType
444 (Option "C" ["print-commands"]
445 (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
448 "print the ganeti command list for reaching the solution,\
449 \ if an argument is passed then write the commands to a\
450 \ file named as such",
453 oPrintInsts :: OptType
455 (Option "" ["print-instances"]
456 (NoArg (\ opts -> Ok opts { optShowInsts = True }))
457 "print the final instance map",
460 oPrintNodes :: OptType
462 (Option "p" ["print-nodes"]
463 (OptArg ((\ f opts ->
464 let (prefix, realf) = case f of
465 '+':rest -> (["+"], rest)
467 splitted = prefix ++ sepSplit ',' realf
468 in Ok opts { optShowNodes = Just splitted }) .
469 fromMaybe []) "FIELDS")
470 "print the final node list",
475 (Option "q" ["quiet"]
476 (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
477 "decrease the verbosity level",
480 oRapiMaster :: OptType
482 (Option "m" ["master"]
483 (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
484 "collect data via RAPI at the given ADDRESS",
487 oSaveCluster :: OptType
490 (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
491 "Save cluster state at the end of the processing to FILE",
496 (Option "" ["standard-alloc"]
497 (ReqArg (\ inp opts -> do
498 tspec <- parseISpecString "standard" inp
499 return $ opts { optStdSpec = Just tspec } )
501 "enable standard specs allocation, given as 'disk,ram,cpu'",
504 oTieredSpec :: OptType
506 (Option "" ["tiered-alloc"]
507 (ReqArg (\ inp opts -> do
508 tspec <- parseISpecString "tiered" inp
509 return $ opts { optTieredSpec = Just tspec } )
511 "enable tiered specs allocation, given as 'disk,ram,cpu'",
516 (Option "v" ["verbose"]
517 (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
518 "increase the verbosity level",
521 -- | Generic options.
522 genericOpts :: [GenericOptType Options]
523 genericOpts = [ oShowVer
530 -- | Wrapper over 'Common.parseOpts' with our custom options.
531 parseOpts :: [String] -- ^ The command line arguments
532 -> String -- ^ The program name
533 -> [OptType] -- ^ The supported command line options
534 -> [ArgCompletion] -- ^ The supported command line arguments
535 -> IO (Options, [String]) -- ^ The resulting options and leftover
537 parseOpts = Common.parseOpts defaultOptions
540 -- | A shell script template for autogenerated scripts.
543 printf "#!/bin/sh\n\n\
544 \# Auto-generated script for executing cluster rebalancing\n\n\
545 \# To stop, touch the file /tmp/stop-htools\n\n\
548 \ if [ -f /tmp/stop-htools ]; then\n\
549 \ echo 'Stop requested, exiting'\n\
554 -- | Optionally print the node list.
555 maybePrintNodes :: Maybe [String] -- ^ The field list
556 -> String -- ^ Informational message
557 -> ([String] -> String) -- ^ Function to generate the listing
559 maybePrintNodes Nothing _ _ = return ()
560 maybePrintNodes (Just fields) msg fn = do
562 hPutStrLn stderr (msg ++ " status:")
563 hPutStrLn stderr $ fn fields
565 -- | Optionally print the instance list.
566 maybePrintInsts :: Bool -- ^ Whether to print the instance list
567 -> String -- ^ Type of the instance map (e.g. initial)
568 -> String -- ^ The instance data
570 maybePrintInsts do_print msg instdata =
573 hPutStrLn stderr $ msg ++ " instance map:"
574 hPutStr stderr instdata
576 -- | Function to display warning messages from parsing the cluster
578 maybeShowWarnings :: [String] -- ^ The warning messages
580 maybeShowWarnings fix_msgs =
581 unless (null fix_msgs) $ do
582 hPutStrLn stderr "Warning: cluster has inconsistent data:"
583 hPutStrLn stderr . unlines . map (printf " - %s") $ fix_msgs
585 -- | Format a list of key, value as a shell fragment.
586 printKeys :: String -- ^ Prefix to printed variables
587 -> [(String, String)] -- ^ List of (key, value) pairs to be printed
591 printf "%s_%s=%s\n" prefix (map toUpper k) (ensureQuoted v))
593 -- | Prints the final @OK@ marker in machine readable output.
594 printFinal :: String -- ^ Prefix to printed variable
595 -> Bool -- ^ Whether output should be machine readable;
596 -- note: if not, there is nothing to print
598 printFinal prefix True =
599 -- this should be the final entry
600 printKeys prefix [("OK", "1")]
602 printFinal _ False = return ()
604 -- | Potentially set the node as offline based on passed offline list.
605 setNodeOffline :: [Ndx] -> Node.Node -> Node.Node
606 setNodeOffline offline_indices n =
607 if Node.idx n `elem` offline_indices
608 then Node.setOffline n True
611 -- | Set node properties based on command line options.
612 setNodeStatus :: Options -> Node.List -> IO Node.List
613 setNodeStatus opts fixed_nl = do
614 let offline_passed = optOffline opts
615 all_nodes = Container.elems fixed_nl
616 offline_lkp = map (lookupName (map Node.name all_nodes)) offline_passed
617 offline_wrong = filter (not . goodLookupResult) offline_lkp
618 offline_names = map lrContent offline_lkp
619 offline_indices = map Node.idx $
620 filter (\n -> Node.name n `elem` offline_names)
625 unless (null offline_wrong) .
626 exitErr $ printf "wrong node name(s) set as offline: %s\n"
627 (commaJoin (map lrContent offline_wrong))
628 let setMCpuFn = case m_cpu of
630 Just new_mcpu -> flip Node.setMcpu new_mcpu
631 let nm = Container.map (setNodeOffline offline_indices .
632 flip Node.setMdsk m_dsk .