Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / HTools / CLI.hs @ ad0e078e

History | View | Annotate | Download (19.8 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.HTools.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 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
  , parseOpts
34
  , parseOptsInner
35
  , parseYesNo
36
  , parseISpecString
37
  , shTemplate
38
  , defaultLuxiSocket
39
  , maybePrintNodes
40
  , maybePrintInsts
41
  , maybeShowWarnings
42
  , setNodeStatus
43
  -- * The options
44
  , oDataFile
45
  , oDiskMoves
46
  , oDiskTemplate
47
  , oDynuFile
48
  , oEvacMode
49
  , oExInst
50
  , oExTags
51
  , oExecJobs
52
  , oGroup
53
  , oInstMoves
54
  , oLuxiSocket
55
  , oMachineReadable
56
  , oMaxCpu
57
  , oMaxSolLength
58
  , oMinDisk
59
  , oMinGain
60
  , oMinGainLim
61
  , oMinScore
62
  , oNoHeaders
63
  , oNodeSim
64
  , oOfflineNode
65
  , oOutputDir
66
  , oPrintCommands
67
  , oPrintInsts
68
  , oPrintNodes
69
  , oQuiet
70
  , oRapiMaster
71
  , oReplay
72
  , oSaveCluster
73
  , oSelInst
74
  , oShowHelp
75
  , oShowVer
76
  , oStdSpec
77
  , oTieredSpec
78
  , oVerbose
79
  ) where
