Statistics
| Branch: | Tag: | Revision:

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

History | View | Annotate | Download (18.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
    , oMaxCpu
55
    , oMaxSolLength
56
    , oMinDisk
57
    , oMinGain
58
    , oMinGainLim
59
    , oMinScore
60
    , oNoHeaders
61
    , oNodeSim
62
    , oOfflineNode
63
    , oOneline
64
    , oOutputDir
65
    , oPrintCommands
66
    , oPrintInsts
67
    , oPrintNodes
68
    , oQuiet
69
    , oRapiMaster
70
    , oReplay
71
    , oSaveCluster
72
    , oSelInst
73
    , oShowHelp
74
    , oShowVer
75
    , oTieredSpec
76
    , oVerbose
77
    ) where
78

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

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

    
93
-- * Constants
94

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

    
101
-- * Data types
102

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

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

    
180
-- | Abrreviation for the option type.
181
type OptType = OptDescr (Options -> Result Options)
182

    
183
-- * Command line options
184

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    
286
oMaxSolLength :: OptType
287
oMaxSolLength = Option "l" ["max-length"]
288
                (ReqArg (\ i opts -> Ok opts { optMaxLength = read i }) "N")
289
                "cap the solution at this many moves (useful for very\
290
                \ unbalanced clusters)"
291

    
292
oMinDisk :: OptType
293
oMinDisk = Option "" ["min-disk"]
294
           (ReqArg (\ n opts -> Ok opts { optMdsk = read n }) "RATIO")
295
           "minimum free disk space for nodes (between 0 and 1) [0]"
296

    
297
oMinGain :: OptType
298
oMinGain = Option "g" ["min-gain"]
299
            (ReqArg (\ g opts -> Ok opts { optMinGain = read g }) "DELTA")
300
            "minimum gain to aim for in a balancing step before giving up"
301

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

    
307
oMinScore :: OptType
308
oMinScore = Option "e" ["min-score"]
309
            (ReqArg (\ e opts -> Ok opts { optMinScore = read e }) "EPSILON")
310
            "mininum score to aim for"
311

    
312
oNoHeaders :: OptType
313
oNoHeaders = Option "" ["no-headers"]
314
             (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
315
             "do not show a header line"
316

    
317
oNodeSim :: OptType
318
oNodeSim = Option "" ["simulate"]
319
            (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
320
            "simulate an empty cluster, given as 'num_nodes,disk,ram,cpu'"
321

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

    
327
oOneline :: OptType
328
oOneline = Option "o" ["oneline"]
329
           (NoArg (\ opts -> Ok opts { optOneline = True }))
330
           "print the ganeti command list for reaching the solution"
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
oTieredSpec :: OptType
388
oTieredSpec = Option "" ["tiered-alloc"]
389
             (ReqArg (\ inp opts -> do
390
                          let sp = sepSplit ',' inp
391
                          prs <- mapM (\(fn, val) -> fn val) $
392
                                 zip [ annotateResult "tiered specs memory" .
393
                                       parseUnit
394
                                     , annotateResult "tiered specs disk" .
395
                                       parseUnit
396
                                     , tryRead "tiered specs cpus"
397
                                     ] sp
398
                          tspec <-
399
                              case prs of
400
                                [dsk, ram, cpu] -> return $ RSpec cpu ram dsk
401
                                _ -> Bad $ "Invalid specification: " ++ inp ++
402
                                     ", expected disk,ram,cpu"
403
                          return $ opts { optTieredSpec = Just tspec } )
404
              "TSPEC")
405
             "enable tiered specs allocation, given as 'disk,ram,cpu'"
406

    
407
oReplay :: OptType
408
oReplay = Option "" ["replay"]
409
          (ReqArg (\ stat opts -> Ok opts { optReplay = Just stat } ) "STATE")
410
          "Pre-seed the random number generator with STATE"
411

    
412
oVerbose :: OptType
413
oVerbose = Option "v" ["verbose"]
414
           (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
415
           "increase the verbosity level"
416

    
417
-- * Functions
418

    
419
-- | Usage info.
420
usageHelp :: String -> [OptType] -> String
421
usageHelp progname =
422
    usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
423
               progname Version.version progname)
424

    
425
-- | Command line parser, using the 'Options' structure.
426
parseOpts :: [String]               -- ^ The command line arguments
427
          -> String                 -- ^ The program name
428
          -> [OptType]              -- ^ The supported command line options
429
          -> IO (Options, [String]) -- ^ The resulting options and leftover
430
                                    -- arguments
431
parseOpts argv progname options =
432
    case getOpt Permute options argv of
433
      (o, n, []) ->
434
          do
435
            let (pr, args) = (foldM (flip id) defaultOptions o, n)
436
            po <- (case pr of
437
                     Bad msg -> do
438
                       hPutStrLn stderr "Error while parsing command\
439
                                        \line arguments:"
440
                       hPutStrLn stderr msg
441
                       exitWith $ ExitFailure 1
442
                     Ok val -> return val)
443
            when (optShowHelp po) $ do
444
              putStr $ usageHelp progname options
445
              exitWith ExitSuccess
446
            when (optShowVer po) $ do
447
              printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
448
                     progname Version.version
449
                     compilerName (Data.Version.showVersion compilerVersion)
450
                     os arch :: IO ()
451
              exitWith ExitSuccess
452
            return (po, args)
453
      (_, _, errs) -> do
454
        hPutStrLn stderr $ "Command line error: "  ++ concat errs
455
        hPutStrLn stderr $ usageHelp progname options
456
        exitWith $ ExitFailure 2
457

    
458
-- | A shell script template for autogenerated scripts.
459
shTemplate :: String
460
shTemplate =
461
    printf "#!/bin/sh\n\n\
462
           \# Auto-generated script for executing cluster rebalancing\n\n\
463
           \# To stop, touch the file /tmp/stop-htools\n\n\
464
           \set -e\n\n\
465
           \check() {\n\
466
           \  if [ -f /tmp/stop-htools ]; then\n\
467
           \    echo 'Stop requested, exiting'\n\
468
           \    exit 0\n\
469
           \  fi\n\
470
           \}\n\n"
471

    
472
-- | Optionally print the node list.
473
maybePrintNodes :: Maybe [String]       -- ^ The field list
474
                -> String               -- ^ Informational message
475
                -> ([String] -> String) -- ^ Function to generate the listing
476
                -> IO ()
477
maybePrintNodes Nothing _ _ = return ()
478
maybePrintNodes (Just fields) msg fn = do
479
  hPutStrLn stderr ""
480
  hPutStrLn stderr (msg ++ " status:")
481
  hPutStrLn stderr $ fn fields
482

    
483

    
484
-- | Optionally print the instance list.
485
maybePrintInsts :: Bool   -- ^ Whether to print the instance list
486
                -> String -- ^ Type of the instance map (e.g. initial)
487
                -> String -- ^ The instance data
488
                -> IO ()
489
maybePrintInsts do_print msg instdata =
490
  when do_print $ do
491
    hPutStrLn stderr ""
492
    hPutStrLn stderr $ msg ++ " instance map:"
493
    hPutStr stderr instdata
494

    
495
-- | Function to display warning messages from parsing the cluster
496
-- state.
497
maybeShowWarnings :: [String] -- ^ The warning messages
498
                  -> IO ()
499
maybeShowWarnings fix_msgs =
500
  unless (null fix_msgs) $ do
501
    hPutStrLn stderr "Warning: cluster has inconsistent data:"
502
    hPutStrLn stderr . unlines . map (printf "  - %s") $ fix_msgs