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.HTools.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
85 import Data.Maybe (fromMaybe)
86 import qualified Data.Version
87 import System.Console.GetOpt
91 import Text.Printf (printf)
93 import qualified Ganeti.HTools.Version as Version(version)
94 import qualified Ganeti.HTools.Container as Container
95 import qualified Ganeti.HTools.Node as Node
96 import qualified Ganeti.Constants as C
97 import Ganeti.HTools.Types
98 import Ganeti.HTools.Utils
99 import Ganeti.HTools.Loader
103 -- | The default value for the luxi socket.
105 -- This is re-exported from the "Ganeti.Constants" module.
106 defaultLuxiSocket :: FilePath
107 defaultLuxiSocket = C.masterSocket
111 -- | Command line options structure.
112 data Options = Options
113 { optDataFile :: Maybe FilePath -- ^ Path to the cluster data file
114 , optDiskMoves :: Bool -- ^ Allow disk moves
115 , optInstMoves :: Bool -- ^ Allow instance moves
116 , optDiskTemplate :: Maybe DiskTemplate -- ^ Override for the disk template
117 , optSpindleUse :: Maybe Int -- ^ Override for the spindle usage
118 , optDynuFile :: Maybe FilePath -- ^ Optional file with dynamic use data
119 , optEvacMode :: Bool -- ^ Enable evacuation mode
120 , optExInst :: [String] -- ^ Instances to be excluded
121 , optExTags :: Maybe [String] -- ^ Tags to use for exclusion
122 , optExecJobs :: Bool -- ^ Execute the commands via Luxi
123 , optGroup :: Maybe GroupID -- ^ The UUID of the group to process
124 , optIAllocSrc :: Maybe FilePath -- ^ The iallocation spec
125 , optSelInst :: [String] -- ^ Instances to be excluded
126 , optLuxi :: Maybe FilePath -- ^ Collect data from Luxi
127 , optMachineReadable :: Bool -- ^ Output machine-readable format
128 , optMaster :: String -- ^ Collect data from RAPI
129 , optMaxLength :: Int -- ^ Stop after this many steps
130 , optMcpu :: Maybe Double -- ^ Override max cpu ratio for nodes
131 , optMdsk :: Double -- ^ Max disk usage ratio for nodes
132 , optMinGain :: Score -- ^ Min gain we aim for in a step
133 , optMinGainLim :: Score -- ^ Limit below which we apply mingain
134 , optMinScore :: Score -- ^ The minimum score we aim for
135 , optNoHeaders :: Bool -- ^ Do not show a header line
136 , optNodeSim :: [String] -- ^ Cluster simulation mode
137 , optOffline :: [String] -- ^ Names of offline nodes
138 , optOutPath :: FilePath -- ^ Path to the output directory
139 , optSaveCluster :: Maybe FilePath -- ^ Save cluster state to this file
140 , optShowCmds :: Maybe FilePath -- ^ Whether to show the command list
141 , optShowHelp :: Bool -- ^ Just show the help
142 , optShowInsts :: Bool -- ^ Whether to show the instance map
143 , optShowNodes :: Maybe [String] -- ^ Whether to show node status
144 , optShowVer :: Bool -- ^ Just show the program version
145 , optStdSpec :: Maybe RSpec -- ^ Requested standard specs
146 , optTestCount :: Maybe Int -- ^ Optional test count override
147 , optTieredSpec :: Maybe RSpec -- ^ Requested specs for tiered mode
148 , optReplay :: Maybe String -- ^ Unittests: RNG state
149 , optVerbose :: Int -- ^ Verbosity level
152 -- | Default values for the command line options.
153 defaultOptions :: Options
154 defaultOptions = Options
155 { optDataFile = Nothing
156 , optDiskMoves = True
157 , optInstMoves = True
158 , optDiskTemplate = Nothing
159 , optSpindleUse = Nothing
160 , optDynuFile = Nothing
161 , optEvacMode = False
163 , optExTags = Nothing
164 , optExecJobs = False
166 , optIAllocSrc = Nothing
169 , optMachineReadable = False
173 , optMdsk = defReservedDiskRatio
175 , optMinGainLim = 1e-1
177 , optNoHeaders = False
181 , optSaveCluster = Nothing
182 , optShowCmds = Nothing
183 , optShowHelp = False
184 , optShowInsts = False
185 , optShowNodes = Nothing
187 , optStdSpec = Nothing
188 , optTestCount = Nothing
189 , optTieredSpec = Nothing
190 , optReplay = Nothing
194 -- | Abrreviation for the option type.
195 type OptType = OptDescr (Options -> Result Options)
197 -- * Helper functions
199 parseISpecString :: String -> String -> Result RSpec
200 parseISpecString descr inp = do
201 let sp = sepSplit ',' inp
202 err = Bad ("Invalid " ++ descr ++ " specification: '" ++ inp ++
203 "', expected disk,ram,cpu")
204 when (length sp /= 3) err
205 prs <- mapM (\(fn, val) -> fn val) $
206 zip [ annotateResult (descr ++ " specs disk") . parseUnit
207 , annotateResult (descr ++ " specs memory") . parseUnit
208 , tryRead (descr ++ " specs cpus")
211 [dsk, ram, cpu] -> return $ RSpec cpu ram dsk
214 -- * Command line options
217 oDataFile = Option "t" ["text-data"]
218 (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
219 "the cluster data FILE"
221 oDiskMoves :: OptType
222 oDiskMoves = Option "" ["no-disk-moves"]
223 (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
224 "disallow disk moves from the list of allowed instance changes,\
225 \ thus allowing only the 'cheap' failover/migrate operations"
227 oDiskTemplate :: OptType
228 oDiskTemplate = Option "" ["disk-template"]
229 (ReqArg (\ t opts -> do
230 dt <- diskTemplateFromRaw t
231 return $ opts { optDiskTemplate = Just dt })
232 "TEMPLATE") "select the desired disk template"
234 oSpindleUse :: OptType
235 oSpindleUse = Option "" ["spindle-use"]
236 (ReqArg (\ n opts -> do
237 su <- tryRead "parsing spindle-use" n
239 fail "Invalid value of the spindle-use\
241 return $ opts { optSpindleUse = Just su })
242 "SPINDLES") "select how many virtual spindle instances use\
243 \ [default read from cluster]"
246 oSelInst = Option "" ["select-instances"]
247 (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
248 "only select given instances for any moves"
250 oInstMoves :: OptType
251 oInstMoves = Option "" ["no-instance-moves"]
252 (NoArg (\ opts -> Ok opts { optInstMoves = False}))
253 "disallow instance (primary node) moves from the list of allowed,\
254 \ instance changes, thus allowing only slower, but sometimes\
255 \ safer, drbd secondary changes"
258 oDynuFile = Option "U" ["dynu-file"]
259 (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
260 "Import dynamic utilisation data from the given FILE"
263 oEvacMode = Option "E" ["evac-mode"]
264 (NoArg (\opts -> Ok opts { optEvacMode = True }))
265 "enable evacuation mode, where the algorithm only moves \
266 \ instances away from offline and drained nodes"
269 oExInst = Option "" ["exclude-instances"]
270 (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
271 "exclude given instances from any moves"
274 oExTags = Option "" ["exclusion-tags"]
275 (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
276 "TAG,...") "Enable instance exclusion based on given tag prefix"
279 oExecJobs = Option "X" ["exec"]
280 (NoArg (\ opts -> Ok opts { optExecJobs = True}))
281 "execute the suggested moves via Luxi (only available when using\
282 \ it for data gathering)"
285 oGroup = Option "G" ["group"]
286 (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
287 "the ID of the group to balance"
289 oIAllocSrc :: OptType
290 oIAllocSrc = Option "I" ["ialloc-src"]
291 (ReqArg (\ f opts -> Ok opts { optIAllocSrc = Just f }) "FILE")
292 "Specify an iallocator spec as the cluster data source"
294 oLuxiSocket :: OptType
295 oLuxiSocket = Option "L" ["luxi"]
296 (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
297 fromMaybe defaultLuxiSocket) "SOCKET")
298 "collect data via Luxi, optionally using the given SOCKET path"
300 oMachineReadable :: OptType
301 oMachineReadable = Option "" ["machine-readable"]
302 (OptArg (\ f opts -> do
303 flag <- parseYesNo True f
304 return $ opts { optMachineReadable = flag }) "CHOICE")
305 "enable machine readable output (pass either 'yes' or 'no' to\
306 \ explicitely control the flag, or without an argument defaults to\
310 oMaxCpu = Option "" ["max-cpu"]
311 (ReqArg (\ n opts -> do
312 mcpu <- tryRead "parsing max-cpu" n
314 fail "Invalid value of the max-cpu ratio,\
316 return $ opts { optMcpu = Just mcpu }) "RATIO")
317 "maximum virtual-to-physical cpu ratio for nodes (from 0\
318 \ upwards) [default read from cluster]"
320 oMaxSolLength :: OptType
321 oMaxSolLength = Option "l" ["max-length"]
322 (ReqArg (\ i opts -> Ok opts { optMaxLength = read i }) "N")
323 "cap the solution at this many balancing or allocation \
324 \ rounds (useful for very unbalanced clusters or empty \
328 oMinDisk = Option "" ["min-disk"]
329 (ReqArg (\ n opts -> Ok opts { optMdsk = read n }) "RATIO")
330 "minimum free disk space for nodes (between 0 and 1) [0]"
333 oMinGain = Option "g" ["min-gain"]
334 (ReqArg (\ g opts -> Ok opts { optMinGain = read g }) "DELTA")
335 "minimum gain to aim for in a balancing step before giving up"
337 oMinGainLim :: OptType
338 oMinGainLim = Option "" ["min-gain-limit"]
339 (ReqArg (\ g opts -> Ok opts { optMinGainLim = read g }) "SCORE")
340 "minimum cluster score for which we start checking the min-gain"
343 oMinScore = Option "e" ["min-score"]
344 (ReqArg (\ e opts -> Ok opts { optMinScore = read e }) "EPSILON")
345 "mininum score to aim for"
347 oNoHeaders :: OptType
348 oNoHeaders = Option "" ["no-headers"]
349 (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
350 "do not show a header line"
353 oNodeSim = Option "" ["simulate"]
354 (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
355 "simulate an empty cluster, given as 'num_nodes,disk,ram,cpu'"
357 oOfflineNode :: OptType
358 oOfflineNode = Option "O" ["offline"]
359 (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
360 "set node as offline"
362 oOutputDir :: OptType
363 oOutputDir = Option "d" ["output-dir"]
364 (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
365 "directory in which to write output files"
367 oPrintCommands :: OptType
368 oPrintCommands = Option "C" ["print-commands"]
369 (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
372 "print the ganeti command list for reaching the solution,\
373 \ if an argument is passed then write the commands to a\
374 \ file named as such"
376 oPrintInsts :: OptType
377 oPrintInsts = Option "" ["print-instances"]
378 (NoArg (\ opts -> Ok opts { optShowInsts = True }))
379 "print the final instance map"
381 oPrintNodes :: OptType
382 oPrintNodes = Option "p" ["print-nodes"]
383 (OptArg ((\ f opts ->
384 let (prefix, realf) = case f of
385 '+':rest -> (["+"], rest)
387 splitted = prefix ++ sepSplit ',' realf
388 in Ok opts { optShowNodes = Just splitted }) .
389 fromMaybe []) "FIELDS")
390 "print the final node list"
393 oQuiet = Option "q" ["quiet"]
394 (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
395 "decrease the verbosity level"
397 oRapiMaster :: OptType
398 oRapiMaster = Option "m" ["master"]
399 (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
400 "collect data via RAPI at the given ADDRESS"
402 oSaveCluster :: OptType
403 oSaveCluster = Option "S" ["save"]
404 (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
405 "Save cluster state at the end of the processing to FILE"
408 oShowHelp = Option "h" ["help"]
409 (NoArg (\ opts -> Ok opts { optShowHelp = True}))
413 oShowVer = Option "V" ["version"]
414 (NoArg (\ opts -> Ok opts { optShowVer = True}))
415 "show the version of the program"
418 oStdSpec = Option "" ["standard-alloc"]
419 (ReqArg (\ inp opts -> do
420 tspec <- parseISpecString "standard" inp
421 return $ opts { optStdSpec = Just tspec } )
423 "enable standard specs allocation, given as 'disk,ram,cpu'"
425 oTestCount :: OptType
426 oTestCount = Option "" ["test-count"]
427 (ReqArg (\ inp opts -> do
428 tcount <- tryRead "parsing test count" inp
429 return $ opts { optTestCount = Just tcount } )
431 "override the target test count"
433 oTieredSpec :: OptType
434 oTieredSpec = Option "" ["tiered-alloc"]
435 (ReqArg (\ inp opts -> do
436 tspec <- parseISpecString "tiered" inp
437 return $ opts { optTieredSpec = Just tspec } )
439 "enable tiered specs allocation, given as 'disk,ram,cpu'"
442 oReplay = Option "" ["replay"]
443 (ReqArg (\ stat opts -> Ok opts { optReplay = Just stat } ) "STATE")
444 "Pre-seed the random number generator with STATE"
447 oVerbose = Option "v" ["verbose"]
448 (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
449 "increase the verbosity level"
453 -- | Helper for parsing a yes\/no command line flag.
454 parseYesNo :: Bool -- ^ Default value (when we get a @Nothing@)
455 -> Maybe String -- ^ Parameter value
456 -> Result Bool -- ^ Resulting boolean value
457 parseYesNo v Nothing = return v
458 parseYesNo _ (Just "yes") = return True
459 parseYesNo _ (Just "no") = return False
460 parseYesNo _ (Just s) = fail ("Invalid choice '" ++ s ++
461 "', pass one of 'yes' or 'no'")
464 usageHelp :: String -> [OptType] -> String
466 usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
467 progname Version.version progname)
469 -- | Show the program version info.
470 versionInfo :: String -> String
471 versionInfo progname =
472 printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
473 progname Version.version compilerName
474 (Data.Version.showVersion compilerVersion)
477 -- | Command line parser, using the 'Options' structure.
478 parseOpts :: [String] -- ^ The command line arguments
479 -> String -- ^ The program name
480 -> [OptType] -- ^ The supported command line options
481 -> IO (Options, [String]) -- ^ The resulting options and leftover
483 parseOpts argv progname options =
484 case parseOptsInner argv progname options of
485 Left (code, msg) -> do
486 hPutStr (if code == 0 then stdout else stderr) msg
487 exitWith (if code == 0 then ExitSuccess else ExitFailure code)
491 -- | Inner parse options. The arguments are similar to 'parseOpts',
492 -- but it returns either a 'Left' composed of exit code and message,
493 -- or a 'Right' for the success case.
494 parseOptsInner :: [String] -> String -> [OptType]
495 -> Either (Int, String) (Options, [String])
496 parseOptsInner argv progname options =
497 case getOpt Permute options argv of
499 let (pr, args) = (foldM (flip id) defaultOptions o, n)
501 Bad msg -> Left (1, "Error while parsing command\
502 \line arguments:\n" ++ msg ++ "\n")
504 select (Right (po, args))
505 [ (optShowHelp po, Left (0, usageHelp progname options))
506 , (optShowVer po, Left (0, versionInfo progname))
509 Left (2, "Command line error: " ++ concat errs ++ "\n" ++
510 usageHelp progname options)
512 -- | A shell script template for autogenerated scripts.
515 printf "#!/bin/sh\n\n\
516 \# Auto-generated script for executing cluster rebalancing\n\n\
517 \# To stop, touch the file /tmp/stop-htools\n\n\
520 \ if [ -f /tmp/stop-htools ]; then\n\
521 \ echo 'Stop requested, exiting'\n\
526 -- | Optionally print the node list.
527 maybePrintNodes :: Maybe [String] -- ^ The field list
528 -> String -- ^ Informational message
529 -> ([String] -> String) -- ^ Function to generate the listing
531 maybePrintNodes Nothing _ _ = return ()
532 maybePrintNodes (Just fields) msg fn = do
534 hPutStrLn stderr (msg ++ " status:")
535 hPutStrLn stderr $ fn fields
538 -- | Optionally print the instance list.
539 maybePrintInsts :: Bool -- ^ Whether to print the instance list
540 -> String -- ^ Type of the instance map (e.g. initial)
541 -> String -- ^ The instance data
543 maybePrintInsts do_print msg instdata =
546 hPutStrLn stderr $ msg ++ " instance map:"
547 hPutStr stderr instdata
549 -- | Function to display warning messages from parsing the cluster
551 maybeShowWarnings :: [String] -- ^ The warning messages
553 maybeShowWarnings fix_msgs =
554 unless (null fix_msgs) $ do
555 hPutStrLn stderr "Warning: cluster has inconsistent data:"
556 hPutStrLn stderr . unlines . map (printf " - %s") $ fix_msgs
558 -- | Potentially set the node as offline based on passed offline list.
559 setNodeOffline :: [Ndx] -> Node.Node -> Node.Node
560 setNodeOffline offline_indices n =
561 if Node.idx n `elem` offline_indices
562 then Node.setOffline n True
565 -- | Set node properties based on command line options.
566 setNodeStatus :: Options -> Node.List -> IO Node.List
567 setNodeStatus opts fixed_nl = do
568 let offline_passed = optOffline opts
569 all_nodes = Container.elems fixed_nl
570 offline_lkp = map (lookupName (map Node.name all_nodes)) offline_passed
571 offline_wrong = filter (not . goodLookupResult) offline_lkp
572 offline_names = map lrContent offline_lkp
573 offline_indices = map Node.idx $
574 filter (\n -> Node.name n `elem` offline_names)
579 unless (null offline_wrong) $ do
580 exitErr $ printf "wrong node name(s) set as offline: %s\n"
581 (commaJoin (map lrContent offline_wrong))
582 let setMCpuFn = case m_cpu of
584 Just new_mcpu -> flip Node.setMcpu new_mcpu
585 let nm = Container.map (setNodeOffline offline_indices .
586 flip Node.setMdsk m_dsk .