Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / HTools / CLI.hs @ 914c6df4

History | View | Annotate | Download (23.5 kB)

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

    
13
This program is free software; you can redistribute it and/or modify
14
it under the terms of the GNU General Public License as published by
15
the Free Software Foundation; either version 2 of the License, or
16
(at your option) any later version.
17

    
18
This program is distributed in the hope that it will be useful, but
19
WITHOUT ANY WARRANTY; without even the implied warranty of
20
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
21
General Public License for more details.
22

    
23
You should have received a copy of the GNU General Public License
24
along with this program; if not, write to the Free Software
25
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26
02110-1301, USA.
27

    
28
-}
29

    
30
module Ganeti.HTools.CLI
31
  ( Options(..)
32
  , OptType
33
  , defaultOptions
34
  , Ganeti.HTools.CLI.parseOpts
35
  , parseOptsInner
36
  , parseYesNo
37
  , parseISpecString
38
  , shTemplate
39
  , maybePrintNodes
40
  , maybePrintInsts
41
  , maybeShowWarnings
42
  , printKeys
43
  , printFinal
44
  , setNodeStatus
45
  -- * The options
46
  , oDataFile
47
  , oDiskMoves
48
  , oDiskTemplate
49
  , oSpindleUse
50
  , oDynuFile
51
  , oEvacMode
52
  , oExInst
53
  , oExTags
54
  , oExecJobs
55
  , oForce
56
  , oGroup
57
  , oIAllocSrc
58
  , oIgnoreNonRedundant
59
  , oInstMoves
60
  , oJobDelay
61
  , genOLuxiSocket
62
  , oLuxiSocket
63
  , oMachineReadable
64
  , oMaxCpu
65
  , oMaxSolLength
66
  , oMinDisk
67
  , oMinGain
68
  , oMinGainLim
69
  , oMinScore
70
  , oNoHeaders
71
  , oNoSimulation
72
  , oNodeSim
73
  , oNodeTags
74
  , oOfflineMaintenance
75
  , oOfflineNode
76
  , oOneStepOnly
77
  , oOutputDir
78
  , oPrintCommands
79
  , oPrintInsts
80
  , oPrintNodes
81
  , oQuiet
82
  , oRapiMaster
83
  , oSaveCluster
84
  , oSelInst
85
  , oShowHelp
86
  , oShowVer
87
  , oShowComp
88
  , oSkipNonRedundant
89
  , oStdSpec
90
  , oTieredSpec
91
  , oVerbose
92
  , oPriority
93
  , genericOpts
94
  ) where
