Merge branch 'stable-2.16' into stable-2.17
[ganeti-github.git] / src / Ganeti / HTools / CLI.hs
1 {-| Implementation of command-line functions.
2
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.
6
7 -}
8
9 {-
10
11 Copyright (C) 2009, 2010, 2011, 2012, 2013, 2015 Google Inc.
12 All rights reserved.
13
14 Redistribution and use in source and binary forms, with or without
15 modification, are permitted provided that the following conditions are
16 met:
17
18 1. Redistributions of source code must retain the above copyright notice,
19 this list of conditions and the following disclaimer.
20
21 2. Redistributions in binary form must reproduce the above copyright
22 notice, this list of conditions and the following disclaimer in the
23 documentation and/or other materials provided with the distribution.
24
25 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
26 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
27 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
28 PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
29 CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
30 EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
31 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
32 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
33 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
34 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
35 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
36
37 -}
38
39 module Ganeti.HTools.CLI
40 ( Options(..)
41 , OptType
42 , defaultOptions
43 , Ganeti.HTools.CLI.parseOpts
44 , parseOptsInner
45 , parseYesNo
46 , parseISpecString
47 , shTemplate
48 , maybeSaveCommands
49 , maybePrintNodes
50 , maybePrintInsts
51 , maybeShowWarnings
52 , printKeys
53 , printFinal
54 , setNodeStatus
55 -- * The options
56 , oDataFile
57 , oDiskMoves
58 , oAvoidDiskMoves
59 , oDiskTemplate
60 , oSpindleUse
61 , oDynuFile
62 , oMemWeight
63 , oMonD
64 , oMonDDataFile
65 , oMonDKvmRSS
66 , oMonDXen
67 , oEvacMode
68 , oMonDExitMissing
69 , oFirstJobGroup
70 , oRestrictedMigrate
71 , oExInst
72 , oExTags
73 , oExecJobs
74 , oForce
75 , oFullEvacuation
76 , oGroup
77 , oIdleDefault
78 , oIAllocSrc
79 , oIgnoreDyn
80 , oIgnoreNonRedundant
81 , oIgnoreSoftErrors
82 , oIndependentGroups
83 , oAcceptExisting
84 , oInstMoves
85 , oJobDelay
86 , genOLuxiSocket
87 , oLuxiSocket
88 , oMachineReadable
89 , oMaxCpu
90 , oMaxSolLength
91 , oMinDisk
92 , oMinGain
93 , oMinGainLim
94 , oMinResources
95 , oMinScore
96 , oNoHeaders
97 , oNoSimulation
98 , oNodeSim
99 , oNodeTags
100 , oOfflineMaintenance
101 , oOfflineNode
102 , oOneStepOnly
103 , oOutputDir
104 , oPrintCommands
105 , oPrintInsts
106 , oPrintMoves
107 , oPrintNodes
108 , oQuiet
109 , oRapiMaster
110 , oReason
111 , oRestrictToNodes
112 , oSaveCluster
113 , oSelInst
114 , oShowHelp
115 , oShowVer
116 , oShowComp
117 , oSkipNonRedundant
118 , oStdSpec
119 , oTargetResources
120 , oTieredSpec
121 , oVerbose
122 , oPriority
123 , oNoCapacityChecks
124 , genericOpts
125 ) where
126
127 import Control.Monad
128 import Data.Char (toUpper)
129 import Data.Maybe (fromMaybe)
130 import System.Console.GetOpt
131 import System.IO
132 import Text.Printf (printf)
133
134 import qualified Ganeti.HTools.Container as Container
135 import qualified Ganeti.HTools.Node as Node
136 import qualified Ganeti.Path as Path
137 import Ganeti.HTools.Types
138 import Ganeti.BasicTypes
139 import Ganeti.Common as Common
140 import Ganeti.Types
141 import Ganeti.Utils
142
143 -- * Data types
144
145 -- | Command line options structure.
146 data Options = Options
147 { optDataFile :: Maybe FilePath -- ^ Path to the cluster data file
148 , optDiskMoves :: Bool -- ^ Allow disk moves
149 , optAvoidDiskMoves :: Double -- ^ Allow only disk moves improving
150 -- cluster score in more than
151 -- optAvoidDiskMoves times
152 , optInstMoves :: Bool -- ^ Allow instance moves
153 , optDiskTemplate :: Maybe DiskTemplate -- ^ Override for the disk template
154 , optSpindleUse :: Maybe Int -- ^ Override for the spindle usage
155 , optDynuFile :: Maybe FilePath -- ^ Optional file with dynamic use data
156 , optIgnoreDynu :: Bool -- ^ Do not use dynamic use data
157 , optIdleDefault :: Bool -- ^ Assume idle load for all not provided
158 -- dynamic utilisation data
159 , optIgnoreSoftErrors :: Bool -- ^ Ignore soft errors in balancing moves
160 , optIndependentGroups :: Bool -- ^ consider groups independently
161 , optAcceptExisting :: Bool -- ^ accept existing N+1 violations
162 , optMonD :: Bool -- ^ Query MonDs
163 , optMonDFile :: Maybe FilePath -- ^ Optional file with data provided
164 -- by MonDs
165 , optMonDXen :: Bool -- ^ Should Xen-specific collectors be
166 -- considered (only if MonD is queried)
167 , optMonDKvmRSS :: Bool -- ^ Should kvm RSS information be
168 -- considered (only if MonD is queried)
169 , optMonDExitMissing :: Bool -- ^ If the program should exit on missing
170 -- MonD data
171 , optMemWeight :: Double -- ^ Rescale the weight of memory
172 -- utilisation
173 , optEvacMode :: Bool -- ^ Enable evacuation mode
174 , optRestrictedMigrate :: Bool -- ^ Disallow replace-primary moves
175 , optExInst :: [String] -- ^ Instances to be excluded
176 , optExTags :: Maybe [String] -- ^ Tags to use for exclusion
177 , optExecJobs :: Bool -- ^ Execute the commands via Luxi
178 , optFirstJobGroup :: Bool -- ^ Only execute the first group of jobs
179 , optForce :: Bool -- ^ Force the execution
180 , optFullEvacuation :: Bool -- ^ Fully evacuate nodes to be rebooted
181 , optGroup :: Maybe GroupID -- ^ The UUID of the group to process
182 , optIAllocSrc :: Maybe FilePath -- ^ The iallocation spec
183 , optIgnoreNonRedundant :: Bool -- ^ Ignore non-redundant instances
184 , optSelInst :: [String] -- ^ Instances to be excluded
185 , optLuxi :: Maybe FilePath -- ^ Collect data from Luxi
186 , optJobDelay :: Double -- ^ Delay before executing first job
187 , optMachineReadable :: Bool -- ^ Output machine-readable format
188 , optMaster :: String -- ^ Collect data from RAPI
189 , optMaxLength :: Int -- ^ Stop after this many steps
190 , optMcpu :: Maybe Double -- ^ Override max cpu ratio for nodes
191 , optMdsk :: Double -- ^ Max disk usage ratio for nodes
192 , optMinGain :: Score -- ^ Min gain we aim for in a step
193 , optMinGainLim :: Score -- ^ Limit below which we apply mingain
194 , optMinResources :: Double -- ^ Minimal resources for hsqueeze
195 , optMinScore :: Score -- ^ The minimum score we aim for
196 , optNoHeaders :: Bool -- ^ Do not show a header line
197 , optNoSimulation :: Bool -- ^ Skip the rebalancing dry-run
198 , optNodeSim :: [String] -- ^ Cluster simulation mode
199 , optNodeTags :: Maybe [String] -- ^ List of node tags to restrict to
200 , optOffline :: [String] -- ^ Names of offline nodes
201 , optRestrictToNodes :: Maybe [String] -- ^ if not Nothing, restrict
202 -- allocation to those nodes
203 , optOfflineMaintenance :: Bool -- ^ Pretend all instances are offline
204 , optOneStepOnly :: Bool -- ^ Only do the first step
205 , optOutPath :: FilePath -- ^ Path to the output directory
206 , optPrintMoves :: Bool -- ^ Whether to show the instance moves
207 , optReason :: Maybe String -- ^ The reason to be passed when
208 -- submitting jobs
209 , optSaveCluster :: Maybe FilePath -- ^ Save cluster state to this file
210 , optShowCmds :: Maybe FilePath -- ^ Whether to show the command list
211 , optShowHelp :: Bool -- ^ Just show the help
212 , optShowComp :: Bool -- ^ Just show the completion info
213 , optShowInsts :: Bool -- ^ Whether to show the instance map
214 , optShowNodes :: Maybe [String] -- ^ Whether to show node status
215 , optShowVer :: Bool -- ^ Just show the program version
216 , optSkipNonRedundant :: Bool -- ^ Skip nodes with non-redundant instance
217 , optStdSpec :: Maybe RSpec -- ^ Requested standard specs
218 , optTargetResources :: Double -- ^ Target resources for squeezing
219 , optTestCount :: Maybe Int -- ^ Optional test count override
220 , optTieredSpec :: Maybe RSpec -- ^ Requested specs for tiered mode
221 , optReplay :: Maybe String -- ^ Unittests: RNG state
222 , optVerbose :: Int -- ^ Verbosity level
223 , optPriority :: Maybe OpSubmitPriority -- ^ OpCode submit priority
224 , optCapacity :: Bool -- ^ Also do capacity-related checks
225 } deriving Show
226
227 -- | Default values for the command line options.
228 defaultOptions :: Options
229 defaultOptions = Options
230 { optDataFile = Nothing
231 , optDiskMoves = True
232 , optAvoidDiskMoves = 1.0
233 , optInstMoves = True
234 , optIndependentGroups = False
235 , optAcceptExisting = False
236 , optDiskTemplate = Nothing
237 , optSpindleUse = Nothing
238 , optIgnoreDynu = False
239 , optIdleDefault = False
240 , optIgnoreSoftErrors = False
241 , optDynuFile = Nothing
242 , optMonD = False
243 , optMonDFile = Nothing
244 , optMonDXen = False
245 , optMonDKvmRSS = False
246 , optMonDExitMissing = False
247 , optMemWeight = 1.0
248 , optEvacMode = False
249 , optRestrictedMigrate = False
250 , optExInst = []
251 , optExTags = Nothing
252 , optExecJobs = False
253 , optFirstJobGroup = False
254 , optForce = False
255 , optFullEvacuation = False
256 , optGroup = Nothing
257 , optIAllocSrc = Nothing
258 , optIgnoreNonRedundant = False
259 , optSelInst = []
260 , optLuxi = Nothing
261 , optJobDelay = 10
262 , optMachineReadable = False
263 , optMaster = ""
264 , optMaxLength = -1
265 , optMcpu = Nothing
266 , optMdsk = defReservedDiskRatio
267 , optMinGain = 1e-2
268 , optMinGainLim = 1e-1
269 , optMinResources = 2.0
270 , optMinScore = 1e-9
271 , optNoHeaders = False
272 , optNoSimulation = False
273 , optNodeSim = []
274 , optNodeTags = Nothing
275 , optSkipNonRedundant = False
276 , optOffline = []
277 , optRestrictToNodes = Nothing
278 , optOfflineMaintenance = False
279 , optOneStepOnly = False
280 , optOutPath = "."
281 , optPrintMoves = False
282 , optReason = Nothing
283 , optSaveCluster = Nothing
284 , optShowCmds = Nothing
285 , optShowHelp = False
286 , optShowComp = False
287 , optShowInsts = False
288 , optShowNodes = Nothing
289 , optShowVer = False
290 , optStdSpec = Nothing
291 , optTargetResources = 2.0
292 , optTestCount = Nothing
293 , optTieredSpec = Nothing
294 , optReplay = Nothing
295 , optVerbose = 1
296 , optPriority = Nothing
297 , optCapacity = True
298 }
299
300 -- | Abbreviation for the option type.
301 type OptType = GenericOptType Options
302
303 instance StandardOptions Options where
304 helpRequested = optShowHelp
305 verRequested = optShowVer
306 compRequested = optShowComp
307 requestHelp o = o { optShowHelp = True }
308 requestVer o = o { optShowVer = True }
309 requestComp o = o { optShowComp = True }
310
311 -- * Helper functions
312
313 parseISpecString :: String -> String -> Result RSpec
314 parseISpecString descr inp = do
315 let sp = sepSplit ',' inp
316 err = Bad ("Invalid " ++ descr ++ " specification: '" ++ inp ++
317 "', expected disk,ram,cpu")
318 when (length sp < 3 || length sp > 4) err
319 prs <- mapM (\(fn, val) -> fn val) $
320 zip [ annotateResult (descr ++ " specs disk") . parseUnit
321 , annotateResult (descr ++ " specs memory") . parseUnit
322 , tryRead (descr ++ " specs cpus")
323 , tryRead (descr ++ " specs spindles")
324 ] sp
325 case prs of
326 {- Spindles are optional, so that they are not needed when exclusive storage
327 is disabled. When exclusive storage is disabled, spindles are ignored,
328 so the actual value doesn't matter. We use 1 as a default so that in
329 case someone forgets and exclusive storage is enabled, we don't run into
330 weird situations. -}
331 [dsk, ram, cpu] -> return $ RSpec cpu ram dsk 1
332 [dsk, ram, cpu, spn] -> return $ RSpec cpu ram dsk spn
333 _ -> err
334
335 -- | Disk template choices.
336 optComplDiskTemplate :: OptCompletion
337 optComplDiskTemplate = OptComplChoices $
338 map diskTemplateToRaw [minBound..maxBound]
339
340 -- * Command line options
341
342 oDataFile :: OptType
343 oDataFile =
344 (Option "t" ["text-data"]
345 (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
346 "the cluster data FILE",
347 OptComplFile)
348
349 oDiskMoves :: OptType
350 oDiskMoves =
351 (Option "" ["no-disk-moves"]
352 (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
353 "disallow disk moves from the list of allowed instance changes,\
354 \ thus allowing only the 'cheap' failover/migrate operations",
355 OptComplNone)
356
357 oAvoidDiskMoves :: OptType
358 oAvoidDiskMoves =
359 (Option "" ["avoid-disk-moves"]
360 (reqWithConversion (tryRead "disk moves avoiding factor")
361 (\f opts -> Ok opts { optAvoidDiskMoves = f }) "FACTOR")
362 "gain in cluster metrics on each balancing step including disk moves\
363 \ should be FACTOR times higher than the gain after migrations in order to\
364 \ admit disk move during the step",
365 OptComplFloat)
366
367 oMonD :: OptType
368 oMonD =
369 (Option "" ["mond"]
370 (OptArg (\ f opts -> do
371 flag <- parseYesNo True f
372 return $ opts { optMonD = flag }) "CHOICE")
373 "pass either 'yes' or 'no' to query all monDs",
374 optComplYesNo)
375
376 oMonDDataFile :: OptType
377 oMonDDataFile =
378 (Option "" ["mond-data"]
379 (ReqArg (\ f opts -> Ok opts { optMonDFile = Just f }) "FILE")
380 "Import data provided by MonDs from the given FILE",
381 OptComplFile)
382
383 oMonDXen :: OptType
384 oMonDXen =
385 (Option "" ["mond-xen"]
386 (NoArg (\ opts -> Ok opts { optMonDXen = True }))
387 "also consider xen-specific collectors in MonD queries",
388 OptComplNone)
389
390 oMonDKvmRSS :: OptType
391 oMonDKvmRSS =
392 (Option "" ["mond-kvm-rss"]
393 (NoArg (\ opts -> Ok opts { optMonDKvmRSS = True }))
394 "also consider residual-set-size data for kvm instances via MonD",
395 OptComplNone)
396
397 oMemWeight :: OptType
398 oMemWeight =
399 (Option "" ["mem-weight"]
400 (reqWithConversion (tryRead "memory weight factor")
401 (\ f opts -> Ok opts { optMemWeight = f }) "FACTOR")
402 "Rescale the weight of the memory utilization by the given factor",
403 OptComplFloat)
404
405 oMonDExitMissing :: OptType
406 oMonDExitMissing =
407 (Option "" ["exit-on-missing-mond-data"]
408 (NoArg (\ opts -> Ok opts { optMonDExitMissing = True }))
409 "abort if the data available from the monitoring daemons is incomplete",
410 OptComplNone)
411
412 oDiskTemplate :: OptType
413 oDiskTemplate =
414 (Option "" ["disk-template"]
415 (reqWithConversion diskTemplateFromRaw
416 (\dt opts -> Ok opts { optDiskTemplate = Just dt })
417 "TEMPLATE") "select the desired disk template",
418 optComplDiskTemplate)
419
420 oSpindleUse :: OptType
421 oSpindleUse =
422 (Option "" ["spindle-use"]
423 (reqWithConversion (tryRead "parsing spindle-use")
424 (\su opts -> do
425 when (su < 0) $
426 fail "Invalid value of the spindle-use (expected >= 0)"
427 return $ opts { optSpindleUse = Just su })
428 "SPINDLES") "select how many virtual spindle instances use\
429 \ [default read from cluster]",
430 OptComplFloat)
431
432 oSelInst :: OptType
433 oSelInst =
434 (Option "" ["select-instances"]
435 (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
436 "only select given instances for any moves",
437 OptComplManyInstances)
438
439 oInstMoves :: OptType
440 oInstMoves =
441 (Option "" ["no-instance-moves"]
442 (NoArg (\ opts -> Ok opts { optInstMoves = False}))
443 "disallow instance (primary node) moves from the list of allowed,\
444 \ instance changes, thus allowing only slower, but sometimes\
445 \ safer, drbd secondary changes",
446 OptComplNone)
447
448 oDynuFile :: OptType
449 oDynuFile =
450 (Option "U" ["dynu-file"]
451 (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
452 "Import dynamic utilisation data from the given FILE",
453 OptComplFile)
454
455 oIgnoreDyn :: OptType
456 oIgnoreDyn =
457 (Option "" ["ignore-dynu"]
458 (NoArg (\ opts -> Ok opts {optIgnoreDynu = True}))
459 "Ignore any dynamic utilisation information",
460 OptComplNone)
461
462 oIdleDefault :: OptType
463 oIdleDefault =
464 (Option "" ["idle-default"]
465 (NoArg (\ opts -> Ok opts {optIdleDefault = True}))
466 "Assume idleness for any non-availabe dynamic utilisation data",
467 OptComplNone)
468
469 oIgnoreSoftErrors :: OptType
470 oIgnoreSoftErrors =
471 (Option "" ["ignore-soft-errors"]
472 (NoArg (\ opts -> Ok opts {optIgnoreSoftErrors = True}))
473 "Ignore any soft restrictions in balancing",
474 OptComplNone)
475
476 oIndependentGroups :: OptType
477 oIndependentGroups =
478 (Option "" ["independent-groups"]
479 (NoArg (\ opts -> Ok opts {optIndependentGroups = True}))
480 "Consider groups independently",
481 OptComplNone)
482
483 oAcceptExisting :: OptType
484 oAcceptExisting =
485 (Option "" ["accept-existing-errors"]
486 (NoArg (\ opts -> Ok opts {optAcceptExisting = True}))
487 "Accept existing N+1 violations; just don't add new ones",
488 OptComplNone)
489
490 oEvacMode :: OptType
491 oEvacMode =
492 (Option "E" ["evac-mode"]
493 (NoArg (\opts -> Ok opts { optEvacMode = True }))
494 "enable evacuation mode, where the algorithm only moves\
495 \ instances away from offline and drained nodes",
496 OptComplNone)
497
498 oRestrictedMigrate :: OptType
499 oRestrictedMigrate =
500 (Option "" ["restricted-migration"]
501 (NoArg (\opts -> Ok opts { optRestrictedMigrate = True }))
502 "disallow replace-primary moves (aka frf-moves); in evacuation mode, this\
503 \ will ensure that the only migrations are off the drained nodes",
504 OptComplNone)
505
506 oExInst :: OptType
507 oExInst =
508 (Option "" ["exclude-instances"]
509 (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
510 "exclude given instances from any moves",
511 OptComplManyInstances)
512
513 oExTags :: OptType
514 oExTags =
515 (Option "" ["exclusion-tags"]
516 (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
517 "TAG,...") "Enable instance exclusion based on given tag prefix",
518 OptComplString)
519
520 oExecJobs :: OptType
521 oExecJobs =
522 (Option "X" ["exec"]
523 (NoArg (\ opts -> Ok opts { optExecJobs = True}))
524 "execute the suggested moves via Luxi (only available when using\
525 \ it for data gathering)",
526 OptComplNone)
527
528 oReason :: OptType
529 oReason =
530 (Option "" ["reason"]
531 (ReqArg (\ f opts -> Ok opts { optReason = Just f }) "REASON")
532 "The reason to pass to the submitted jobs",
533 OptComplNone)
534
535 oFirstJobGroup :: OptType
536 oFirstJobGroup =
537 (Option "" ["first-job-group"]
538 (NoArg (\ opts -> Ok opts {optFirstJobGroup = True}))
539 "only execute the first group of jobs",
540 OptComplNone)
541
542 oForce :: OptType
543 oForce =
544 (Option "f" ["force"]
545 (NoArg (\ opts -> Ok opts {optForce = True}))
546 "force the execution of this program, even if warnings would\
547 \ otherwise prevent it",
548 OptComplNone)
549
550 oFullEvacuation :: OptType
551 oFullEvacuation =
552 (Option "" ["full-evacuation"]
553 (NoArg (\ opts -> Ok opts { optFullEvacuation = True}))
554 "fully evacuate the nodes to be rebooted",
555 OptComplNone)
556
557 oGroup :: OptType
558 oGroup =
559 (Option "G" ["group"]
560 (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
561 "the target node group (name or UUID)",
562 OptComplOneGroup)
563
564 oIAllocSrc :: OptType
565 oIAllocSrc =
566 (Option "I" ["ialloc-src"]
567 (ReqArg (\ f opts -> Ok opts { optIAllocSrc = Just f }) "FILE")
568 "Specify an iallocator spec as the cluster data source",
569 OptComplFile)
570
571 oIgnoreNonRedundant :: OptType
572 oIgnoreNonRedundant =
573 (Option "" ["ignore-non-redundant"]
574 (NoArg (\ opts -> Ok opts { optIgnoreNonRedundant = True }))
575 "Pretend that there are no non-redundant instances in the cluster",
576 OptComplNone)
577
578 oJobDelay :: OptType
579 oJobDelay =
580 (Option "" ["job-delay"]
581 (reqWithConversion (tryRead "job delay")
582 (\d opts -> Ok opts { optJobDelay = d }) "SECONDS")
583 "insert this much delay before the execution of repair jobs\
584 \ to allow the tool to continue processing instances",
585 OptComplFloat)
586
587 genOLuxiSocket :: String -> OptType
588 genOLuxiSocket defSocket =
589 (Option "L" ["luxi"]
590 (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
591 fromMaybe defSocket) "SOCKET")
592 ("collect data via Luxi, optionally using the given SOCKET path [" ++
593 defSocket ++ "]"),
594 OptComplFile)
595
596 oLuxiSocket :: IO OptType
597 oLuxiSocket = liftM genOLuxiSocket Path.defaultQuerySocket
598
599 oMachineReadable :: OptType
600 oMachineReadable =
601 (Option "" ["machine-readable"]
602 (OptArg (\ f opts -> do
603 flag <- parseYesNo True f
604 return $ opts { optMachineReadable = flag }) "CHOICE")
605 "enable machine readable output (pass either 'yes' or 'no' to\
606 \ explicitly control the flag, or without an argument defaults to\
607 \ yes)",
608 optComplYesNo)
609
610 oMaxCpu :: OptType
611 oMaxCpu =
612 (Option "" ["max-cpu"]
613 (reqWithConversion (tryRead "parsing max-cpu")
614 (\mcpu opts -> do
615 when (mcpu <= 0) $
616 fail "Invalid value of the max-cpu ratio, expected >0"
617 return $ opts { optMcpu = Just mcpu }) "RATIO")
618 "maximum virtual-to-physical cpu ratio for nodes (from 0\
619 \ upwards) [default read from cluster]",
620 OptComplFloat)
621
622 oMaxSolLength :: OptType
623 oMaxSolLength =
624 (Option "l" ["max-length"]
625 (reqWithConversion (tryRead "max solution length")
626 (\i opts -> Ok opts { optMaxLength = i }) "N")
627 "cap the solution at this many balancing or allocation\
628 \ rounds (useful for very unbalanced clusters or empty\
629 \ clusters)",
630 OptComplInteger)
631
632 oMinDisk :: OptType
633 oMinDisk =
634 (Option "" ["min-disk"]
635 (reqWithConversion (tryRead "min free disk space")
636 (\n opts -> Ok opts { optMdsk = n }) "RATIO")
637 "minimum free disk space for nodes (between 0 and 1) [0]",
638 OptComplFloat)
639
640 oMinGain :: OptType
641 oMinGain =
642 (Option "g" ["min-gain"]
643 (reqWithConversion (tryRead "min gain")
644 (\g opts -> Ok opts { optMinGain = g }) "DELTA")
645 "minimum gain to aim for in a balancing step before giving up",
646 OptComplFloat)
647
648 oMinGainLim :: OptType
649 oMinGainLim =
650 (Option "" ["min-gain-limit"]
651 (reqWithConversion (tryRead "min gain limit")
652 (\g opts -> Ok opts { optMinGainLim = g }) "SCORE")
653 "minimum cluster score for which we start checking the min-gain",
654 OptComplFloat)
655
656 oMinResources :: OptType
657 oMinResources =
658 (Option "" ["minimal-resources"]
659 (reqWithConversion (tryRead "minimal resources")
660 (\d opts -> Ok opts { optMinResources = d}) "FACTOR")
661 "minimal resources to be present on each in multiples of\
662 \ the standard allocation for not onlining standby nodes",
663 OptComplFloat)
664
665 oMinScore :: OptType
666 oMinScore =
667 (Option "e" ["min-score"]
668 (reqWithConversion (tryRead "min score")
669 (\e opts -> Ok opts { optMinScore = e }) "EPSILON")
670 "mininum excess to the N+1 limit to aim for",
671 OptComplFloat)
672
673 oNoHeaders :: OptType
674 oNoHeaders =
675 (Option "" ["no-headers"]
676 (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
677 "do not show a header line",
678 OptComplNone)
679
680 oNoSimulation :: OptType
681 oNoSimulation =
682 (Option "" ["no-simulation"]
683 (NoArg (\opts -> Ok opts {optNoSimulation = True}))
684 "do not perform rebalancing simulation",
685 OptComplNone)
686
687 oNodeSim :: OptType
688 oNodeSim =
689 (Option "" ["simulate"]
690 (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
691 "simulate an empty cluster, given as\
692 \ 'alloc_policy,num_nodes,disk,ram,cpu'",
693 OptComplString)
694
695 oNodeTags :: OptType
696 oNodeTags =
697 (Option "" ["node-tags"]
698 (ReqArg (\ f opts -> Ok opts { optNodeTags = Just $ sepSplit ',' f })
699 "TAG,...") "Restrict to nodes with the given tags",
700 OptComplString)
701
702 oOfflineMaintenance :: OptType
703 oOfflineMaintenance =
704 (Option "" ["offline-maintenance"]
705 (NoArg (\ opts -> Ok opts {optOfflineMaintenance = True}))
706 "Schedule offline maintenance, i.e., pretend that all instance are\
707 \ offline.",
708 OptComplNone)
709
710 oOfflineNode :: OptType
711 oOfflineNode =
712 (Option "O" ["offline"]
713 (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
714 "set node as offline",
715 OptComplOneNode)
716
717 oRestrictToNodes :: OptType
718 oRestrictToNodes =
719 (Option "" ["restrict-allocation-to"]
720 (ReqArg (\ ns o -> Ok o { optRestrictToNodes = Just $ sepSplit ',' ns })
721 "NODE,...") "Restrict allocations to the given set of nodes",
722 OptComplManyNodes)
723
724 oOneStepOnly :: OptType
725 oOneStepOnly =
726 (Option "" ["one-step-only"]
727 (NoArg (\ opts -> Ok opts {optOneStepOnly = True}))
728 "Only do the first step",
729 OptComplNone)
730
731 oOutputDir :: OptType
732 oOutputDir =
733 (Option "d" ["output-dir"]
734 (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
735 "directory in which to write output files",
736 OptComplDir)
737
738 oPrintCommands :: OptType
739 oPrintCommands =
740 (Option "C" ["print-commands"]
741 (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
742 fromMaybe "-")
743 "FILE")
744 "print the ganeti command list for reaching the solution,\
745 \ if an argument is passed then write the commands to a\
746 \ file named as such",
747 OptComplNone)
748
749 oPrintInsts :: OptType
750 oPrintInsts =
751 (Option "" ["print-instances"]
752 (NoArg (\ opts -> Ok opts { optShowInsts = True }))
753 "print the final instance map",
754 OptComplNone)
755
756 oPrintMoves :: OptType
757 oPrintMoves =
758 (Option "" ["print-moves"]
759 (NoArg (\ opts -> Ok opts { optPrintMoves = True }))
760 "print the moves of the instances",
761 OptComplNone)
762
763 oPrintNodes :: OptType
764 oPrintNodes =
765 (Option "p" ["print-nodes"]
766 (OptArg ((\ f opts ->
767 let (prefix, realf) = case f of
768 '+':rest -> (["+"], rest)
769 _ -> ([], f)
770 splitted = prefix ++ sepSplit ',' realf
771 in Ok opts { optShowNodes = Just splitted }) .
772 fromMaybe []) "FIELDS")
773 "print the final node list",
774 OptComplNone)
775
776 oQuiet :: OptType
777 oQuiet =
778 (Option "q" ["quiet"]
779 (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
780 "decrease the verbosity level",
781 OptComplNone)
782
783 oRapiMaster :: OptType
784 oRapiMaster =
785 (Option "m" ["master"]
786 (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
787 "collect data via RAPI at the given ADDRESS",
788 OptComplHost)
789
790 oSaveCluster :: OptType
791 oSaveCluster =
792 (Option "S" ["save"]
793 (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
794 "Save cluster state at the end of the processing to FILE",
795 OptComplNone)
796
797 oSkipNonRedundant :: OptType
798 oSkipNonRedundant =
799 (Option "" ["skip-non-redundant"]
800 (NoArg (\ opts -> Ok opts { optSkipNonRedundant = True }))
801 "Skip nodes that host a non-redundant instance",
802 OptComplNone)
803
804 oStdSpec :: OptType
805 oStdSpec =
806 (Option "" ["standard-alloc"]
807 (ReqArg (\ inp opts -> do
808 tspec <- parseISpecString "standard" inp
809 return $ opts { optStdSpec = Just tspec } )
810 "STDSPEC")
811 "enable standard specs allocation, given as 'disk,ram,cpu'",
812 OptComplString)
813
814 oTargetResources :: OptType
815 oTargetResources =
816 (Option "" ["target-resources"]
817 (reqWithConversion (tryRead "target resources")
818 (\d opts -> Ok opts { optTargetResources = d}) "FACTOR")
819 "target resources to be left on each node after squeezing in\
820 \ multiples of the standard allocation",
821 OptComplFloat)
822
823 oTieredSpec :: OptType
824 oTieredSpec =
825 (Option "" ["tiered-alloc"]
826 (ReqArg (\ inp opts -> do
827 tspec <- parseISpecString "tiered" inp
828 return $ opts { optTieredSpec = Just tspec } )
829 "TSPEC")
830 "enable tiered specs allocation, given as 'disk,ram,cpu'",
831 OptComplString)
832
833 oVerbose :: OptType
834 oVerbose =
835 (Option "v" ["verbose"]
836 (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
837 "increase the verbosity level",
838 OptComplNone)
839
840 oPriority :: OptType
841 oPriority =
842 (Option "" ["priority"]
843 (ReqArg (\ inp opts -> do
844 prio <- parseSubmitPriority inp
845 Ok opts { optPriority = Just prio }) "PRIO")
846 "set the priority of submitted jobs",
847 OptComplChoices (map fmtSubmitPriority [minBound..maxBound]))
848
849 oNoCapacityChecks :: OptType
850 oNoCapacityChecks =
851 (Option "" ["no-capacity-checks"]
852 (NoArg (\ opts -> Ok opts { optCapacity = False}))
853 "disable capacity checks (like global N+1 redundancy)",
854 OptComplNone)
855
856 -- | Generic options.
857 genericOpts :: [GenericOptType Options]
858 genericOpts = [ oShowVer
859 , oShowHelp
860 , oShowComp
861 ]
862
863 -- * Functions
864
865 -- | Wrapper over 'Common.parseOpts' with our custom options.
866 parseOpts :: [String] -- ^ The command line arguments
867 -> String -- ^ The program name
868 -> [OptType] -- ^ The supported command line options
869 -> [ArgCompletion] -- ^ The supported command line arguments
870 -> IO (Options, [String]) -- ^ The resulting options and leftover
871 -- arguments
872 parseOpts = Common.parseOpts defaultOptions
873
874
875 -- | A shell script template for autogenerated scripts.
876 shTemplate :: String
877 shTemplate =
878 printf "#!/bin/sh\n\n\
879 \# Auto-generated script for executing cluster rebalancing\n\n\
880 \# To stop, touch the file /tmp/stop-htools\n\n\
881 \set -e\n\n\
882 \check() {\n\
883 \ if [ -f /tmp/stop-htools ]; then\n\
884 \ echo 'Stop requested, exiting'\n\
885 \ exit 0\n\
886 \ fi\n\
887 \}\n\n"
888
889 -- | Optionally show or save a list of commands
890 maybeSaveCommands :: String -- ^ Informal description
891 -> Options
892 -> String -- ^ commands
893 -> IO ()
894 maybeSaveCommands msg opts cmds =
895 case optShowCmds opts of
896 Nothing -> return ()
897 Just "-" -> do
898 putStrLn ""
899 putStrLn msg
900 putStr . unlines . map (" " ++) . filter (/= " check") . lines $ cmds
901 Just out_path -> do
902 writeFile out_path (shTemplate ++ cmds)
903 printf "The commands have been written to file '%s'\n" out_path
904
905 -- | Optionally print the node list.
906 maybePrintNodes :: Maybe [String] -- ^ The field list
907 -> String -- ^ Informational message
908 -> ([String] -> String) -- ^ Function to generate the listing
909 -> IO ()
910 maybePrintNodes Nothing _ _ = return ()
911 maybePrintNodes (Just fields) msg fn = do
912 hPutStrLn stderr ""
913 hPutStrLn stderr (msg ++ " status:")
914 hPutStrLn stderr $ fn fields
915
916 -- | Optionally print the instance list.
917 maybePrintInsts :: Bool -- ^ Whether to print the instance list
918 -> String -- ^ Type of the instance map (e.g. initial)
919 -> String -- ^ The instance data
920 -> IO ()
921 maybePrintInsts do_print msg instdata =
922 when do_print $ do
923 hPutStrLn stderr ""
924 hPutStrLn stderr $ msg ++ " instance map:"
925 hPutStr stderr instdata
926
927 -- | Function to display warning messages from parsing the cluster
928 -- state.
929 maybeShowWarnings :: [String] -- ^ The warning messages
930 -> IO ()
931 maybeShowWarnings fix_msgs =
932 unless (null fix_msgs) $ do
933 hPutStrLn stderr "Warning: cluster has inconsistent data:"
934 hPutStrLn stderr . unlines . map (printf " - %s") $ fix_msgs
935
936 -- | Format a list of key, value as a shell fragment.
937 printKeys :: String -- ^ Prefix to printed variables
938 -> [(String, String)] -- ^ List of (key, value) pairs to be printed
939 -> IO ()
940 printKeys prefix =
941 mapM_ (\(k, v) ->
942 printf "%s_%s=%s\n" prefix (map toUpper k) (ensureQuoted v))
943
944 -- | Prints the final @OK@ marker in machine readable output.
945 printFinal :: String -- ^ Prefix to printed variable
946 -> Bool -- ^ Whether output should be machine readable;
947 -- note: if not, there is nothing to print
948 -> IO ()
949 printFinal prefix True =
950 -- this should be the final entry
951 printKeys prefix [("OK", "1")]
952
953 printFinal _ False = return ()
954
955 -- | Potentially set the node as offline based on passed offline list.
956 setNodeOffline :: [Ndx] -> Node.Node -> Node.Node
957 setNodeOffline offline_indices n =
958 if Node.idx n `elem` offline_indices
959 then Node.setOffline n True
960 else n
961
962 -- | Set node properties based on command line options.
963 setNodeStatus :: Options -> Node.List -> IO Node.List
964 setNodeStatus opts fixed_nl = do
965 let offline_passed = optOffline opts
966 all_nodes = Container.elems fixed_nl
967 offline_lkp = map (lookupName (map Node.name all_nodes)) offline_passed
968 offline_wrong = filter (not . goodLookupResult) offline_lkp
969 offline_names = map lrContent offline_lkp
970 offline_indices = map Node.idx $
971 filter (\n -> Node.name n `elem` offline_names)
972 all_nodes
973 m_cpu = optMcpu opts
974 m_dsk = optMdsk opts
975
976 unless (null offline_wrong) .
977 exitErr $ printf "wrong node name(s) set as offline: %s\n"
978 (commaJoin (map lrContent offline_wrong))
979 let setMCpuFn = case m_cpu of
980 Nothing -> id
981 Just new_mcpu -> flip Node.setMcpu new_mcpu
982 let nm = Container.map (setNodeOffline offline_indices .
983 flip Node.setMdsk m_dsk .
984 setMCpuFn) fixed_nl
985 return nm