CLI.hs 21 KB
Newer Older
1
2
{-| Implementation of command-line functions.

3
4
5
This module holds the common command-line related functions for the
binaries, separated into this module since "Ganeti.HTools.Utils" is
used in many other places and this is more IO oriented.
6
7
8

-}

Iustin Pop's avatar
Iustin Pop committed
9
10
{-

11
Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
Iustin Pop's avatar
Iustin Pop committed
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

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

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

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

-}

30
module Ganeti.HTools.CLI
Iustin Pop's avatar
Iustin Pop committed
31
32
33
  ( Options(..)
  , OptType
  , parseOpts
34
  , parseOptsInner
Iustin Pop's avatar
Iustin Pop committed
35
  , parseYesNo
36
  , parseISpecString
Iustin Pop's avatar
Iustin Pop committed
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
  , shTemplate
  , defaultLuxiSocket
  , maybePrintNodes
  , maybePrintInsts
  , maybeShowWarnings
  , setNodeStatus
  -- * The options
  , oDataFile
  , oDiskMoves
  , oDiskTemplate
  , oDynuFile
  , oEvacMode
  , oExInst
  , oExTags
  , oExecJobs
  , oGroup
53
  , oIAllocSrc
Iustin Pop's avatar
Iustin Pop committed
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
  , oInstMoves
  , oLuxiSocket
  , oMachineReadable
  , oMaxCpu
  , oMaxSolLength
  , oMinDisk
  , oMinGain
  , oMinGainLim
  , oMinScore
  , oNoHeaders
  , oNodeSim
  , oOfflineNode
  , oOutputDir
  , oPrintCommands
  , oPrintInsts
  , oPrintNodes
  , oQuiet
  , oRapiMaster
  , oReplay
  , oSaveCluster
  , oSelInst
  , oShowHelp
  , oShowVer
77
  , oStdSpec
78
  , oTestCount
Iustin Pop's avatar
Iustin Pop committed
79
80
81
  , oTieredSpec
  , oVerbose
  ) where
82

Iustin Pop's avatar
Iustin Pop committed
83
import Control.Monad
84
import Data.Maybe (fromMaybe)
85
import qualified Data.Version
86
87
88
import System.Console.GetOpt
import System.IO
import System.Info
89
import System.Exit
Iustin Pop's avatar
Iustin Pop committed
90
import Text.Printf (printf, hPrintf)
91
92

import qualified Ganeti.HTools.Version as Version(version)
Iustin Pop's avatar
Iustin Pop committed
93
94
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Node as Node
Iustin Pop's avatar
Iustin Pop committed
95
import qualified Ganeti.Constants as C
96
import Ganeti.HTools.Types
97
import Ganeti.HTools.Utils
Iustin Pop's avatar
Iustin Pop committed
98
import Ganeti.HTools.Loader
99

100
101
102
103
104
-- * Constants

-- | The default value for the luxi socket.
--
-- This is re-exported from the "Ganeti.Constants" module.
105
defaultLuxiSocket :: FilePath
Iustin Pop's avatar
Iustin Pop committed
106
defaultLuxiSocket = C.masterSocket
107

108
109
-- * Data types