95

    
96
import Control.Monad
97
import Data.Char (toUpper)
98
import Data.Maybe (fromMaybe)
99
import System.Console.GetOpt
100
import System.IO
101
import Text.Printf (printf)
102

    
103
import qualified Ganeti.HTools.Container as Container
104
import qualified Ganeti.HTools.Node as Node
105
import qualified Ganeti.Path as Path
106
import Ganeti.HTools.Types
107
import Ganeti.BasicTypes
108
import Ganeti.Common as Common
109
import Ganeti.Types
110
import Ganeti.Utils
111

    
112
-- * Data types
113

    
114
-- | Command line options structure.
115
data Options = Options
116
  { optDataFile    :: Maybe FilePath -- ^ Path to the cluster data file
117
  , optDiskMoves   :: Bool           -- ^ Allow disk moves
118
  , optInstMoves   :: Bool           -- ^ Allow instance moves
119
  , optDiskTemplate :: Maybe DiskTemplate  -- ^ Override for the disk template
120
  , optSpindleUse  :: Maybe Int      -- ^ Override for the spindle usage
121
  , optDynuFile    :: Maybe FilePath -- ^ Optional file with dynamic use data
122
  , optEvacMode    :: Bool           -- ^ Enable evacuation mode
123
  , optExInst      :: [String]       -- ^ Instances to be excluded
124
  , optExTags      :: Maybe [String] -- ^ Tags to use for exclusion
125
  , optExecJobs    :: Bool           -- ^ Execute the commands via Luxi
126
  , optForce       :: Bool           -- ^ Force the execution
127
  , optGroup       :: Maybe GroupID  -- ^ The UUID of the group to process
128
  , optIAllocSrc   :: Maybe FilePath -- ^ The iallocation spec
129
  , optIgnoreNonRedundant :: Bool    -- ^ Ignore non-redundant instances
130
  , optSelInst     :: [String]       -- ^ Instances to be excluded
131
  , optLuxi        :: Maybe FilePath -- ^ Collect data from Luxi
132
  , optJobDelay    :: Double         -- ^ Delay before executing first job
133
  , optMachineReadable :: Bool       -- ^ Output machine-readable format
134
  , optMaster      :: String         -- ^ Collect data from RAPI
135
  , optMaxLength   :: Int            -- ^ Stop after this many steps
136
  , optMcpu        :: Maybe Double   -- ^ Override max cpu ratio for nodes
137
  , optMdsk        :: Double         -- ^ Max disk usage ratio for nodes
138
  , optMinGain     :: Score          -- ^ Min gain we aim for in a step
139
  , optMinGainLim  :: Score          -- ^ Limit below which we apply mingain
140
  , optMinScore    :: Score          -- ^ The minimum score we aim for
141
  , optNoHeaders   :: Bool           -- ^ Do not show a header line
142
  , optNoSimulation :: Bool          -- ^ Skip the rebalancing dry-run
143
  , optNodeSim     :: [String]       -- ^ Cluster simulation mode
144
  , optNodeTags    :: Maybe [String] -- ^ List of node tags to restrict to 
145
  , optOffline     :: [String]       -- ^ Names of offline nodes
146
  , optOfflineMaintenance :: Bool    -- ^ Pretend all instances are offline
147
  , optOneStepOnly :: Bool           -- ^ Only do the first step
148
  , optOutPath     :: FilePath       -- ^ Path to the output directory
149
  , optSaveCluster :: Maybe FilePath -- ^ Save cluster state to this file
150
  , optShowCmds    :: Maybe FilePath -- ^ Whether to show the command list
151
  , optShowHelp    :: Bool           -- ^ Just show the help
152
  , optShowComp    :: Bool           -- ^ Just show the completion info
153
  , optShowInsts   :: Bool           -- ^ Whether to show the instance map
154
  , optShowNodes   :: Maybe [String] -- ^ Whether to show node status
155
  , optShowVer     :: Bool           -- ^ Just show the program version
156
  , optSkipNonRedundant :: Bool      -- ^ Skip nodes with non-redundant instance
157
  , optStdSpec     :: Maybe RSpec    -- ^ Requested standard specs
158
  , optTestCount   :: Maybe Int      -- ^ Optional test count override
159
  , optTieredSpec  :: Maybe RSpec    -- ^ Requested specs for tiered mode
160
  , optReplay      :: Maybe String   -- ^ Unittests: RNG state
161
  , optVerbose     :: Int            -- ^ Verbosity level
162
  , optPriority    :: Maybe OpSubmitPriority -- ^ OpCode submit priority
163
  } deriving Show
164

    
165
-- | Default values for the command line options.
166
defaultOptions :: Options
167
defaultOptions  = Options
168
  { optDataFile    = Nothing
169
  , optDiskMoves   = True
170
  , optInstMoves   = True
171
  , optDiskTemplate = Nothing
172
  , optSpindleUse  = Nothing
173
  , optDynuFile    = Nothing
174
  , optEvacMode    = False
175
  , optExInst      = []
176
  , optExTags      = Nothing
177
  , optExecJobs    = False
178
  , optForce       = False
179
  , optGroup       = Nothing
180
  , optIAllocSrc   = Nothing
181
  , optIgnoreNonRedundant = False
182
  , optSelInst     = []
183
  , optLuxi        = Nothing
184
  , optJobDelay    = 10
185
  , optMachineReadable = False
186
  , optMaster      = ""
187
  , optMaxLength   = -1
188
  , optMcpu        = Nothing
189
  , optMdsk        = defReservedDiskRatio
190
  , optMinGain     = 1e-2
191
  , optMinGainLim  = 1e-1
192
  , optMinScore    = 1e-9
193
  , optNoHeaders   = False
194
  , optNoSimulation = False
195
  , optNodeSim     = []
196
  , optNodeTags    = Nothing
197
  , optSkipNonRedundant = False
198
  , optOffline     = []
199
  , optOfflineMaintenance = False
200
  , optOneStepOnly = False
201
  , optOutPath     = "."
202
  , optSaveCluster = Nothing
203
  , optShowCmds    = Nothing
204
  , optShowHelp    = False
205
  , optShowComp    = False
206
  , optShowInsts   = False
207
  , optShowNodes   = Nothing
208
  , optShowVer     = False
209
  , optStdSpec     = Nothing
210
  , optTestCount   = Nothing
211
  , optTieredSpec  = Nothing
212
  , optReplay      = Nothing
213
  , optVerbose     = 1
214
  , optPriority    = Nothing
215
  }
