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

This module holds the common cli-related functions for the binaries,
separated into this module since Utils.hs is used in many other places
Iustin Pop's avatar
Iustin Pop committed
5
and this is more IO oriented.
6
7
8

-}

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

Iustin Pop's avatar
Iustin Pop committed
11
Copyright (C) 2009, 2010, 2011 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
31
32
    ( Options(..)
    , OptType
Iustin Pop's avatar
Iustin Pop committed
33
    , parseOpts
34
    , shTemplate
35
    , defaultLuxiSocket
36
    , maybePrintNodes
37
    , maybePrintInsts
38
    -- * The options
39
    , oDataFile
Iustin Pop's avatar
Iustin Pop committed
40
    , oDiskMoves
41
    , oInstMoves
Iustin Pop's avatar
Iustin Pop committed
42
    , oDynuFile
Iustin Pop's avatar
Iustin Pop committed
43
    , oEvacMode
44
    , oExInst
Iustin Pop's avatar
Iustin Pop committed
45
    , oExTags
46
    , oExecJobs
47
    , oGroup
48
    , oIDisk
Iustin Pop's avatar
Iustin Pop committed
49
    , oIMem
50
    , oINodes
Iustin Pop's avatar
Iustin Pop committed
51
52
    , oIVcpus
    , oLuxiSocket
53
    , oMaxCpu
Iustin Pop's avatar
Iustin Pop committed
54
    , oMaxSolLength
55
    , oMinDisk
56
57
    , oMinGain
    , oMinGainLim
Iustin Pop's avatar
Iustin Pop committed
58
59
60
61
62
63
64
65
66
67
68
    , oMinScore
    , oNoHeaders
    , oNodeSim
    , oOfflineNode
    , oOneline
    , oOutputDir
    , oPrintCommands
    , oPrintInsts
    , oPrintNodes
    , oQuiet
    , oRapiMaster
Iustin Pop's avatar
Iustin Pop committed
69
    , oSaveCluster
70
    , oShowHelp
Iustin Pop's avatar
Iustin Pop committed
71
72
73
    , oShowVer
    , oTieredSpec
    , oVerbose
74
75
    ) where

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

import qualified Ganeti.HTools.Version as Version(version)
Iustin Pop's avatar
Iustin Pop committed
86
import qualified Ganeti.Constants as C
87
import Ganeti.HTools.Types
88
import Ganeti.HTools.Utils
89

90
91
-- | The default value for the luxi socket
defaultLuxiSocket :: FilePath
Iustin Pop's avatar
Iustin Pop committed
92
defaultLuxiSocket = C.masterSocket
93

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

-- | Default values for the command line options.
defaultOptions :: Options
defaultOptions  = Options
Iustin Pop's avatar
Iustin Pop committed
133
134
 { optDataFile    = Nothing
 , optDiskMoves   = True
135
 , optInstMoves   = True
Iustin Pop's avatar
Iustin Pop committed
136
 , optDynuFile    = Nothing
Iustin Pop's avatar
Iustin Pop committed
137
 , optEvacMode    = False
138
 , optExInst      = []
Iustin Pop's avatar
Iustin Pop committed
139
 , optExTags      = Nothing
140
 , optExecJobs    = False
141
 , optGroup       = Nothing
142
143
 , optINodes      = 2
 , optISpec       = RSpec 1 4096 102400
Iustin Pop's avatar
Iustin Pop committed
144
145
146
 , optLuxi        = Nothing
 , optMaster      = ""
 , optMaxLength   = -1
147
148
 , optMcpu        = defVcpuRatio
 , optMdsk        = defReservedDiskRatio
149
150
 , optMinGain     = 1e-2
 , optMinGainLim  = 1e-1
Iustin Pop's avatar
Iustin Pop committed
151
152
 , optMinScore    = 1e-9
 , optNoHeaders   = False
153
 , optNodeSim     = []
Iustin Pop's avatar
Iustin Pop committed
154
155
156
 , optOffline     = []
 , optOneline     = False
 , optOutPath     = "."
Iustin Pop's avatar
Iustin Pop committed
157
 , optSaveCluster = Nothing
Iustin Pop's avatar
Iustin Pop committed
158
 , optShowCmds    = Nothing
159
 , optShowHelp    = False
Iustin Pop's avatar
Iustin Pop committed
160
161
162
163
164
 , optShowInsts   = False
 , optShowNodes   = Nothing
 , optShowVer     = False
 , optTieredSpec  = Nothing
 , optVerbose     = 1
165
166
167
 }