80

    
81
import Control.Monad
82
import Data.Maybe (fromMaybe)
83
import qualified Data.Version
84
import System.Console.GetOpt
85
import System.IO
86
import System.Info
87
import System.Exit
88
import Text.Printf (printf, hPrintf)
89

    
90
import qualified Ganeti.HTools.Version as Version(version)
91
import qualified Ganeti.HTools.Container as Container
92
import qualified Ganeti.HTools.Node as Node
93
import qualified Ganeti.Constants as C
94
import Ganeti.HTools.Types
95
import Ganeti.HTools.Utils
96
import Ganeti.HTools.Loader
97

    
98
-- * Constants
99

    
100
-- | The default value for the luxi socket.
101
--
102
-- This is re-exported from the "Ganeti.Constants" module.
103
defaultLuxiSocket :: FilePath
104
defaultLuxiSocket = C.masterSocket
105

    
106
-- * Data types
107

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

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

    
185
-- | Abrreviation for the option type.
186
type OptType = OptDescr (Options -> Result Options)
187

    
188
-- * Helper functions
189

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

    
205
-- * Command line options
206

    
207
oDataFile :: OptType
208
oDataFile = Option "t" ["text-data"]
209
            (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
210
            "the cluster data FILE"
211

    
212
oDiskMoves :: OptType
213
oDiskMoves = Option "" ["no-disk-moves"]
214
             (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
215
             "disallow disk moves from the list of allowed instance changes,\
216
             \ thus allowing only the 'cheap' failover/migrate operations"
217

    
218
oDiskTemplate :: OptType
219
oDiskTemplate = Option "" ["disk-template"]
220
                (ReqArg (\ t opts -> do
221
                           dt <- diskTemplateFromRaw t
222
                           return $ opts { optDiskTemplate = Just dt })
223
                 "TEMPLATE") "select the desired disk template"
224

    
225
oSelInst :: OptType
226
oSelInst = Option "" ["select-instances"]
227
          (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
228
          "only select given instances for any moves"
229

    
230
oInstMoves :: OptType
231
oInstMoves = Option "" ["no-instance-moves"]
232
             (NoArg (\ opts -> Ok opts { optInstMoves = False}))
233
             "disallow instance (primary node) moves from the list of allowed,\
234
             \ instance changes, thus allowing only slower, but sometimes\
235
             \ safer, drbd secondary changes"
236

    
237
oDynuFile :: OptType
238
oDynuFile = Option "U" ["dynu-file"]
239
            (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
240
            "Import dynamic utilisation data from the given FILE"
241

    
242
oEvacMode :: OptType
243
oEvacMode = Option "E" ["evac-mode"]
244
            (NoArg (\opts -> Ok opts { optEvacMode = True }))
245
            "enable evacuation mode, where the algorithm only moves \
246
            \ instances away from offline and drained nodes"
247

    
248
oExInst :: OptType
249
oExInst = Option "" ["exclude-instances"]
250
          (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
251
          "exclude given instances from any moves"
252

    
253
oExTags :: OptType
254
oExTags = Option "" ["exclusion-tags"]
255
            (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
256
             "TAG,...") "Enable instance exclusion based on given tag prefix"
257

    
258
oExecJobs :: OptType
259
oExecJobs = Option "X" ["exec"]
260
             (NoArg (\ opts -> Ok opts { optExecJobs = True}))
261
             "execute the suggested moves via Luxi (only available when using\
262
             \ it for data gathering)"
263

    
264
oGroup :: OptType
265
oGroup = Option "G" ["group"]
266
            (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
267
            "the ID of the group to balance"
268

    
269
oLuxiSocket :: OptType
270
oLuxiSocket = Option "L" ["luxi"]
271
              (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
272
                       fromMaybe defaultLuxiSocket) "SOCKET")
273
              "collect data via Luxi, optionally using the given SOCKET path"
274

    
275
oMachineReadable :: OptType
276
oMachineReadable = Option "" ["machine-readable"]
277
                   (OptArg (\ f opts -> do
278
                     flag <- parseYesNo True f
279
                     return $ opts { optMachineReadable = flag }) "CHOICE")
280
          "enable machine readable output (pass either 'yes' or 'no' to\
281
          \ explicitely control the flag, or without an argument defaults to\
282
          \ yes"
283

    
284
oMaxCpu :: OptType
285
oMaxCpu = Option "" ["max-cpu"]
286
          (ReqArg (\ n opts -> Ok opts { optMcpu = read n }) "RATIO")
287
          "maximum virtual-to-physical cpu ratio for nodes (from 1\
288
          \ upwards) [64]"
289

    
290
oMaxSolLength :: OptType
291
oMaxSolLength = Option "l" ["max-length"]
292
                (ReqArg (\ i opts -> Ok opts { optMaxLength = read i }) "N")
293
                "cap the solution at this many balancing or allocation \
294
                \ rounds (useful for very unbalanced clusters or empty \
295
                \ clusters)"
296

    
297
oMinDisk :: OptType
298
oMinDisk = Option "" ["min-disk"]
299
           (ReqArg (\ n opts -> Ok opts { optMdsk = read n }) "RATIO")
300
           "minimum free disk space for nodes (between 0 and 1) [0]"
301

    
302
oMinGain :: OptType
303
oMinGain = Option "g" ["min-gain"]
304
            (ReqArg (\ g opts -> Ok opts { optMinGain = read g }) "DELTA")
305
            "minimum gain to aim for in a balancing step before giving up"
306

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

    
312
oMinScore :: OptType
313
oMinScore = Option "e" ["min-score"]
314
            (ReqArg (\ e opts -> Ok opts { optMinScore = read e }) "EPSILON")
315
            "mininum score to aim for"
316

    
317
oNoHeaders :: OptType
318
oNoHeaders = Option "" ["no-headers"]
319
             (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
320
             "do not show a header line"
321

    
322
oNodeSim :: OptType
323
oNodeSim = Option "" ["simulate"]
324
            (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
325
            "simulate an empty cluster, given as 'num_nodes,disk,ram,cpu'"
326

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

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

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

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

    
351
oPrintNodes :: OptType
352
oPrintNodes = Option "p" ["print-nodes"]
353
              (OptArg ((\ f opts ->
354
                          let (prefix, realf) = case f of
355
                                                  '+':rest -> (["+"], rest)
356
                                                  _ -> ([], f)
357
                              splitted = prefix ++ sepSplit ',' realf
358
                          in Ok opts { optShowNodes = Just splitted }) .
359
                       fromMaybe []) "FIELDS")
360
              "print the final node list"
361

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

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

    
372
oSaveCluster :: OptType
373
oSaveCluster = Option "S" ["save"]
374
            (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
375
            "Save cluster state at the end of the processing to FILE"
376

    
377
oShowHelp :: OptType
378
oShowHelp = Option "h" ["help"]
379
            (NoArg (\ opts -> Ok opts { optShowHelp = True}))
380
            "show help"
381

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

    
387
oStdSpec :: OptType
388
oStdSpec = Option "" ["standard-alloc"]
389
             (ReqArg (\ inp opts -> do
390
                        tspec <- parseISpecString "standard" inp
391
                        return $ opts { optStdSpec = Just tspec } )
392
              "STDSPEC")
393
             "enable standard specs allocation, given as 'disk,ram,cpu'"
394

    
395
oTieredSpec :: OptType
396
oTieredSpec = Option "" ["tiered-alloc"]
397
             (ReqArg (\ inp opts -> do
398
                        tspec <- parseISpecString "tiered" inp
399
                        return $ opts { optTieredSpec = Just tspec } )
400
              "TSPEC")
401
             "enable tiered specs allocation, given as 'disk,ram,cpu'"
402

    
403
oReplay :: OptType
404
oReplay = Option "" ["replay"]
405
          (ReqArg (\ stat opts -> Ok opts { optReplay = Just stat } ) "STATE")
406
          "Pre-seed the random number generator with STATE"
407

    
408
oVerbose :: OptType
409
oVerbose = Option "v" ["verbose"]
410
           (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
411
           "increase the verbosity level"
412

    
413
-- * Functions
414

    
415
-- | Helper for parsing a yes\/no command line flag.
416
parseYesNo :: Bool         -- ^ Default value (when we get a @Nothing@)
417
           -> Maybe String -- ^ Parameter value
418
           -> Result Bool  -- ^ Resulting boolean value
419
parseYesNo v Nothing      = return v
420
parseYesNo _ (Just "yes") = return True
421
parseYesNo _ (Just "no")  = return False
422
parseYesNo _ (Just s)     = fail ("Invalid choice '" ++ s ++
423
                                  "', pass one of 'yes' or 'no'")
424

    
425
-- | Usage info.
426
usageHelp :: String -> [OptType] -> String
427
usageHelp progname =
428
  usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
429
             progname Version.version progname)
430

    
431
-- | Show the program version info.
432
versionInfo :: String -> String
433
versionInfo progname =
434
  printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
435
         progname Version.version compilerName
436
         (Data.Version.showVersion compilerVersion)
437
         os arch
438

    
439
-- | Command line parser, using the 'Options' structure.
440
parseOpts :: [String]               -- ^ The command line arguments
441
          -> String                 -- ^ The program name
442
          -> [OptType]              -- ^ The supported command line options
443
          -> IO (Options, [String]) -- ^ The resulting options and leftover
444
                                    -- arguments
445
parseOpts argv progname options =
446
  case parseOptsInner argv progname options of
447
    Left (code, msg) -> do
448
      hPutStr (if code == 0 then stdout else stderr) msg
449
      exitWith (if code == 0 then ExitSuccess else ExitFailure code)
450
    Right result ->
451
      return result
452

    
453
-- | Inner parse options. The arguments are similar to 'parseOpts',
454
-- but it returns either a 'Left' composed of exit code and message,
455
-- or a 'Right' for the success case.
456
parseOptsInner :: [String] -> String -> [OptType]
457
               -> Either (Int, String) (Options, [String])
458
parseOptsInner argv progname options =
459
  case getOpt Permute options argv of
460
    (o, n, []) ->
461
      let (pr, args) = (foldM (flip id) defaultOptions o, n)
462
      in case pr of
463
           Bad msg -> Left (1, "Error while parsing command\
464
                               \line arguments:\n" ++ msg ++ "\n")
465
           Ok po ->
466
             select (Right (po, args))
467
                 [ (optShowHelp po, Left (0, usageHelp progname options))
468
                 , (optShowVer po,  Left (0, versionInfo progname))
469
                 ]
470
    (_, _, errs) ->
471
      Left (2, "Command line error: "  ++ concat errs ++ "\n" ++
472
            usageHelp progname options)
473

    
474
-- | A shell script template for autogenerated scripts.
475
shTemplate :: String
476
shTemplate =
477
  printf "#!/bin/sh\n\n\
478
         \# Auto-generated script for executing cluster rebalancing\n\n\
479
         \# To stop, touch the file /tmp/stop-htools\n\n\
480
         \set -e\n\n\
481
         \check() {\n\
482
         \  if [ -f /tmp/stop-htools ]; then\n\
483
         \    echo 'Stop requested, exiting'\n\
484
         \    exit 0\n\
485
         \  fi\n\
486
         \}\n\n"
487

    
488
-- | Optionally print the node list.
489
maybePrintNodes :: Maybe [String]       -- ^ The field list
490
                -> String               -- ^ Informational message
491
                -> ([String] -> String) -- ^ Function to generate the listing
492
                -> IO ()
493
maybePrintNodes Nothing _ _ = return ()
494
maybePrintNodes (Just fields) msg fn = do
495
  hPutStrLn stderr ""
496
  hPutStrLn stderr (msg ++ " status:")
497
  hPutStrLn stderr $ fn fields
498

    
499

    
500
-- | Optionally print the instance list.
501
maybePrintInsts :: Bool   -- ^ Whether to print the instance list
502
                -> String -- ^ Type of the instance map (e.g. initial)
503
                -> String -- ^ The instance data
504
                -> IO ()
505
maybePrintInsts do_print msg instdata =
506
  when do_print $ do
507
    hPutStrLn stderr ""
508
    hPutStrLn stderr $ msg ++ " instance map:"
509
    hPutStr stderr instdata
510

    
511
-- | Function to display warning messages from parsing the cluster
512
-- state.
513
maybeShowWarnings :: [String] -- ^ The warning messages
514
                  -> IO ()
515
maybeShowWarnings fix_msgs =
516
  unless (null fix_msgs) $ do
517
    hPutStrLn stderr "Warning: cluster has inconsistent data:"
518
    hPutStrLn stderr . unlines . map (printf "  - %s") $ fix_msgs
519

    
520
-- | Set node properties based on command line options.
521
setNodeStatus :: Options -> Node.List -> IO Node.List
522
setNodeStatus opts fixed_nl = do
523
  let offline_passed = optOffline opts
524
      all_nodes = Container.elems fixed_nl
525
      offline_lkp = map (lookupName (map Node.name all_nodes)) offline_passed
526
      offline_wrong = filter (not . goodLookupResult) offline_lkp
527
      offline_names = map lrContent offline_lkp
528
      offline_indices = map Node.idx $
529
                        filter (\n -> Node.name n `elem` offline_names)
530
                               all_nodes
531
      m_cpu = optMcpu opts
532
      m_dsk = optMdsk opts
533

    
534
  unless (null offline_wrong) $ do
535
         hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
536
                     (commaJoin (map lrContent offline_wrong)) :: IO ()
537
         exitWith $ ExitFailure 1
538

    
539
  let nm = Container.map (\n -> if Node.idx n `elem` offline_indices
540
                                then Node.setOffline n True
541
                                else n) fixed_nl
542
      nlf = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
543
            nm
544
  return nlf