216

    
217
-- | Abbreviation for the option type.
218
type OptType = GenericOptType Options
219

    
220
instance StandardOptions Options where
221
  helpRequested = optShowHelp
222
  verRequested  = optShowVer
223
  compRequested = optShowComp
224
  requestHelp o = o { optShowHelp = True }
225
  requestVer  o = o { optShowVer  = True }
226
  requestComp o = o { optShowComp = True }
227

    
228
-- * Helper functions
229

    
230
parseISpecString :: String -> String -> Result RSpec
231
parseISpecString descr inp = do
232
  let sp = sepSplit ',' inp
233
      err = Bad ("Invalid " ++ descr ++ " specification: '" ++ inp ++
234
                 "', expected disk,ram,cpu")
235
  when (length sp < 3 || length sp > 4) err
236
  prs <- mapM (\(fn, val) -> fn val) $
237
         zip [ annotateResult (descr ++ " specs disk") . parseUnit
238
             , annotateResult (descr ++ " specs memory") . parseUnit
239
             , tryRead (descr ++ " specs cpus")
240
             , tryRead (descr ++ " specs spindles")
241
             ] sp
242
  case prs of
243
    {- Spindles are optional, so that they are not needed when exclusive storage
244
       is disabled. When exclusive storage is disabled, spindles are ignored,
245
       so the actual value doesn't matter. We use 1 as a default so that in
246
       case someone forgets and exclusive storage is enabled, we don't run into
247
       weird situations. -}
248
    [dsk, ram, cpu] -> return $ RSpec cpu ram dsk 1
249
    [dsk, ram, cpu, spn] -> return $ RSpec cpu ram dsk spn
250
    _ -> err
251

    
252
-- | Disk template choices.
253
optComplDiskTemplate :: OptCompletion
254
optComplDiskTemplate = OptComplChoices $
255
                       map diskTemplateToRaw [minBound..maxBound]