-- | Abrreviation for the option type
168
type OptType = OptDescr (Options -> Result Options)
169

170
171
172
173
oDataFile :: OptType
oDataFile = Option "t" ["text-data"]
            (ReqArg (\ f o -> Ok o { optDataFile = Just f }) "FILE")
            "the cluster data FILE"
174

Iustin Pop's avatar
Iustin Pop committed
175
176
177
178
179
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"
180

181
182
183
184
185
186
187
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
188
189
190
191
oDynuFile :: OptType
oDynuFile = Option "U" ["dynu-file"]
            (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
            "Import dynamic utilisation data from the given FILE"
192

Iustin Pop's avatar
Iustin Pop committed
193
194
195
196
197
198
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"

199
200
201
202
203
oExInst :: OptType
oExInst = Option "" ["exclude-instances"]
          (ReqArg (\ f opts -> Ok opts { optExInst = sepSplit ',' f }) "INSTS")
          "exclude given instances  from any moves"

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

209
210
oExecJobs :: OptType
oExecJobs = Option "X" ["exec"]
211
             (NoArg (\ opts -> Ok opts { optExecJobs = True}))
212
             "execute the suggested moves via Luxi (only available when using\
213
             \ it for data gathering)"
214

215
216
217
218
219
oGroup :: OptType
oGroup = Option "G" ["group"]
            (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
            "the ID of the group to balance"

Iustin Pop's avatar
Iustin Pop committed
220
221
222
223
224
225
226
oIDisk :: OptType
oIDisk = Option "" ["disk"]
         (ReqArg (\ d opts ->
                     let ospec = optISpec opts
                         nspec = ospec { rspecDsk = read d }
                     in Ok opts { optISpec = nspec }) "DISK")
         "disk size for instances"
227
228
229

oIMem :: OptType
oIMem = Option "" ["memory"]
230
231
232
233
        (ReqArg (\ m opts ->
                     let ospec = optISpec opts
                         nspec = ospec { rspecMem = read m }
                     in Ok opts { optISpec = nspec }) "MEMORY")
234
235
        "memory size for instances"

Iustin Pop's avatar
Iustin Pop committed
236
237
238
239
oINodes :: OptType
oINodes = Option "" ["req-nodes"]
          (ReqArg (\ n opts -> Ok opts { optINodes = read n }) "NODES")
          "number of nodes for the new instances (1=plain, 2=mirrored)"
240
241
242

oIVcpus :: OptType
oIVcpus = Option "" ["vcpus"]
243
244
245
246
          (ReqArg (\ p opts ->
                       let ospec = optISpec opts
                           nspec = ospec { rspecCpu = read p }
                       in Ok opts { optISpec = nspec }) "NUM")
247
248
          "number of virtual cpus for instances"

Iustin Pop's avatar
Iustin Pop committed
249
250
251
252
253
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"
254
255
256

oMaxCpu :: OptType
oMaxCpu = Option "" ["max-cpu"]
257
          (ReqArg (\ n opts -> Ok opts { optMcpu = read n }) "RATIO")
258
259
          "maximum virtual-to-physical cpu ratio for nodes (from 1\
          \ upwards) [64]"
260

Iustin Pop's avatar
Iustin Pop committed
261
262
263
264
265
266
oMaxSolLength :: OptType
oMaxSolLength = Option "l" ["max-length"]
                (ReqArg (\ i opts -> Ok opts { optMaxLength = read i }) "N")
                "cap the solution at this many moves (useful for very\
                \ unbalanced clusters)"

267
268
oMinDisk :: OptType
oMinDisk = Option "" ["min-disk"]
269
           (ReqArg (\ n opts -> Ok opts { optMdsk = read n }) "RATIO")
270
           "minimum free disk space for nodes (between 0 and 1) [0]"
271

272
273
274
275
276
277
278
279
280
281
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
282
283
284
oMinScore :: OptType
oMinScore = Option "e" ["min-score"]
            (ReqArg (\ e opts -> Ok opts { optMinScore = read e }) "EPSILON")
285
            "mininum score to aim for"
286

Iustin Pop's avatar
Iustin Pop committed
287
288
289
290
oNoHeaders :: OptType
oNoHeaders = Option "" ["no-headers"]
             (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
             "do not show a header line"
291

Iustin Pop's avatar
Iustin Pop committed
292
293
oNodeSim :: OptType
oNodeSim = Option "" ["simulate"]
294
            (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
Iustin Pop's avatar
Iustin Pop committed
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
            "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"

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

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
329
330
331
332
                            let (prefix, realf) = case f of
                                  '+':rest -> (["+"], rest)
                                  _ -> ([], f)
                                splitted = prefix ++ sepSplit ',' realf
Iustin Pop's avatar
Iustin Pop committed
333
334
335
336
337
338
339
340
341
342
343
344
345
346
                            in Ok opts { optShowNodes = Just splitted }) .
                       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
347
348
349
350
351
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
352
353
354
355
356
357
358
359
360
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"
361

362
363
364
365
366
367
368
oTieredSpec :: OptType
oTieredSpec = Option "" ["tiered-alloc"]
             (ReqArg (\ inp opts -> do
                          let sp = sepSplit ',' inp
                          prs <- mapM (tryRead "tiered specs") sp
                          tspec <-
                              case prs of
369
                                [dsk, ram, cpu] -> return $ RSpec cpu ram dsk
370
371
                                _ -> Bad $ "Invalid specification: " ++ inp ++
                                     ", expected disk,ram,cpu"
372
373
                          return $ opts { optTieredSpec = Just tspec } )
              "TSPEC")
374
             "enable tiered specs allocation, given as 'disk,ram,cpu'"
375

Iustin Pop's avatar
Iustin Pop committed
376
377
378
379
oVerbose :: OptType
oVerbose = Option "v" ["verbose"]
           (NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 }))
           "increase the verbosity level"
