Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / HTools / CLI.hs @ 23247a73

History | View | Annotate | Download (23 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) 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
             ] sp
241
  case prs of
242
    [dsk, ram, cpu] -> return $ RSpec cpu ram dsk
243
    _ -> err
244

    
245
-- | Disk template choices.
246
optComplDiskTemplate :: OptCompletion
247
optComplDiskTemplate = OptComplChoices $
248
                       map diskTemplateToRaw [minBound..maxBound]
249

    
250
-- * Command line options
251

    
252
oDataFile :: OptType
253
oDataFile =
254
  (Option "t" ["text-data"]
255
   (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
256
   "the cluster data FILE",
257
   OptComplFile)
258

    
259
oDiskMoves :: OptType
260
oDiskMoves =
261
  (Option "" ["no-disk-moves"]
262
   (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
263
   "disallow disk moves from the list of allowed instance changes,\
264
   \ thus allowing only the 'cheap' failover/migrate operations",
265
   OptComplNone)
266

    
267
oDiskTemplate :: OptType
268
oDiskTemplate =
269
  (Option "" ["disk-template"]
270
   (reqWithConversion diskTemplateFromRaw
271
    (\dt opts -> Ok opts { optDiskTemplate = Just dt })
272
    "TEMPLATE") "select the desired disk template",
273
   optComplDiskTemplate)
274

    
275
oSpindleUse :: OptType
276
oSpindleUse =
277
  (Option "" ["spindle-use"]
278
   (reqWithConversion (tryRead "parsing spindle-use")
279
    (\su opts -> do
280
       when (su < 0) $
281
            fail "Invalid value of the spindle-use (expected >= 0)"
282
       return $ opts { optSpindleUse = Just su })
283
    "SPINDLES") "select how many virtual spindle instances use\
284
                \ [default read from cluster]",
285
   OptComplFloat)
286

    
287
oSelInst :: OptType
288
oSelInst =
289
  (Option "" ["select-instances"]
290
   (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
291
   "only select given instances for any moves",
292
   OptComplManyInstances)
293

    
294
oInstMoves :: OptType
295
oInstMoves =
296
  (Option "" ["no-instance-moves"]
297
   (NoArg (\ opts -> Ok opts { optInstMoves = False}))
298
   "disallow instance (primary node) moves from the list of allowed,\
299
   \ instance changes, thus allowing only slower, but sometimes\
300
   \ safer, drbd secondary changes",
301
   OptComplNone)
302

    
303
oDynuFile :: OptType
304
oDynuFile =
305
  (Option "U" ["dynu-file"]
306
   (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
307
   "Import dynamic utilisation data from the given FILE",
308
   OptComplFile)
309

    
310
oEvacMode :: OptType
311
oEvacMode =
312
  (Option "E" ["evac-mode"]
313
   (NoArg (\opts -> Ok opts { optEvacMode = True }))
314
   "enable evacuation mode, where the algorithm only moves\
315
   \ instances away from offline and drained nodes",
316
   OptComplNone)
317

    
318
oExInst :: OptType
319
oExInst =
320
  (Option "" ["exclude-instances"]
321
   (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
322
   "exclude given instances from any moves",
323
   OptComplManyInstances)
324

    
325
oExTags :: OptType
326
oExTags =
327
  (Option "" ["exclusion-tags"]
328
   (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
329
    "TAG,...") "Enable instance exclusion based on given tag prefix",
330
   OptComplString)
331

    
332
oExecJobs :: OptType
333
oExecJobs =
334
  (Option "X" ["exec"]
335
   (NoArg (\ opts -> Ok opts { optExecJobs = True}))
336
   "execute the suggested moves via Luxi (only available when using\
337
   \ it for data gathering)",
338
   OptComplNone)
339

    
340
oForce :: OptType
341
oForce =
342
  (Option "f" ["force"]
343
   (NoArg (\ opts -> Ok opts {optForce = True}))
344
   "force the execution of this program, even if warnings would\
345
   \ otherwise prevent it",
346
   OptComplNone)
347

    
348
oGroup :: OptType
349
oGroup =
350
  (Option "G" ["group"]
351
   (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
352
   "the target node group (name or UUID)",
353
   OptComplOneGroup)
354

    
355
oIAllocSrc :: OptType
356
oIAllocSrc =
357
  (Option "I" ["ialloc-src"]
358
   (ReqArg (\ f opts -> Ok opts { optIAllocSrc = Just f }) "FILE")
359
   "Specify an iallocator spec as the cluster data source",
360
   OptComplFile)
361

    
362
oIgnoreNonRedundant :: OptType
363
oIgnoreNonRedundant =
364
  (Option "" ["ignore-non-redundant"]
365
   (NoArg (\ opts -> Ok opts { optIgnoreNonRedundant = True }))
366
    "Pretend that there are no non-redundant instances in the cluster",
367
    OptComplNone)
368

    
369
oJobDelay :: OptType
370
oJobDelay =
371
  (Option "" ["job-delay"]
372
   (reqWithConversion (tryRead "job delay")
373
    (\d opts -> Ok opts { optJobDelay = d }) "SECONDS")
374
   "insert this much delay before the execution of repair jobs\
375
   \ to allow the tool to continue processing instances",
376
   OptComplFloat)
377

    
378
genOLuxiSocket :: String -> OptType
379
genOLuxiSocket defSocket =
380
  (Option "L" ["luxi"]
381
   (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
382
            fromMaybe defSocket) "SOCKET")
383
   ("collect data via Luxi, optionally using the given SOCKET path [" ++
384
    defSocket ++ "]"),
385
   OptComplFile)
386

    
387
oLuxiSocket :: IO OptType
388
oLuxiSocket = liftM genOLuxiSocket Path.defaultLuxiSocket
389

    
390
oMachineReadable :: OptType
391
oMachineReadable =
392
  (Option "" ["machine-readable"]
393
   (OptArg (\ f opts -> do
394
              flag <- parseYesNo True f
395
              return $ opts { optMachineReadable = flag }) "CHOICE")
396
   "enable machine readable output (pass either 'yes' or 'no' to\
397
   \ explicitly control the flag, or without an argument defaults to\
398
   \ yes",
399
   optComplYesNo)
400

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

    
413
oMaxSolLength :: OptType
414
oMaxSolLength =
415
  (Option "l" ["max-length"]
416
   (reqWithConversion (tryRead "max solution length")
417
    (\i opts -> Ok opts { optMaxLength = i }) "N")
418
   "cap the solution at this many balancing or allocation\
419
   \ rounds (useful for very unbalanced clusters or empty\
420
   \ clusters)",
421
   OptComplInteger)
422

    
423
oMinDisk :: OptType
424
oMinDisk =
425
  (Option "" ["min-disk"]
426
   (reqWithConversion (tryRead "min free disk space")
427
    (\n opts -> Ok opts { optMdsk = n }) "RATIO")
428
   "minimum free disk space for nodes (between 0 and 1) [0]",
429
   OptComplFloat)
430

    
431
oMinGain :: OptType
432
oMinGain =
433
  (Option "g" ["min-gain"]
434
   (reqWithConversion (tryRead "min gain")
435
    (\g opts -> Ok opts { optMinGain = g }) "DELTA")
436
   "minimum gain to aim for in a balancing step before giving up",
437
   OptComplFloat)
438

    
439
oMinGainLim :: OptType
440
oMinGainLim =
441
  (Option "" ["min-gain-limit"]
442
   (reqWithConversion (tryRead "min gain limit")
443
    (\g opts -> Ok opts { optMinGainLim = g }) "SCORE")
444
   "minimum cluster score for which we start checking the min-gain",
445
   OptComplFloat)
446

    
447
oMinScore :: OptType
448
oMinScore =
449
  (Option "e" ["min-score"]
450
   (reqWithConversion (tryRead "min score")
451
    (\e opts -> Ok opts { optMinScore = e }) "EPSILON")
452
   "mininum score to aim for",
453
   OptComplFloat)
454

    
455
oNoHeaders :: OptType
456
oNoHeaders =
457
  (Option "" ["no-headers"]
458
   (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
459
   "do not show a header line",
460
   OptComplNone)
461

    
462
oNoSimulation :: OptType
463
oNoSimulation =
464
  (Option "" ["no-simulation"]
465
   (NoArg (\opts -> Ok opts {optNoSimulation = True}))
466
   "do not perform rebalancing simulation",
467
   OptComplNone)
468

    
469
oNodeSim :: OptType
470
oNodeSim =
471
  (Option "" ["simulate"]
472
   (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
473
   "simulate an empty cluster, given as\
474
   \ 'alloc_policy,num_nodes,disk,ram,cpu'",
475
   OptComplString)
476

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

    
492
oOfflineNode :: OptType
493
oOfflineNode =
494
  (Option "O" ["offline"]
495
   (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
496
   "set node as offline",
497
   OptComplOneNode)
498

    
499
oOneStepOnly :: OptType
500
oOneStepOnly =
501
  (Option "" ["one-step-only"]
502
   (NoArg (\ opts -> Ok opts {optOneStepOnly = True}))
503
   "Only do the first step",
504
   OptComplNone)
505

    
506
oOutputDir :: OptType
507
oOutputDir =
508
  (Option "d" ["output-dir"]
509
   (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
510
   "directory in which to write output files",
511
   OptComplDir)
512

    
513
oPrintCommands :: OptType
514
oPrintCommands =
515
  (Option "C" ["print-commands"]
516
   (OptArg ((\ f opts -> Ok opts { optShowCmds = Just f }) .
517
            fromMaybe "-")
518
    "FILE")
519
   "print the ganeti command list for reaching the solution,\
520
   \ if an argument is passed then write the commands to a\
521
   \ file named as such",
522
   OptComplNone)
523

    
524
oPrintInsts :: OptType
525
oPrintInsts =
526
  (Option "" ["print-instances"]
527
   (NoArg (\ opts -> Ok opts { optShowInsts = True }))
528
   "print the final instance map",
529
   OptComplNone)
530

    
531
oPrintNodes :: OptType
532
oPrintNodes =
533
  (Option "p" ["print-nodes"]
534
   (OptArg ((\ f opts ->
535
               let (prefix, realf) = case f of
536
                                       '+':rest -> (["+"], rest)
537
                                       _ -> ([], f)
538
                   splitted = prefix ++ sepSplit ',' realf
539
               in Ok opts { optShowNodes = Just splitted }) .
540
            fromMaybe []) "FIELDS")
541
   "print the final node list",
542
   OptComplNone)
543

    
544
oQuiet :: OptType
545
oQuiet =
546
  (Option "q" ["quiet"]
547
   (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
548
   "decrease the verbosity level",
549
   OptComplNone)
550

    
551
oRapiMaster :: OptType
552
oRapiMaster =
553
  (Option "m" ["master"]
554
   (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
555
   "collect data via RAPI at the given ADDRESS",
556
   OptComplHost)
557

    
558
oSaveCluster :: OptType
559
oSaveCluster =
560
  (Option "S" ["save"]
561
   (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
562
   "Save cluster state at the end of the processing to FILE",
563
   OptComplNone)
564

    
565
oSkipNonRedundant :: OptType
566
oSkipNonRedundant =
567
  (Option "" ["skip-non-redundant"]
568
   (NoArg (\ opts -> Ok opts { optSkipNonRedundant = True }))
569
    "Skip nodes that host a non-redundant instance",
570
    OptComplNone)
571

    
572
oStdSpec :: OptType
573
oStdSpec =
574
  (Option "" ["standard-alloc"]
575
   (ReqArg (\ inp opts -> do
576
              tspec <- parseISpecString "standard" inp
577
              return $ opts { optStdSpec = Just tspec } )
578
    "STDSPEC")
579
   "enable standard specs allocation, given as 'disk,ram,cpu'",
580
   OptComplString)
581

    
582
oTieredSpec :: OptType
583
oTieredSpec =
584
  (Option "" ["tiered-alloc"]
585
   (ReqArg (\ inp opts -> do
586
              tspec <- parseISpecString "tiered" inp
587
              return $ opts { optTieredSpec = Just tspec } )
588
    "TSPEC")
589
   "enable tiered specs allocation, given as 'disk,ram,cpu'",
590
   OptComplString)
591

    
592
oVerbose :: OptType
593
oVerbose =
594
  (Option "v" ["verbose"]
595
   (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
596
   "increase the verbosity level",
597
   OptComplNone)
598

    
599
oPriority :: OptType
600
oPriority =
601
  (Option "" ["priority"]
602
   (ReqArg (\ inp opts -> do
603
              prio <- parseSubmitPriority inp
604
              Ok opts { optPriority = Just prio }) "PRIO")
605
   "set the priority of submitted jobs",
606
    OptComplChoices (map fmtSubmitPriority [minBound..maxBound]))
607

    
608
-- | Generic options.
609
genericOpts :: [GenericOptType Options]
610
genericOpts =  [ oShowVer
611
               , oShowHelp
612
               , oShowComp
613
               ]
614

    
615
-- * Functions
616

    
617
-- | Wrapper over 'Common.parseOpts' with our custom options.
618
parseOpts :: [String]               -- ^ The command line arguments
619
          -> String                 -- ^ The program name
620
          -> [OptType]              -- ^ The supported command line options
621
          -> [ArgCompletion]        -- ^ The supported command line arguments
622
          -> IO (Options, [String]) -- ^ The resulting options and leftover
623
                                    -- arguments
624
parseOpts = Common.parseOpts defaultOptions
625

    
626

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

    
641
-- | Optionally print the node list.
642
maybePrintNodes :: Maybe [String]       -- ^ The field list
643
                -> String               -- ^ Informational message
644
                -> ([String] -> String) -- ^ Function to generate the listing
645
                -> IO ()
646
maybePrintNodes Nothing _ _ = return ()
647
maybePrintNodes (Just fields) msg fn = do
648
  hPutStrLn stderr ""
649
  hPutStrLn stderr (msg ++ " status:")
650
  hPutStrLn stderr $ fn fields
651

    
652
-- | Optionally print the instance list.
653
maybePrintInsts :: Bool   -- ^ Whether to print the instance list
654
                -> String -- ^ Type of the instance map (e.g. initial)
655
                -> String -- ^ The instance data
656
                -> IO ()
657
maybePrintInsts do_print msg instdata =
658
  when do_print $ do
659
    hPutStrLn stderr ""
660
    hPutStrLn stderr $ msg ++ " instance map:"
661
    hPutStr stderr instdata
662

    
663
-- | Function to display warning messages from parsing the cluster
664
-- state.
665
maybeShowWarnings :: [String] -- ^ The warning messages
666
                  -> IO ()
667
maybeShowWarnings fix_msgs =
668
  unless (null fix_msgs) $ do
669
    hPutStrLn stderr "Warning: cluster has inconsistent data:"
670
    hPutStrLn stderr . unlines . map (printf "  - %s") $ fix_msgs
671

    
672
-- | Format a list of key, value as a shell fragment.
673
printKeys :: String              -- ^ Prefix to printed variables
674
          -> [(String, String)]  -- ^ List of (key, value) pairs to be printed
675
          -> IO ()
676
printKeys prefix =
677
  mapM_ (\(k, v) ->
678
           printf "%s_%s=%s\n" prefix (map toUpper k) (ensureQuoted v))
679

    
680
-- | Prints the final @OK@ marker in machine readable output.
681
printFinal :: String    -- ^ Prefix to printed variable
682
           -> Bool      -- ^ Whether output should be machine readable;
683
                        -- note: if not, there is nothing to print
684
           -> IO ()
685
printFinal prefix True =
686
  -- this should be the final entry
687
  printKeys prefix [("OK", "1")]
688

    
689
printFinal _ False = return ()
690

    
691
-- | Potentially set the node as offline based on passed offline list.
692
setNodeOffline :: [Ndx] -> Node.Node -> Node.Node
693
setNodeOffline offline_indices n =
694
  if Node.idx n `elem` offline_indices
695
    then Node.setOffline n True
696
    else n
697

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

    
712
  unless (null offline_wrong) .
713
         exitErr $ printf "wrong node name(s) set as offline: %s\n"
714
                   (commaJoin (map lrContent offline_wrong))
715
  let setMCpuFn = case m_cpu of
716
                    Nothing -> id
717
                    Just new_mcpu -> flip Node.setMcpu new_mcpu
718
  let nm = Container.map (setNodeOffline offline_indices .
719
                          flip Node.setMdsk m_dsk .
720
                          setMCpuFn) fixed_nl
721
  return nm