256

    
257
-- * Command line options
258

    
259
oDataFile :: OptType
260
oDataFile =
261
  (Option "t" ["text-data"]
262
   (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
263
   "the cluster data FILE",
264
   OptComplFile)
265

    
266
oDiskMoves :: OptType
267
oDiskMoves =
268
  (Option "" ["no-disk-moves"]
269
   (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
270
   "disallow disk moves from the list of allowed instance changes,\
271
   \ thus allowing only the 'cheap' failover/migrate operations",
272
   OptComplNone)
273

    
274
oDiskTemplate :: OptType
275
oDiskTemplate =
276
  (Option "" ["disk-template"]
277
   (reqWithConversion diskTemplateFromRaw
278
    (\dt opts -> Ok opts { optDiskTemplate = Just dt })
279
    "TEMPLATE") "select the desired disk template",
280
   optComplDiskTemplate)
281

    
282
oSpindleUse :: OptType
283
oSpindleUse =
284
  (Option "" ["spindle-use"]
285
   (reqWithConversion (tryRead "parsing spindle-use")
286
    (\su opts -> do
287
       when (su < 0) $
288
            fail "Invalid value of the spindle-use (expected >= 0)"
289
       return $ opts { optSpindleUse = Just su })
290
    "SPINDLES") "select how many virtual spindle instances use\
291
                \ [default read from cluster]",
292
   OptComplFloat)
293

    
294
oSelInst :: OptType
295
oSelInst =
296
  (Option "" ["select-instances"]
297
   (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
298
   "only select given instances for any moves",
299
   OptComplManyInstances)
300

    
301
oInstMoves :: OptType
302
oInstMoves =
303
  (Option "" ["no-instance-moves"]
304
   (NoArg (\ opts -> Ok opts { optInstMoves = False}))
305
   "disallow instance (primary node) moves from the list of allowed,\
306
   \ instance changes, thus allowing only slower, but sometimes\
307
   \ safer, drbd secondary changes",
308
   OptComplNone)
309

    
310
oDynuFile :: OptType
311
oDynuFile =
312
  (Option "U" ["dynu-file"]
313
   (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
314
   "Import dynamic utilisation data from the given FILE",
315
   OptComplFile)
316

    
317
oEvacMode :: OptType
318
oEvacMode =
319
  (Option "E" ["evac-mode"]
320
   (NoArg (\opts -> Ok opts { optEvacMode = True }))
321
   "enable evacuation mode, where the algorithm only moves\
322
   \ instances away from offline and drained nodes",
323
   OptComplNone)
324

    
325
oExInst :: OptType
326
oExInst =
327
  (Option "" ["exclude-instances"]
328
   (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
329
   "exclude given instances from any moves",
330
   OptComplManyInstances)
331

    
332
oExTags :: OptType
333
oExTags =
334
  (Option "" ["exclusion-tags"]
335
   (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
336
    "TAG,...") "Enable instance exclusion based on given tag prefix",
337
   OptComplString)
338

    
339
oExecJobs :: OptType
340
oExecJobs =
341
  (Option "X" ["exec"]
342
   (NoArg (\ opts -> Ok opts { optExecJobs = True}))
343
   "execute the suggested moves via Luxi (only available when using\
344
   \ it for data gathering)",
345
   OptComplNone)
346

    
347
oForce :: OptType
348
oForce =
349
  (Option "f" ["force"]
350
   (NoArg (\ opts -> Ok opts {optForce = True}))
351
   "force the execution of this program, even if warnings would\
352
   \ otherwise prevent it",
353
   OptComplNone)
354

    
355
oGroup :: OptType
356
oGroup =
357
  (Option "G" ["group"]
358
   (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
359
   "the target node group (name or UUID)",
360
   OptComplOneGroup)
361

    
362
oIAllocSrc :: OptType
363
oIAllocSrc =
364
  (Option "I" ["ialloc-src"]
365
   (ReqArg (\ f opts -> Ok opts { optIAllocSrc = Just f }) "FILE")
366
   "Specify an iallocator spec as the cluster data source",
367
   OptComplFile)
368

    
369
oIgnoreNonRedundant :: OptType
370
oIgnoreNonRedundant =
371
  (Option "" ["ignore-non-redundant"]
372
   (NoArg (\ opts -> Ok opts { optIgnoreNonRedundant = True }))
373
    "Pretend that there are no non-redundant instances in the cluster",
374
    OptComplNone)
375

    
376
oJobDelay :: OptType
377
oJobDelay =
378
  (Option "" ["job-delay"]
379
   (reqWithConversion (tryRead "job delay")
380
    (\d opts -> Ok opts { optJobDelay = d }) "SECONDS")
381
   "insert this much delay before the execution of repair jobs\
382
   \ to allow the tool to continue processing instances",
383
   OptComplFloat)
384

    
385
genOLuxiSocket :: String -> OptType
386
genOLuxiSocket defSocket =
387
  (Option "L" ["luxi"]
388
   (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
389
            fromMaybe defSocket) "SOCKET")
390
   ("collect data via Luxi, optionally using the given SOCKET path [" ++
391
    defSocket ++ "]"),
392
   OptComplFile)
393

    
394
oLuxiSocket :: IO OptType
395
oLuxiSocket = liftM genOLuxiSocket Path.defaultLuxiSocket
396

    
397
oMachineReadable :: OptType
398
oMachineReadable =
399
  (Option "" ["machine-readable"]
400
   (OptArg (\ f opts -> do
401
              flag <- parseYesNo True f
402
              return $ opts { optMachineReadable = flag }) "CHOICE")
403
   "enable machine readable output (pass either 'yes' or 'no' to\
404
   \ explicitly control the flag, or without an argument defaults to\
405
   \ yes",
406
   optComplYesNo)
407

    
408
oMaxCpu :: OptType
409
oMaxCpu =
410
  (Option "" ["max-cpu"]
411
   (reqWithConversion (tryRead "parsing max-cpu")
412
    (\mcpu opts -> do
413
       when (mcpu <= 0) $
414
            fail "Invalid value of the max-cpu ratio, expected >0"
415
       return $ opts { optMcpu = Just mcpu }) "RATIO")
416
   "maximum virtual-to-physical cpu ratio for nodes (from 0\
417
   \ upwards) [default read from cluster]",
418
   OptComplFloat)
419

    
420
oMaxSolLength :: OptType
421
oMaxSolLength =
422
  (Option "l" ["max-length"]
423
   (reqWithConversion (tryRead "max solution length")
424
    (\i opts -> Ok opts { optMaxLength = i }) "N")
425
   "cap the solution at this many balancing or allocation\
426
   \ rounds (useful for very unbalanced clusters or empty\
427
   \ clusters)",
428
   OptComplInteger)
429

    
430
oMinDisk :: OptType
431
oMinDisk =
432
  (Option "" ["min-disk"]
433
   (reqWithConversion (tryRead "min free disk space")
434
    (\n opts -> Ok opts { optMdsk = n }) "RATIO")
435
   "minimum free disk space for nodes (between 0 and 1) [0]",
436
   OptComplFloat)
437

    
438
oMinGain :: OptType
439
oMinGain =
440
  (Option "g" ["min-gain"]
441
   (reqWithConversion (tryRead "min gain")
442
    (\g opts -> Ok opts { optMinGain = g }) "DELTA")
443
   "minimum gain to aim for in a balancing step before giving up",
444
   OptComplFloat)
445

    
446
oMinGainLim :: OptType
447
oMinGainLim =
448
  (Option "" ["min-gain-limit"]
449
   (reqWithConversion (tryRead "min gain limit")
450
    (\g opts -> Ok opts { optMinGainLim = g }) "SCORE")
451
   "minimum cluster score for which we start checking the min-gain",
452
   OptComplFloat)
453

    
454
oMinScore :: OptType
455
oMinScore =
456
  (Option "e" ["min-score"]
457
   (reqWithConversion (tryRead "min score")
458
    (\e opts -> Ok opts { optMinScore = e }) "EPSILON")
459
   "mininum score to aim for",
460
   OptComplFloat)
461

    
462
oNoHeaders :: OptType
463
oNoHeaders =
464
  (Option "" ["no-headers"]
465
   (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
466
   "do not show a header line",
467
   OptComplNone)
468

    
469
oNoSimulation :: OptType
470
oNoSimulation =
471
  (Option "" ["no-simulation"]
472
   (NoArg (\opts -> Ok opts {optNoSimulation = True}))
473
   "do not perform rebalancing simulation",
474
   OptComplNone)
475

    
476
oNodeSim :: OptType
477
oNodeSim =
478
  (Option "" ["simulate"]
479
   (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
480
   "simulate an empty cluster, given as\
481
   \ 'alloc_policy,num_nodes,disk,ram,cpu'",
482
   OptComplString)
483

    
484
oNodeTags :: OptType
485
oNodeTags =
486
  (Option "" ["node-tags"]
487
   (ReqArg (\ f opts -> Ok opts { optNodeTags = Just $ sepSplit ',' f })
488
    "TAG,...") "Restrict to nodes with the given tags",
489
   OptComplString)
490
     
491
oOfflineMaintenance :: OptType
492
oOfflineMaintenance =
493
  (Option "" ["offline-maintenance"]
494
   (NoArg (\ opts -> Ok opts {optOfflineMaintenance = True}))
495
   "Schedule offline maintenance, i.e., pretend that all instance are\
496
   \ offline.",
497
   OptComplNone)
498

    
499
oOfflineNode :: OptType
500
oOfflineNode =
501
  (Option "O" ["offline"]
502
   (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
503
   "set node as offline",
504
   OptComplOneNode)
505

    
506
oOneStepOnly :: OptType
507
oOneStepOnly =
508
  (Option "" ["one-step-only"]
509
   (NoArg (\ opts -> Ok opts {optOneStepOnly = True}))
510
   "Only do the first step",
511
   OptComplNone)
512

    
513
oOutputDir :: OptType
514
oOutputDir =
515
  (Option "d" ["output-dir"]
516
   (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
517
   "directory in which to write output files",
518
   OptComplDir)
519

    
520
oPrintCommands :: OptType
521
oPrintCommands =
522
  (Option "C" ["print-commands"]
523
   (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
524
            fromMaybe "-")
525
    "FILE")
526
   "print the ganeti command list for reaching the solution,\
527
   \ if an argument is passed then write the commands to a\
528
   \ file named as such",
529
   OptComplNone)
530

    
531
oPrintInsts :: OptType
532
oPrintInsts =
533
  (Option "" ["print-instances"]
534
   (NoArg (\ opts -> Ok opts { optShowInsts = True }))
535
   "print the final instance map",
536
   OptComplNone)
537

    
538
oPrintNodes :: OptType
539
oPrintNodes =
540
  (Option "p" ["print-nodes"]
541
   (OptArg ((\ f opts ->
542
               let (prefix, realf) = case f of
543
                                       '+':rest -> (["+"], rest)
544
                                       _ -> ([], f)
545
                   splitted = prefix ++ sepSplit ',' realf
546
               in Ok opts { optShowNodes = Just splitted }) .
547
            fromMaybe []) "FIELDS")
548
   "print the final node list",
549
   OptComplNone)
550

    
551
oQuiet :: OptType
552
oQuiet =
553
  (Option "q" ["quiet"]
554
   (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
555
   "decrease the verbosity level",
556
   OptComplNone)
557

    
558
oRapiMaster :: OptType
559
oRapiMaster =
560
  (Option "m" ["master"]
561
   (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
562
   "collect data via RAPI at the given ADDRESS",
563
   OptComplHost)
564

    
565
oSaveCluster :: OptType
566
oSaveCluster =
567
  (Option "S" ["save"]
568
   (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
569
   "Save cluster state at the end of the processing to FILE",
570
   OptComplNone)
571

    
572
oSkipNonRedundant :: OptType
573
oSkipNonRedundant =
574
  (Option "" ["skip-non-redundant"]
575
   (NoArg (\ opts -> Ok opts { optSkipNonRedundant = True }))
576
    "Skip nodes that host a non-redundant instance",
577
    OptComplNone)
578

    
579
oStdSpec :: OptType
580
oStdSpec =
581
  (Option "" ["standard-alloc"]
582
   (ReqArg (\ inp opts -> do
583
              tspec <- parseISpecString "standard" inp
584
              return $ opts { optStdSpec = Just tspec } )
585
    "STDSPEC")
586
   "enable standard specs allocation, given as 'disk,ram,cpu'",
587
   OptComplString)
588

    
589
oTieredSpec :: OptType
590
oTieredSpec =
591
  (Option "" ["tiered-alloc"]
592
   (ReqArg (\ inp opts -> do
593
              tspec <- parseISpecString "tiered" inp
594
              return $ opts { optTieredSpec = Just tspec } )
595
    "TSPEC")
596
   "enable tiered specs allocation, given as 'disk,ram,cpu'",
597
   OptComplString)
598

    
599
oVerbose :: OptType
600
oVerbose =
601
  (Option "v" ["verbose"]
602
   (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
603
   "increase the verbosity level",
604
   OptComplNone)
605

    
606
oPriority :: OptType
607
oPriority =
608
  (Option "" ["priority"]
609
   (ReqArg (\ inp opts -> do
610
              prio <- parseSubmitPriority inp
611
              Ok opts { optPriority = Just prio }) "PRIO")
612
   "set the priority of submitted jobs",
613
    OptComplChoices (map fmtSubmitPriority [minBound..maxBound]))
614

    
615
-- | Generic options.
616
genericOpts :: [GenericOptType Options]
617
genericOpts =  [ oShowVer
618
               , oShowHelp
619
               , oShowComp
620
               ]
621

    
622
-- * Functions
623

    
624
-- | Wrapper over 'Common.parseOpts' with our custom options.
625
parseOpts :: [String]               -- ^ The command line arguments
626
          -> String                 -- ^ The program name
627
          -> [OptType]              -- ^ The supported command line options
628
          -> [ArgCompletion]        -- ^ The supported command line arguments
629
          -> IO (Options, [String]) -- ^ The resulting options and leftover
630
                                    -- arguments
631
parseOpts = Common.parseOpts defaultOptions
632

    
633

    
634
-- | A shell script template for autogenerated scripts.
635
shTemplate :: String
636
shTemplate =
637
  printf "#!/bin/sh\n\n\
638
         \# Auto-generated script for executing cluster rebalancing\n\n\
639
         \# To stop, touch the file /tmp/stop-htools\n\n\
640
         \set -e\n\n\
641
         \check() {\n\
642
         \  if [ -f /tmp/stop-htools ]; then\n\
643
         \    echo 'Stop requested, exiting'\n\
644
         \    exit 0\n\
645
         \  fi\n\
646
         \}\n\n"
647

    
648
-- | Optionally print the node list.
649
maybePrintNodes :: Maybe [String]       -- ^ The field list
650
                -> String               -- ^ Informational message
651
                -> ([String] -> String) -- ^ Function to generate the listing
652
                -> IO ()
653
maybePrintNodes Nothing _ _ = return ()
654
maybePrintNodes (Just fields) msg fn = do
655
  hPutStrLn stderr ""
656
  hPutStrLn stderr (msg ++ " status:")
657
  hPutStrLn stderr $ fn fields
658

    
659
-- | Optionally print the instance list.
660
maybePrintInsts :: Bool   -- ^ Whether to print the instance list
661
                -> String -- ^ Type of the instance map (e.g. initial)
662
                -> String -- ^ The instance data
663
                -> IO ()
664
maybePrintInsts do_print msg instdata =
665
  when do_print $ do
666
    hPutStrLn stderr ""
667
    hPutStrLn stderr $ msg ++ " instance map:"
668
    hPutStr stderr instdata
669

    
670
-- | Function to display warning messages from parsing the cluster
671
-- state.
672
maybeShowWarnings :: [String] -- ^ The warning messages
673
                  -> IO ()
674
maybeShowWarnings fix_msgs =
675
  unless (null fix_msgs) $ do
676
    hPutStrLn stderr "Warning: cluster has inconsistent data:"
677
    hPutStrLn stderr . unlines . map (printf "  - %s") $ fix_msgs
678

    
679
-- | Format a list of key, value as a shell fragment.
680
printKeys :: String              -- ^ Prefix to printed variables
681
          -> [(String, String)]  -- ^ List of (key, value) pairs to be printed
682
          -> IO ()
683
printKeys prefix =
684
  mapM_ (\(k, v) ->
685
           printf "%s_%s=%s\n" prefix (map toUpper k) (ensureQuoted v))
686

    
687
-- | Prints the final @OK@ marker in machine readable output.
688
printFinal :: String    -- ^ Prefix to printed variable
689
           -> Bool      -- ^ Whether output should be machine readable;
690
                        -- note: if not, there is nothing to print
691
           -> IO ()
692
printFinal prefix True =
693
  -- this should be the final entry
694
  printKeys prefix [("OK", "1")]
695

    
696
printFinal _ False = return ()
697

    
698
-- | Potentially set the node as offline based on passed offline list.
699
setNodeOffline :: [Ndx] -> Node.Node -> Node.Node
700
setNodeOffline offline_indices n =
701
  if Node.idx n `elem` offline_indices
702
    then Node.setOffline n True
703
    else n
704

    
705
-- | Set node properties based on command line options.
706
setNodeStatus :: Options -> Node.List -> IO Node.List
707
setNodeStatus opts fixed_nl = do
708
  let offline_passed = optOffline opts
709
      all_nodes = Container.elems fixed_nl
710
      offline_lkp = map (lookupName (map Node.name all_nodes)) offline_passed
711
      offline_wrong = filter (not . goodLookupResult) offline_lkp
712
      offline_names = map lrContent offline_lkp
713
      offline_indices = map Node.idx $
714
                        filter (\n -> Node.name n `elem` offline_names)
715
                               all_nodes
716
      m_cpu = optMcpu opts
717
      m_dsk = optMdsk opts
718

    
719
  unless (null offline_wrong) .
720
         exitErr $ printf "wrong node name(s) set as offline: %s\n"
721
                   (commaJoin (map lrContent offline_wrong))
722
  let setMCpuFn = case m_cpu of
723
                    Nothing -> id
724
                    Just new_mcpu -> flip Node.setMcpu new_mcpu
725
  let nm = Container.map (setNodeOffline offline_indices .
726
                          flip Node.setMdsk m_dsk .
727
                          setMCpuFn) fixed_nl
728
  return nm