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