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