110
111
-- | Command line options structure.
data Options = Options
Iustin Pop's avatar
Iustin Pop committed
112
113
114
  { optDataFile    :: Maybe FilePath -- ^ Path to the cluster data file
  , optDiskMoves   :: Bool           -- ^ Allow disk moves
  , optInstMoves   :: Bool           -- ^ Allow instance moves
115
  , optDiskTemplate :: Maybe DiskTemplate  -- ^ Override for the disk template
Iustin Pop's avatar
Iustin Pop committed
116
117
118
119
120
121
  , optDynuFile    :: Maybe FilePath -- ^ Optional file with dynamic use data
  , optEvacMode    :: Bool           -- ^ Enable evacuation mode
  , optExInst      :: [String]       -- ^ Instances to be excluded
  , optExTags      :: Maybe [String] -- ^ Tags to use for exclusion
  , optExecJobs    :: Bool           -- ^ Execute the commands via Luxi
  , optGroup       :: Maybe GroupID  -- ^ The UUID of the group to process
122
  , optIAllocSrc   :: Maybe FilePath -- ^ The iallocation spec
Iustin Pop's avatar
Iustin Pop committed
123
124
125
126
127
  , optSelInst     :: [String]       -- ^ Instances to be excluded
  , optLuxi        :: Maybe FilePath -- ^ Collect data from Luxi
  , optMachineReadable :: Bool       -- ^ Output machine-readable format
  , optMaster      :: String         -- ^ Collect data from RAPI
  , optMaxLength   :: Int            -- ^ Stop after this many steps
128
  , optMcpu        :: Maybe Double   -- ^ Override max cpu ratio for nodes
Iustin Pop's avatar
Iustin Pop committed
129
130
131
132
133
134
135
136
137
138
139
140
141
142
  , optMdsk        :: Double         -- ^ Max disk usage ratio for nodes
  , optMinGain     :: Score          -- ^ Min gain we aim for in a step
  , optMinGainLim  :: Score          -- ^ Limit below which we apply mingain
  , optMinScore    :: Score          -- ^ The minimum score we aim for
  , optNoHeaders   :: Bool           -- ^ Do not show a header line
  , optNodeSim     :: [String]       -- ^ Cluster simulation mode
  , optOffline     :: [String]       -- ^ Names of offline nodes
  , optOutPath     :: FilePath       -- ^ Path to the output directory
  , optSaveCluster :: Maybe FilePath -- ^ Save cluster state to this file
  , optShowCmds    :: Maybe FilePath -- ^ Whether to show the command list
  , optShowHelp    :: Bool           -- ^ Just show the help
  , optShowInsts   :: Bool           -- ^ Whether to show the instance map
  , optShowNodes   :: Maybe [String] -- ^ Whether to show node status
  , optShowVer     :: Bool           -- ^ Just show the program version
143
  , optStdSpec     :: Maybe RSpec    -- ^ Requested standard specs
144
  , optTestCount   :: Maybe Int      -- ^ Optional test count override
Iustin Pop's avatar
Iustin Pop committed
145
146
147
148
  , optTieredSpec  :: Maybe RSpec    -- ^ Requested specs for tiered mode
  , optReplay      :: Maybe String   -- ^ Unittests: RNG state
  , optVerbose     :: Int            -- ^ Verbosity level
  } deriving Show
149
150
151
152

-- | Default values for the command line options.
defaultOptions :: Options
defaultOptions  = Options
Iustin Pop's avatar
Iustin Pop committed
153
154
155
  { optDataFile    = Nothing
  , optDiskMoves   = True
  , optInstMoves   = True
156
  , optDiskTemplate = Nothing
Iustin Pop's avatar
Iustin Pop committed
157
158
159
160
161
162
  , optDynuFile    = Nothing
  , optEvacMode    = False
  , optExInst      = []
  , optExTags      = Nothing
  , optExecJobs    = False
  , optGroup       = Nothing
163
  , optIAllocSrc   = Nothing
Iustin Pop's avatar
Iustin Pop committed
164
165
166
167
168
  , optSelInst     = []
  , optLuxi        = Nothing
  , optMachineReadable = False
  , optMaster      = ""
  , optMaxLength   = -1
169
  , optMcpu        = Nothing
Iustin Pop's avatar
Iustin Pop committed
170
171
172
173
174
175
176
177
178
179
180
181
182
183
  , optMdsk        = defReservedDiskRatio
  , optMinGain     = 1e-2
  , optMinGainLim  = 1e-1
  , optMinScore    = 1e-9
  , optNoHeaders   = False
  , optNodeSim     = []
  , optOffline     = []
  , optOutPath     = "."
  , optSaveCluster = Nothing
  , optShowCmds    = Nothing
  , optShowHelp    = False
  , optShowInsts   = False
  , optShowNodes   = Nothing
  , optShowVer     = False
184
  , optStdSpec     = Nothing
185
  , optTestCount   = Nothing
Iustin Pop's avatar
Iustin Pop committed
186
187
188
189
  , optTieredSpec  = Nothing
  , optReplay      = Nothing
  , optVerbose     = 1
  }
190

191
-- | Abrreviation for the option type.
192
type OptType = OptDescr (Options -> Result Options)
193

194
195
196
197
198
-- * Helper functions

parseISpecString :: String -> String -> Result RSpec
parseISpecString descr inp = do
  let sp = sepSplit ',' inp
199
200
201
      err = Bad ("Invalid " ++ descr ++ " specification: '" ++ inp ++
                 "', expected disk,ram,cpu")
  when (length sp /= 3) err
