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 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
79 import Data.Maybe (fromMaybe)
80 import qualified Data.Version
81 import System.Console.GetOpt
85 import Text.Printf (printf, hPrintf)
87 import qualified Ganeti.HTools.Version as Version(version)
88 import qualified Ganeti.HTools.Container as Container
89 import qualified Ganeti.HTools.Node as Node
90 import qualified Ganeti.Constants as C
91 import Ganeti.HTools.Types
92 import Ganeti.HTools.Utils
93 import Ganeti.HTools.Loader
97 -- | The default value for the luxi socket.
99 -- This is re-exported from the "Ganeti.Constants" module.
100 defaultLuxiSocket :: FilePath
101 defaultLuxiSocket = C.masterSocket
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 :: DiskTemplate -- ^ The requested disk template
111 , optDynuFile :: Maybe FilePath -- ^ Optional file with dynamic use data
112 , optEvacMode :: Bool -- ^ Enable evacuation mode
113 , optExInst :: [String] -- ^ Instances to be excluded
114 , optExTags :: Maybe [String] -- ^ Tags to use for exclusion
115 , optExecJobs :: Bool -- ^ Execute the commands via Luxi
116 , optGroup :: Maybe GroupID -- ^ The UUID of the group to process
117 , optSelInst :: [String] -- ^ Instances to be excluded
118 , optLuxi :: Maybe FilePath -- ^ Collect data from Luxi
119 , optMachineReadable :: Bool -- ^ Output machine-readable format
120 , optMaster :: String -- ^ Collect data from RAPI
121 , optMaxLength :: Int -- ^ Stop after this many steps
122 , optMcpu :: Double -- ^ Max cpu ratio for nodes
123 , optMdsk :: Double -- ^ Max disk usage ratio for nodes
124 , optMinGain :: Score -- ^ Min gain we aim for in a step
125 , optMinGainLim :: Score -- ^ Limit below which we apply mingain
126 , optMinScore :: Score -- ^ The minimum score we aim for
127 , optNoHeaders :: Bool -- ^ Do not show a header line
128 , optNodeSim :: [String] -- ^ Cluster simulation mode
129 , optOffline :: [String] -- ^ Names of offline nodes
130 , optOutPath :: FilePath -- ^ Path to the output directory
131 , optSaveCluster :: Maybe FilePath -- ^ Save cluster state to this file
132 , optShowCmds :: Maybe FilePath -- ^ Whether to show the command list
133 , optShowHelp :: Bool -- ^ Just show the help
134 , optShowInsts :: Bool -- ^ Whether to show the instance map
135 , optShowNodes :: Maybe [String] -- ^ Whether to show node status
136 , optShowVer :: Bool -- ^ Just show the program version
137 , optStdSpec :: Maybe RSpec -- ^ Requested standard specs
138 , optTieredSpec :: Maybe RSpec -- ^ Requested specs for tiered mode
139 , optReplay :: Maybe String -- ^ Unittests: RNG state
140 , optVerbose :: Int -- ^ Verbosity level
143 -- | Default values for the command line options.
144 defaultOptions :: Options
145 defaultOptions = Options
146 { optDataFile = Nothing
147 , optDiskMoves = True
148 , optInstMoves = True
149 , optDiskTemplate = DTDrbd8
150 , optDynuFile = Nothing
151 , optEvacMode = False
153 , optExTags = Nothing
154 , optExecJobs = False
158 , optMachineReadable = False
161 , optMcpu = defVcpuRatio
162 , optMdsk = defReservedDiskRatio
164 , optMinGainLim = 1e-1
166 , optNoHeaders = False
170 , optSaveCluster = Nothing
171 , optShowCmds = Nothing
172 , optShowHelp = False
173 , optShowInsts = False
174 , optShowNodes = Nothing
176 , optStdSpec = Nothing
177 , optTieredSpec = Nothing
178 , optReplay = Nothing
182 -- | Abrreviation for the option type.
183 type OptType = OptDescr (Options -> Result Options)
185 -- * Helper functions
187 parseISpecString :: String -> String -> Result RSpec
188 parseISpecString descr inp = do
189 let sp = sepSplit ',' inp
190 prs <- mapM (\(fn, val) -> fn val) $
191 zip [ annotateResult (descr ++ " specs memory") . parseUnit
192 , annotateResult (descr ++ " specs disk") . parseUnit
193 , tryRead (descr ++ " specs cpus")
196 [dsk, ram, cpu] -> return $ RSpec cpu ram dsk
197 _ -> Bad $ "Invalid " ++ descr ++ " specification: '" ++ inp ++
198 "', expected disk,ram,cpu"
200 -- * Command line options
203 oDataFile = Option "t" ["text-data"]
204 (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
205 "the cluster data FILE"
207 oDiskMoves :: OptType
208 oDiskMoves = Option "" ["no-disk-moves"]
209 (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
210 "disallow disk moves from the list of allowed instance changes,\
211 \ thus allowing only the 'cheap' failover/migrate operations"
213 oDiskTemplate :: OptType
214 oDiskTemplate = Option "" ["disk-template"]
215 (ReqArg (\ t opts -> do
216 dt <- diskTemplateFromRaw t
217 return $ opts { optDiskTemplate = dt }) "TEMPLATE")
218 "select the desired disk template"
221 oSelInst = Option "" ["select-instances"]
222 (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
223 "only select given instances for any moves"
225 oInstMoves :: OptType
226 oInstMoves = Option "" ["no-instance-moves"]
227 (NoArg (\ opts -> Ok opts { optInstMoves = False}))
228 "disallow instance (primary node) moves from the list of allowed,\
229 \ instance changes, thus allowing only slower, but sometimes\
230 \ safer, drbd secondary changes"
233 oDynuFile = Option "U" ["dynu-file"]
234 (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
235 "Import dynamic utilisation data from the given FILE"
238 oEvacMode = Option "E" ["evac-mode"]
239 (NoArg (\opts -> Ok opts { optEvacMode = True }))
240 "enable evacuation mode, where the algorithm only moves \
241 \ instances away from offline and drained nodes"
244 oExInst = Option "" ["exclude-instances"]
245 (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
246 "exclude given instances from any moves"
249 oExTags = Option "" ["exclusion-tags"]
250 (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
251 "TAG,...") "Enable instance exclusion based on given tag prefix"
254 oExecJobs = Option "X" ["exec"]
255 (NoArg (\ opts -> Ok opts { optExecJobs = True}))
256 "execute the suggested moves via Luxi (only available when using\
257 \ it for data gathering)"
260 oGroup = Option "G" ["group"]
261 (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
262 "the ID of the group to balance"
264 oLuxiSocket :: OptType
265 oLuxiSocket = Option "L" ["luxi"]
266 (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
267 fromMaybe defaultLuxiSocket) "SOCKET")
268 "collect data via Luxi, optionally using the given SOCKET path"
270 oMachineReadable :: OptType
271 oMachineReadable = Option "" ["machine-readable"]
272 (OptArg (\ f opts -> do
273 flag <- parseYesNo True f
274 return $ opts { optMachineReadable = flag }) "CHOICE")
275 "enable machine readable output (pass either 'yes' or 'no' to\
276 \ explicitely control the flag, or without an argument defaults to\
280 oMaxCpu = Option "" ["max-cpu"]
281 (ReqArg (\ n opts -> Ok opts { optMcpu = read n }) "RATIO")
282 "maximum virtual-to-physical cpu ratio for nodes (from 1\
285 oMaxSolLength :: OptType
286 oMaxSolLength = Option "l" ["max-length"]
287 (ReqArg (\ i opts -> Ok opts { optMaxLength = read i }) "N")
288 "cap the solution at this many balancing or allocation \
289 \ rounds (useful for very unbalanced clusters or empty \
293 oMinDisk = Option "" ["min-disk"]
294 (ReqArg (\ n opts -> Ok opts { optMdsk = read n }) "RATIO")
295 "minimum free disk space for nodes (between 0 and 1) [0]"
298 oMinGain = Option "g" ["min-gain"]
299 (ReqArg (\ g opts -> Ok opts { optMinGain = read g }) "DELTA")
300 "minimum gain to aim for in a balancing step before giving up"
302 oMinGainLim :: OptType
303 oMinGainLim = Option "" ["min-gain-limit"]
304 (ReqArg (\ g opts -> Ok opts { optMinGainLim = read g }) "SCORE")
305 "minimum cluster score for which we start checking the min-gain"
308 oMinScore = Option "e" ["min-score"]
309 (ReqArg (\ e opts -> Ok opts { optMinScore = read e }) "EPSILON")
310 "mininum score to aim for"
312 oNoHeaders :: OptType
313 oNoHeaders = Option "" ["no-headers"]
314 (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
315 "do not show a header line"
318 oNodeSim = Option "" ["simulate"]
319 (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
320 "simulate an empty cluster, given as 'num_nodes,disk,ram,cpu'"
322 oOfflineNode :: OptType
323 oOfflineNode = Option "O" ["offline"]
324 (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
325 "set node as offline"
327 oOutputDir :: OptType
328 oOutputDir = Option "d" ["output-dir"]
329 (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
330 "directory in which to write output files"
332 oPrintCommands :: OptType
333 oPrintCommands = Option "C" ["print-commands"]
334 (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
337 "print the ganeti command list for reaching the solution,\
338 \ if an argument is passed then write the commands to a\
339 \ file named as such"
341 oPrintInsts :: OptType
342 oPrintInsts = Option "" ["print-instances"]
343 (NoArg (\ opts -> Ok opts { optShowInsts = True }))
344 "print the final instance map"
346 oPrintNodes :: OptType
347 oPrintNodes = Option "p" ["print-nodes"]
348 (OptArg ((\ f opts ->
349 let (prefix, realf) = case f of
350 '+':rest -> (["+"], rest)
352 splitted = prefix ++ sepSplit ',' realf
353 in Ok opts { optShowNodes = Just splitted }) .
354 fromMaybe []) "FIELDS")
355 "print the final node list"
358 oQuiet = Option "q" ["quiet"]
359 (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
360 "decrease the verbosity level"
362 oRapiMaster :: OptType
363 oRapiMaster = Option "m" ["master"]
364 (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
365 "collect data via RAPI at the given ADDRESS"
367 oSaveCluster :: OptType
368 oSaveCluster = Option "S" ["save"]
369 (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
370 "Save cluster state at the end of the processing to FILE"
373 oShowHelp = Option "h" ["help"]
374 (NoArg (\ opts -> Ok opts { optShowHelp = True}))
378 oShowVer = Option "V" ["version"]
379 (NoArg (\ opts -> Ok opts { optShowVer = True}))
380 "show the version of the program"
383 oStdSpec = Option "" ["standard-alloc"]
384 (ReqArg (\ inp opts -> do
385 tspec <- parseISpecString "standard" inp
386 return $ opts { optStdSpec = Just tspec } )
388 "enable standard specs allocation, given as 'disk,ram,cpu'"
390 oTieredSpec :: OptType
391 oTieredSpec = Option "" ["tiered-alloc"]
392 (ReqArg (\ inp opts -> do
393 tspec <- parseISpecString "tiered" inp
394 return $ opts { optTieredSpec = Just tspec } )
396 "enable tiered specs allocation, given as 'disk,ram,cpu'"
399 oReplay = Option "" ["replay"]
400 (ReqArg (\ stat opts -> Ok opts { optReplay = Just stat } ) "STATE")
401 "Pre-seed the random number generator with STATE"
404 oVerbose = Option "v" ["verbose"]
405 (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
406 "increase the verbosity level"
410 -- | Helper for parsing a yes\/no command line flag.
411 parseYesNo :: Bool -- ^ Default whalue (when we get a @Nothing@)
412 -> Maybe String -- ^ Parameter value
413 -> Result Bool -- ^ Resulting boolean value
414 parseYesNo v Nothing = return v
415 parseYesNo _ (Just "yes") = return True
416 parseYesNo _ (Just "no") = return False
417 parseYesNo _ (Just s) = fail $ "Invalid choice '" ++ s ++
418 "', pass one of 'yes' or 'no'"
421 usageHelp :: String -> [OptType] -> String
423 usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
424 progname Version.version progname)
426 -- | Command line parser, using the 'Options' structure.
427 parseOpts :: [String] -- ^ The command line arguments
428 -> String -- ^ The program name
429 -> [OptType] -- ^ The supported command line options
430 -> IO (Options, [String]) -- ^ The resulting options and leftover
432 parseOpts argv progname options =
433 case getOpt Permute options argv of
436 let (pr, args) = (foldM (flip id) defaultOptions o, n)
439 hPutStrLn stderr "Error while parsing command\
442 exitWith $ ExitFailure 1
444 when (optShowHelp po) $ do
445 putStr $ usageHelp progname options
447 when (optShowVer po) $ do
448 printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
449 progname Version.version
450 compilerName (Data.Version.showVersion compilerVersion)
455 hPutStrLn stderr $ "Command line error: " ++ concat errs
456 hPutStrLn stderr $ usageHelp progname options
457 exitWith $ ExitFailure 2
459 -- | A shell script template for autogenerated scripts.
462 printf "#!/bin/sh\n\n\
463 \# Auto-generated script for executing cluster rebalancing\n\n\
464 \# To stop, touch the file /tmp/stop-htools\n\n\
467 \ if [ -f /tmp/stop-htools ]; then\n\
468 \ echo 'Stop requested, exiting'\n\
473 -- | Optionally print the node list.
474 maybePrintNodes :: Maybe [String] -- ^ The field list
475 -> String -- ^ Informational message
476 -> ([String] -> String) -- ^ Function to generate the listing
478 maybePrintNodes Nothing _ _ = return ()
479 maybePrintNodes (Just fields) msg fn = do
481 hPutStrLn stderr (msg ++ " status:")
482 hPutStrLn stderr $ fn fields
485 -- | Optionally print the instance list.
486 maybePrintInsts :: Bool -- ^ Whether to print the instance list
487 -> String -- ^ Type of the instance map (e.g. initial)
488 -> String -- ^ The instance data
490 maybePrintInsts do_print msg instdata =
493 hPutStrLn stderr $ msg ++ " instance map:"
494 hPutStr stderr instdata
496 -- | Function to display warning messages from parsing the cluster
498 maybeShowWarnings :: [String] -- ^ The warning messages
500 maybeShowWarnings fix_msgs =
501 unless (null fix_msgs) $ do
502 hPutStrLn stderr "Warning: cluster has inconsistent data:"
503 hPutStrLn stderr . unlines . map (printf " - %s") $ fix_msgs
505 -- | Set node properties based on command line options.
506 setNodeStatus :: Options -> Node.List -> IO Node.List
507 setNodeStatus opts fixed_nl = do
508 let offline_passed = optOffline opts
509 all_nodes = Container.elems fixed_nl
510 offline_lkp = map (lookupName (map Node.name all_nodes)) offline_passed
511 offline_wrong = filter (not . goodLookupResult) offline_lkp
512 offline_names = map lrContent offline_lkp
513 offline_indices = map Node.idx $
514 filter (\n -> Node.name n `elem` offline_names)
519 unless (null offline_wrong) $ do
520 hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
521 (commaJoin (map lrContent offline_wrong)) :: IO ()
522 exitWith $ ExitFailure 1
524 let nm = Container.map (\n -> if Node.idx n `elem` offline_indices
525 then Node.setOffline n True
527 nlf = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)