380

381
-- | Usage info
382
usageHelp :: String -> [OptType] -> String
Iustin Pop's avatar
Iustin Pop committed
383
usageHelp progname =
384
    usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
Iustin Pop's avatar
Iustin Pop committed
385
               progname Version.version progname)
386

387
-- | Command line parser, using the 'options' structure.
388
389
390
391
392
393
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 =
394
395
396
    case getOpt Permute options argv of
      (o, n, []) ->
          do
397
398
399
400
401
402
403
404
            let (pr, args) = (foldM (flip id) defaultOptions o, n)
            po <- (case pr of
                     Bad msg -> do
                       hPutStrLn stderr "Error while parsing command\
                                        \line arguments:"
                       hPutStrLn stderr msg
                       exitWith $ ExitFailure 1
                     Ok val -> return val)
405
            when (optShowHelp po) $ do
406
              putStr $ usageHelp progname options
407
              exitWith ExitSuccess
408
            when (optShowVer po) $ do
Iustin Pop's avatar
Iustin Pop committed
409
410
411
              printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
                     progname Version.version
                     compilerName (Data.Version.showVersion compilerVersion)
Iustin Pop's avatar
Iustin Pop committed
412
                     os arch :: IO ()
Iustin Pop's avatar
Iustin Pop committed
413
              exitWith ExitSuccess
414
            return (po, args)
415
416
417
418
      (_, _, errs) -> do
        hPutStrLn stderr $ "Command line error: "  ++ concat errs
        hPutStrLn stderr $ usageHelp progname options
        exitWith $ ExitFailure 2
419

Iustin Pop's avatar
Iustin Pop committed
420
-- | A shell script template for autogenerated scripts.
421
422
423
424
425
426
427
428
429
430
431
432
shTemplate :: String
shTemplate =
    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"
433
434
435
436
437
438
439
440
441
442
443

-- | 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
444
445
446
447
448
449
450
451
452
453
454
455


-- | 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