202
  prs <- mapM (\(fn, val) -> fn val) $
203
204
         zip [ annotateResult (descr ++ " specs disk") . parseUnit
             , annotateResult (descr ++ " specs memory") . parseUnit
205
206
207
208
             , tryRead (descr ++ " specs cpus")
             ] sp
  case prs of
    [dsk, ram, cpu] -> return $ RSpec cpu ram dsk
209
    _ -> err
210

211
212
-- * Command line options

213
214
215
216
oDataFile :: OptType
oDataFile = Option "t" ["text-data"]
            (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
            "the cluster data FILE"
217

Iustin Pop's avatar
Iustin Pop committed
218
219
220
221
222
oDiskMoves :: OptType
oDiskMoves = Option "" ["no-disk-moves"]
             (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
             "disallow disk moves from the list of allowed instance changes,\
             \ thus allowing only the 'cheap' failover/migrate operations"
223

224
225
226
oDiskTemplate :: OptType
oDiskTemplate = Option "" ["disk-template"]
                (ReqArg (\ t opts -> do
227
                           dt <- diskTemplateFromRaw t
228
229
                           return $ opts { optDiskTemplate = Just dt })
                 "TEMPLATE") "select the desired disk template"
230

231
232
233
234
235
oSelInst :: OptType
oSelInst = Option "" ["select-instances"]
          (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
          "only select given instances for any moves"

236
237
238
239
240
241
242
oInstMoves :: OptType
oInstMoves = Option "" ["no-instance-moves"]
             (NoArg (\ opts -> Ok opts { optInstMoves = False}))
             "disallow instance (primary node) moves from the list of allowed,\
             \ instance changes, thus allowing only slower, but sometimes\
             \ safer, drbd secondary changes"

Iustin Pop's avatar
Iustin Pop committed
243
244
245
246
oDynuFile :: OptType
oDynuFile = Option "U" ["dynu-file"]
            (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
            "Import dynamic utilisation data from the given FILE"
247

Iustin Pop's avatar
Iustin Pop committed
248
249
250
251
252
253
oEvacMode :: OptType
oEvacMode = Option "E" ["evac-mode"]
            (NoArg (\opts -> Ok opts { optEvacMode = True }))
            "enable evacuation mode, where the algorithm only moves \
            \ instances away from offline and drained nodes"

254
255
256
oExInst :: OptType
oExInst = Option "" ["exclude-instances"]
          (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
257
          "exclude given instances from any moves"
258

Iustin Pop's avatar
Iustin Pop committed
259
260
261
262
oExTags :: OptType
oExTags = Option "" ["exclusion-tags"]
            (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
             "TAG,...") "Enable instance exclusion based on given tag prefix"
263

264
265
oExecJobs :: OptType
oExecJobs = Option "X" ["exec"]
266
             (NoArg (\ opts -> Ok opts { optExecJobs = True}))
267
             "execute the suggested moves via Luxi (only available when using\
268
             \ it for data gathering)"
269

270
271
272
273
274
oGroup :: OptType
oGroup = Option "G" ["group"]
            (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
            "the ID of the group to balance"

275
276
277
278
279
oIAllocSrc :: OptType
oIAllocSrc = Option "I" ["ialloc-src"]
             (ReqArg (\ f opts -> Ok opts { optIAllocSrc = Just f }) "FILE")
             "Specify an iallocator spec as the cluster data source"

Iustin Pop's avatar
Iustin Pop committed
280
281
282
283
284
oLuxiSocket :: OptType
oLuxiSocket = Option "L" ["luxi"]
              (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
                       fromMaybe defaultLuxiSocket) "SOCKET")
              "collect data via Luxi, optionally using the given SOCKET path"
285

286
287
oMachineReadable :: OptType
oMachineReadable = Option "" ["machine-readable"]
Iustin Pop's avatar
Iustin Pop committed
288
                   (OptArg (\ f opts -> do
289
290
291
292
293
294
                     flag <- parseYesNo True f
                     return $ opts { optMachineReadable = flag }) "CHOICE")
          "enable machine readable output (pass either 'yes' or 'no' to\
          \ explicitely control the flag, or without an argument defaults to\
          \ yes"

295
296
oMaxCpu :: OptType
oMaxCpu = Option "" ["max-cpu"]
297
298
299
300
301
302
303
304
          (ReqArg (\ n opts -> do
                     mcpu <- tryRead "parsing max-cpu" n
                     when (mcpu <= 0) $
                          fail "Invalid value of the max-cpu ratio,\
                               \ expected >0"
                     return $ opts { optMcpu = Just mcpu }) "RATIO")
          "maximum virtual-to-physical cpu ratio for nodes (from 0\
          \ upwards) [default read from cluster]"
305

Iustin Pop's avatar
Iustin Pop committed
306
307
308
oMaxSolLength :: OptType
oMaxSolLength = Option "l" ["max-length"]
                (ReqArg (\ i opts -> Ok opts { optMaxLength = read i }) "N")
Iustin Pop's avatar
Iustin Pop committed
309
310
311
                "cap the solution at this many balancing or allocation \
                \ rounds (useful for very unbalanced clusters or empty \
                \ clusters)"
Iustin Pop's avatar
Iustin Pop committed
312

313
314
oMinDisk :: OptType
oMinDisk = Option "" ["min-disk"]
315
           (ReqArg (\ n opts -> Ok opts { optMdsk = read n }) "RATIO")
316
           "minimum free disk space for nodes (between 0 and 1) [0]"
317

318
319
320
321
322
323
324
325
326
327
oMinGain :: OptType
oMinGain = Option "g" ["min-gain"]
            (ReqArg (\ g opts -> Ok opts { optMinGain = read g }) "DELTA")
            "minimum gain to aim for in a balancing step before giving up"

oMinGainLim :: OptType
oMinGainLim = Option "" ["min-gain-limit"]
            (ReqArg (\ g opts -> Ok opts { optMinGainLim = read g }) "SCORE")
            "minimum cluster score for which we start checking the min-gain"

Iustin Pop's avatar
Iustin Pop committed
328
329
330
oMinScore :: OptType
oMinScore = Option "e" ["min-score"]
            (ReqArg (\ e opts -> Ok opts { optMinScore = read e }) "EPSILON")
331
            "mininum score to aim for"
332

Iustin Pop's avatar
Iustin Pop committed
333
334
335
336
oNoHeaders :: OptType
oNoHeaders = Option "" ["no-headers"]
             (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
             "do not show a header line"
337

Iustin Pop's avatar
Iustin Pop committed
338
339
oNodeSim :: OptType
oNodeSim = Option "" ["simulate"]
340
            (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
Iustin Pop's avatar
Iustin Pop committed
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
            "simulate an empty cluster, given as 'num_nodes,disk,ram,cpu'"

oOfflineNode :: OptType
oOfflineNode = Option "O" ["offline"]
               (ReqArg (\ n o -> Ok o { optOffline = n:optOffline o }) "NODE")
               "set node as offline"

oOutputDir :: OptType
oOutputDir = Option "d" ["output-dir"]
             (ReqArg (\ d opts -> Ok opts { optOutPath = d }) "PATH")
             "directory in which to write output files"

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

oPrintInsts :: OptType
oPrintInsts = Option "" ["print-instances"]
              (NoArg (\ opts -> Ok opts { optShowInsts = True }))
              "print the final instance map"

oPrintNodes :: OptType
oPrintNodes = Option "p" ["print-nodes"]
              (OptArg ((\ f opts ->
Iustin Pop's avatar
Iustin Pop committed
370
371
372
373
374
                          let (prefix, realf) = case f of
                                                  '+':rest -> (["+"], rest)
                                                  _ -> ([], f)
                              splitted = prefix ++ sepSplit ',' realf
                          in Ok opts { optShowNodes = Just splitted }) .
Iustin Pop's avatar
Iustin Pop committed
375
376
377
378
379
380
381
382
383
384
385
386
387
                       fromMaybe []) "FIELDS")
              "print the final node list"

oQuiet :: OptType
oQuiet = Option "q" ["quiet"]
         (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts - 1 }))
         "decrease the verbosity level"

oRapiMaster :: OptType
oRapiMaster = Option "m" ["master"]
              (ReqArg (\ m opts -> Ok opts { optMaster = m }) "ADDRESS")
              "collect data via RAPI at the given ADDRESS"

Iustin Pop's avatar
Iustin Pop committed
388
389
390
391
392
oSaveCluster :: OptType
oSaveCluster = Option "S" ["save"]
            (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
            "Save cluster state at the end of the processing to FILE"

Iustin Pop's avatar
Iustin Pop committed
393
394
395
396
397
398
399
400
401
oShowHelp :: OptType
oShowHelp = Option "h" ["help"]
            (NoArg (\ opts -> Ok opts { optShowHelp = True}))
            "show help"

oShowVer :: OptType
oShowVer = Option "V" ["version"]
           (NoArg (\ opts -> Ok opts { optShowVer = True}))
           "show the version of the program"
402

403
404
405
406
oStdSpec :: OptType
oStdSpec = Option "" ["standard-alloc"]
             (ReqArg (\ inp opts -> do
                        tspec <- parseISpecString "standard" inp
407
                        return $ opts { optStdSpec = Just tspec } )
408
409
410
              "STDSPEC")
             "enable standard specs allocation, given as 'disk,ram,cpu'"

411
412
413
414
415
416
417
418
oTestCount :: OptType
oTestCount = Option "" ["test-count"]
             (ReqArg (\ inp opts -> do
                        tcount <- tryRead "parsing test count" inp
                        return $ opts { optTestCount = Just tcount } )
              "COUNT")
             "override the target test count"

419
420
421
oTieredSpec :: OptType
oTieredSpec = Option "" ["tiered-alloc"]
             (ReqArg (\ inp opts -> do
422
                        tspec <- parseISpecString "tiered" inp
Iustin Pop's avatar
Iustin Pop committed
423
                        return $ opts { optTieredSpec = Just tspec } )
424
              "TSPEC")
425
             "enable tiered specs allocation, given as 'disk,ram,cpu'"
426

427
428
429
430
431
oReplay :: OptType
oReplay = Option "" ["replay"]
          (ReqArg (\ stat opts -> Ok opts { optReplay = Just stat } ) "STATE")
          "Pre-seed the random number generator with STATE"

Iustin Pop's avatar
Iustin Pop committed
432
433
434
435
oVerbose :: OptType
oVerbose = Option "v" ["verbose"]
           (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
           "increase the verbosity level"
436

437
438
-- * Functions

439
-- | Helper for parsing a yes\/no command line flag.
Iustin Pop's avatar
Iustin Pop committed
440
parseYesNo :: Bool         -- ^ Default value (when we get a @Nothing@)
441
442
443
444
445
           -> Maybe String -- ^ Parameter value
           -> Result Bool  -- ^ Resulting boolean value
parseYesNo v Nothing      = return v
parseYesNo _ (Just "yes") = return True
parseYesNo _ (Just "no")  = return False
Iustin Pop's avatar
Iustin Pop committed
446
447
parseYesNo _ (Just s)     = fail ("Invalid choice '" ++ s ++
                                  "', pass one of 'yes' or 'no'")
448

449
-- | Usage info.
450
usageHelp :: String -> [OptType] -> String
Iustin Pop's avatar
Iustin Pop committed
451
usageHelp progname =
Iustin Pop's avatar
Iustin Pop committed
452
453
  usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
             progname Version.version progname)
454

455
456
457
458
459
460
461
462
-- | Show the program version info.
versionInfo :: String -> String
versionInfo progname =
  printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
         progname Version.version compilerName
         (Data.Version.showVersion compilerVersion)
         os arch

463
-- | Command line parser, using the 'Options' structure.
464
465
466
467
468
469
parseOpts :: [String]               -- ^ The command line arguments
          -> String                 -- ^ The program name
          -> [OptType]              -- ^ The supported command line options
          -> IO (Options, [String]) -- ^ The resulting options and leftover
                                    -- arguments
parseOpts argv progname options =
470
471
472
473
474
475
476
477
478
479
480
481
482
  case parseOptsInner argv progname options of
    Left (code, msg) -> do
      hPutStr (if code == 0 then stdout else stderr) msg
      exitWith (if code == 0 then ExitSuccess else ExitFailure code)
    Right result ->
      return result

-- | Inner parse options. The arguments are similar to 'parseOpts',
-- but it returns either a 'Left' composed of exit code and message,
-- or a 'Right' for the success case.
parseOptsInner :: [String] -> String -> [OptType]
               -> Either (Int, String) (Options, [String])
parseOptsInner argv progname options =
Iustin Pop's avatar
Iustin Pop committed
483
484
  case getOpt Permute options argv of
    (o, n, []) ->
485
486
487
488
489
490
491
492
493
494
495
496
      let (pr, args) = (foldM (flip id) defaultOptions o, n)
      in case pr of
           Bad msg -> Left (1, "Error while parsing command\
                               \line arguments:\n" ++ msg ++ "\n")
           Ok po ->
             select (Right (po, args))
                 [ (optShowHelp po, Left (0, usageHelp progname options))
                 , (optShowVer po,  Left (0, versionInfo progname))
                 ]
    (_, _, errs) ->
      Left (2, "Command line error: "  ++ concat errs ++ "\n" ++
            usageHelp progname options)
497

Iustin Pop's avatar
Iustin Pop committed
498
-- | A shell script template for autogenerated scripts.
499
500
shTemplate :: String
shTemplate =
Iustin Pop's avatar
Iustin Pop committed
501
502
503
504
505
506
507
508
509
510
  printf "#!/bin/sh\n\n\
         \# Auto-generated script for executing cluster rebalancing\n\n\
         \# To stop, touch the file /tmp/stop-htools\n\n\
         \set -e\n\n\
         \check() {\n\
         \  if [ -f /tmp/stop-htools ]; then\n\
         \    echo 'Stop requested, exiting'\n\
         \    exit 0\n\
         \  fi\n\
         \}\n\n"
511
512
513
514
515
516
517
518
519
520
521

-- | Optionally print the node list.
maybePrintNodes :: Maybe [String]       -- ^ The field list
                -> String               -- ^ Informational message
                -> ([String] -> String) -- ^ Function to generate the listing
                -> IO ()
maybePrintNodes Nothing _ _ = return ()
maybePrintNodes (Just fields) msg fn = do
  hPutStrLn stderr ""
  hPutStrLn stderr (msg ++ " status:")
  hPutStrLn stderr $ fn fields
522
523
524
525
526
527
528
529
530
531
532
533


-- | Optionally print the instance list.
maybePrintInsts :: Bool   -- ^ Whether to print the instance list
                -> String -- ^ Type of the instance map (e.g. initial)
                -> String -- ^ The instance data
                -> IO ()
maybePrintInsts do_print msg instdata =
  when do_print $ do
    hPutStrLn stderr ""
    hPutStrLn stderr $ msg ++ " instance map:"
    hPutStr stderr instdata
534
535
536
537
538
539
540
541
542

-- | Function to display warning messages from parsing the cluster
-- state.
maybeShowWarnings :: [String] -- ^ The warning messages
                  -> IO ()
maybeShowWarnings fix_msgs =
  unless (null fix_msgs) $ do
    hPutStrLn stderr "Warning: cluster has inconsistent data:"
    hPutStrLn stderr . unlines . map (printf "  - %s") $ fix_msgs
Iustin Pop's avatar
Iustin Pop committed
543

544
545
546
547
548
549
550
-- | Potentially set the node as offline based on passed offline list.
setNodeOffline :: [Ndx] -> Node.Node -> Node.Node
setNodeOffline offline_indices n =
  if Node.idx n `elem` offline_indices
    then Node.setOffline n True
    else n

Iustin Pop's avatar
Iustin Pop committed
551
552
553
554
555
556
557
558
559
560
561
562
563
564
-- | Set node properties based on command line options.
setNodeStatus :: Options -> Node.List -> IO Node.List
setNodeStatus opts fixed_nl = do
  let offline_passed = optOffline opts
      all_nodes = Container.elems fixed_nl
      offline_lkp = map (lookupName (map Node.name all_nodes)) offline_passed
      offline_wrong = filter (not . goodLookupResult) offline_lkp
      offline_names = map lrContent offline_lkp
      offline_indices = map Node.idx $
                        filter (\n -> Node.name n `elem` offline_names)
                               all_nodes
      m_cpu = optMcpu opts
      m_dsk = optMdsk opts

Iustin Pop's avatar
Iustin Pop committed
565
  unless (null offline_wrong) $ do
Iustin Pop's avatar
Iustin Pop committed
566
567
568
         hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
                     (commaJoin (map lrContent offline_wrong)) :: IO ()
         exitWith $ ExitFailure 1
569
570
571
572
573
574
575
  let setMCpuFn = case m_cpu of
                    Nothing -> id
                    Just new_mcpu -> flip Node.setMcpu new_mcpu
  let nm = Container.map (setNodeOffline offline_indices .
                          flip Node.setMdsk m_dsk .
                          setMCpuFn) fixed_nl
  return nm