Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / HTools / CLI.hs @ 1b0a6356

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

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

    
89
import qualified Ganeti.HTools.Version as Version(version)
90
import qualified Ganeti.Constants as C
91
import Ganeti.HTools.Types
92
import Ganeti.HTools.Utils
93

    
94
-- * Constants
95

    
96
-- | The default value for the luxi socket.
97
--
98
-- This is re-exported from the "Ganeti.Constants" module.
99
defaultLuxiSocket :: FilePath
100
defaultLuxiSocket = C.masterSocket
101

    
102
-- * Data types
103

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

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

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

    
186
-- * Command line options
187

    
188
oDataFile :: OptType
189
oDataFile = Option "t" ["text-data"]
190
            (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
191
            "the cluster data FILE"
192

    
193
oDiskMoves :: OptType
194
oDiskMoves = Option "" ["no-disk-moves"]
195
             (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
196
             "disallow disk moves from the list of allowed instance changes,\
197
             \ thus allowing only the 'cheap' failover/migrate operations"
198

    
199
oDiskTemplate :: OptType
200
oDiskTemplate = Option "" ["disk-template"]
201
                (ReqArg (\ t opts -> do
202
                           dt <- dtFromString t
203
                           return $ opts { optDiskTemplate = dt }) "TEMPLATE")
204
                "select the desired disk template"
205

    
206
oSelInst :: OptType
207
oSelInst = Option "" ["select-instances"]
208
          (ReqArg (\ f opts -> Ok opts { optSelInst = sepSplit ',' f }) "INSTS")
209
          "only select given instances for any moves"
210

    
211
oInstMoves :: OptType
212
oInstMoves = Option "" ["no-instance-moves"]
213
             (NoArg (\ opts -> Ok opts { optInstMoves = False}))
214
             "disallow instance (primary node) moves from the list of allowed,\
215
             \ instance changes, thus allowing only slower, but sometimes\
216
             \ safer, drbd secondary changes"
217

    
218
oDynuFile :: OptType
219
oDynuFile = Option "U" ["dynu-file"]
220
            (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
221
            "Import dynamic utilisation data from the given FILE"
222

    
223
oEvacMode :: OptType
224
oEvacMode = Option "E" ["evac-mode"]
225
            (NoArg (\opts -> Ok opts { optEvacMode = True }))
226
            "enable evacuation mode, where the algorithm only moves \
227
            \ instances away from offline and drained nodes"
228

    
229
oExInst :: OptType
230
oExInst = Option "" ["exclude-instances"]
231
          (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
232
          "exclude given instances from any moves"
233

    
234
oExTags :: OptType
235
oExTags = Option "" ["exclusion-tags"]
236
            (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
237
             "TAG,...") "Enable instance exclusion based on given tag prefix"
238

    
239
oExecJobs :: OptType
240
oExecJobs = Option "X" ["exec"]
241
             (NoArg (\ opts -> Ok opts { optExecJobs = True}))
242
             "execute the suggested moves via Luxi (only available when using\
243
             \ it for data gathering)"
244

    
245
oGroup :: OptType
246
oGroup = Option "G" ["group"]
247
            (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
248
            "the ID of the group to balance"
249

    
250
oIDisk :: OptType
251
oIDisk = Option "" ["disk"]
252
         (ReqArg (\ d opts -> do
253
                    dsk <- annotateResult "--disk option" (parseUnit d)
254
                    let ospec = optISpec opts
255
                        nspec = ospec { rspecDsk = dsk }
256
                    return $ opts { optISpec = nspec }) "DISK")
257
         "disk size for instances"
258

    
259
oIMem :: OptType
260
oIMem = Option "" ["memory"]
261
        (ReqArg (\ m opts -> do
262
                   mem <- annotateResult "--memory option" (parseUnit m)
263
                   let ospec = optISpec opts
264
                       nspec = ospec { rspecMem = mem }
265
                   return $ opts { optISpec = nspec }) "MEMORY")
266
        "memory size for instances"
267

    
268
oIVcpus :: OptType
269
oIVcpus = Option "" ["vcpus"]
270
          (ReqArg (\ p opts -> do
271
                     vcpus <- tryRead "--vcpus option" p
272
                     let ospec = optISpec opts
273
                         nspec = ospec { rspecCpu = vcpus }
274
                     return $ opts { optISpec = nspec }) "NUM")
275
          "number of virtual cpus for instances"
276

    
277
oLuxiSocket :: OptType
278
oLuxiSocket = Option "L" ["luxi"]
279
              (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
280
                       fromMaybe defaultLuxiSocket) "SOCKET")
281
              "collect data via Luxi, optionally using the given SOCKET path"
282

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

    
292
oMaxCpu :: OptType
293
oMaxCpu = Option "" ["max-cpu"]
294
          (ReqArg (\ n opts -> Ok opts { optMcpu = read n }) "RATIO")
295
          "maximum virtual-to-physical cpu ratio for nodes (from 1\
296
          \ upwards) [64]"
297

    
298
oMaxSolLength :: OptType
299
oMaxSolLength = Option "l" ["max-length"]
300
                (ReqArg (\ i opts -> Ok opts { optMaxLength = read i }) "N")
301
                "cap the solution at this many moves (useful for very\
302
                \ unbalanced clusters)"
303

    
304
oMinDisk :: OptType
305
oMinDisk = Option "" ["min-disk"]
306
           (ReqArg (\ n opts -> Ok opts { optMdsk = read n }) "RATIO")
307
           "minimum free disk space for nodes (between 0 and 1) [0]"
308

    
309
oMinGain :: OptType
310
oMinGain = Option "g" ["min-gain"]
311
            (ReqArg (\ g opts -> Ok opts { optMinGain = read g }) "DELTA")
312
            "minimum gain to aim for in a balancing step before giving up"
313

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

    
319
oMinScore :: OptType
320
oMinScore = Option "e" ["min-score"]
321
            (ReqArg (\ e opts -> Ok opts { optMinScore = read e }) "EPSILON")
322
            "mininum score to aim for"
323

    
324
oNoHeaders :: OptType
325
oNoHeaders = Option "" ["no-headers"]
326
             (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
327
             "do not show a header line"
328

    
329
oNodeSim :: OptType
330
oNodeSim = Option "" ["simulate"]
331
            (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
332
            "simulate an empty cluster, given as 'num_nodes,disk,ram,cpu'"
333

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

    
339
oOneline :: OptType
340
oOneline = Option "o" ["oneline"]
341
           (NoArg (\ opts -> Ok opts { optOneline = True }))
342
           "print the ganeti command list for reaching the solution"
343

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

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

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

    
363
oPrintNodes :: OptType
364
oPrintNodes = Option "p" ["print-nodes"]
365
              (OptArg ((\ f opts ->
366
                            let (prefix, realf) = case f of
367
                                  '+':rest -> (["+"], rest)
368
                                  _ -> ([], f)
369
                                splitted = prefix ++ sepSplit ',' realf
370
                            in Ok opts { optShowNodes = Just splitted }) .
371
                       fromMaybe []) "FIELDS")
372
              "print the final node list"
373

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

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

    
384
oSaveCluster :: OptType
385
oSaveCluster = Option "S" ["save"]
386
            (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
387
            "Save cluster state at the end of the processing to FILE"
388

    
389
oShowHelp :: OptType
390
oShowHelp = Option "h" ["help"]
391
            (NoArg (\ opts -> Ok opts { optShowHelp = True}))
392
            "show help"
393

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

    
399
oTieredSpec :: OptType
400
oTieredSpec = Option "" ["tiered-alloc"]
401
             (ReqArg (\ inp opts -> do
402
                          let sp = sepSplit ',' inp
403
                          prs <- mapM (\(fn, val) -> fn val) $
404
                                 zip [ annotateResult "tiered specs memory" .
405
                                       parseUnit
406
                                     , annotateResult "tiered specs disk" .
407
                                       parseUnit
408
                                     , tryRead "tiered specs cpus"
409
                                     ] sp
410
                          tspec <-
411
                              case prs of
412
                                [dsk, ram, cpu] -> return $ RSpec cpu ram dsk
413
                                _ -> Bad $ "Invalid specification: " ++ inp ++
414
                                     ", expected disk,ram,cpu"
415
                          return $ opts { optTieredSpec = Just tspec } )
416
              "TSPEC")
417
             "enable tiered specs allocation, given as 'disk,ram,cpu'"
418

    
419
oReplay :: OptType
420
oReplay = Option "" ["replay"]
421
          (ReqArg (\ stat opts -> Ok opts { optReplay = Just stat } ) "STATE")
422
          "Pre-seed the random number generator with STATE"
423

    
424
oVerbose :: OptType
425
oVerbose = Option "v" ["verbose"]
426
           (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
427
           "increase the verbosity level"
428

    
429
-- * Functions
430

    
431
-- | Helper for parsing a yes\/no command line flag.
432
parseYesNo :: Bool         -- ^ Default whalue (when we get a @Nothing@)
433
           -> Maybe String -- ^ Parameter value
434
           -> Result Bool  -- ^ Resulting boolean value
435
parseYesNo v Nothing      = return v
436
parseYesNo _ (Just "yes") = return True
437
parseYesNo _ (Just "no")  = return False
438
parseYesNo _ (Just s)     = fail $ "Invalid choice '" ++ s ++
439
                            "', pass one of 'yes' or 'no'"
440

    
441
-- | Usage info.
442
usageHelp :: String -> [OptType] -> String
443
usageHelp progname =
444
    usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
445
               progname Version.version progname)
446

    
447
-- | Command line parser, using the 'Options' structure.
448
parseOpts :: [String]               -- ^ The command line arguments
449
          -> String                 -- ^ The program name
450
          -> [OptType]              -- ^ The supported command line options
451
          -> IO (Options, [String]) -- ^ The resulting options and leftover
452
                                    -- arguments
453
parseOpts argv progname options =
454
    case getOpt Permute options argv of
455
      (o, n, []) ->
456
          do
457
            let (pr, args) = (foldM (flip id) defaultOptions o, n)
458
            po <- (case pr of
459
                     Bad msg -> do
460
                       hPutStrLn stderr "Error while parsing command\
461
                                        \line arguments:"
462
                       hPutStrLn stderr msg
463
                       exitWith $ ExitFailure 1
464
                     Ok val -> return val)
465
            when (optShowHelp po) $ do
466
              putStr $ usageHelp progname options
467
              exitWith ExitSuccess
468
            when (optShowVer po) $ do
469
              printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
470
                     progname Version.version
471
                     compilerName (Data.Version.showVersion compilerVersion)
472
                     os arch :: IO ()
473
              exitWith ExitSuccess
474
            return (po, args)
475
      (_, _, errs) -> do
476
        hPutStrLn stderr $ "Command line error: "  ++ concat errs
477
        hPutStrLn stderr $ usageHelp progname options
478
        exitWith $ ExitFailure 2
479

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

    
494
-- | Optionally print the node list.
495
maybePrintNodes :: Maybe [String]       -- ^ The field list
496
                -> String               -- ^ Informational message
497
                -> ([String] -> String) -- ^ Function to generate the listing
498
                -> IO ()
499
maybePrintNodes Nothing _ _ = return ()
500
maybePrintNodes (Just fields) msg fn = do
501
  hPutStrLn stderr ""
502
  hPutStrLn stderr (msg ++ " status:")
503
  hPutStrLn stderr $ fn fields
504

    
505

    
506
-- | Optionally print the instance list.
507
maybePrintInsts :: Bool   -- ^ Whether to print the instance list
508
                -> String -- ^ Type of the instance map (e.g. initial)
509
                -> String -- ^ The instance data
510
                -> IO ()
511
maybePrintInsts do_print msg instdata =
512
  when do_print $ do
513
    hPutStrLn stderr ""
514
    hPutStrLn stderr $ msg ++ " instance map:"
515
    hPutStr stderr instdata
516

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