Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / HTools / CLI.hs @ 8fcfb767

History | View | Annotate | Download (16.6 kB)

1
{-| Implementation of command-line functions.
2

    
3
This module holds the common cli-related functions for the binaries,
4
separated into this module since Utils.hs is used in many other places
5
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
    -- * The options
39
    , oDataFile
40
    , oDiskMoves
41
    , oInstMoves
42
    , oDynuFile
43
    , oEvacMode
44
    , oExInst
45
    , oExTags
46
    , oExecJobs
47
    , oGroup
48
    , oIDisk
49
    , oIMem
50
    , oINodes
51
    , oIVcpus
52
    , oLuxiSocket
53
    , oMaxCpu
54
    , oMaxSolLength
55
    , oMinDisk
56
    , oMinGain
57
    , oMinGainLim
58
    , oMinScore
59
    , oNoHeaders
60
    , oNodeSim
61
    , oOfflineNode
62
    , oOneline
63
    , oOutputDir
64
    , oPrintCommands
65
    , oPrintInsts
66
    , oPrintNodes
67
    , oQuiet
68
    , oRapiMaster
69
    , oSaveCluster
70
    , oShowHelp
71
    , oShowVer
72
    , oTieredSpec
73
    , oVerbose
74
    ) where
75

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

    
85
import qualified Ganeti.HTools.Version as Version(version)
86
import qualified Ganeti.Constants as C
87
import Ganeti.HTools.Types
88
import Ganeti.HTools.Utils
89

    
90
-- | The default value for the luxi socket
91
defaultLuxiSocket :: FilePath
92
defaultLuxiSocket = C.masterSocket
93

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

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

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

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

    
175
oDiskMoves :: OptType
176
oDiskMoves = Option "" ["no-disk-moves"]
177
             (NoArg (\ opts -> Ok opts { optDiskMoves = False}))
178
             "disallow disk moves from the list of allowed instance changes,\
179
             \ thus allowing only the 'cheap' failover/migrate operations"
180

    
181
oInstMoves :: OptType
182
oInstMoves = Option "" ["no-instance-moves"]
183
             (NoArg (\ opts -> Ok opts { optInstMoves = False}))
184
             "disallow instance (primary node) moves from the list of allowed,\
185
             \ instance changes, thus allowing only slower, but sometimes\
186
             \ safer, drbd secondary changes"
187

    
188
oDynuFile :: OptType
189
oDynuFile = Option "U" ["dynu-file"]
190
            (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
191
            "Import dynamic utilisation data from the given FILE"
192

    
193
oEvacMode :: OptType
194
oEvacMode = Option "E" ["evac-mode"]
195
            (NoArg (\opts -> Ok opts { optEvacMode = True }))
196
            "enable evacuation mode, where the algorithm only moves \
197
            \ instances away from offline and drained nodes"
198

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

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

    
209
oExecJobs :: OptType
210
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
oGroup :: OptType
216
oGroup = Option "G" ["group"]
217
            (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
218
            "the ID of the group to balance"
219

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

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

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

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

    
249
oLuxiSocket :: OptType
250
oLuxiSocket = Option "L" ["luxi"]
251
              (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
252
                       fromMaybe defaultLuxiSocket) "SOCKET")
253
              "collect data via Luxi, optionally using the given SOCKET path"
254

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

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

    
267
oMinDisk :: OptType
268
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
oMinGain :: OptType
273
oMinGain = Option "g" ["min-gain"]
274
            (ReqArg (\ g opts -> Ok opts { optMinGain = read g }) "DELTA")
275
            "minimum gain to aim for in a balancing step before giving up"
276

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

    
282
oMinScore :: OptType
283
oMinScore = Option "e" ["min-score"]
284
            (ReqArg (\ e opts -> Ok opts { optMinScore = read e }) "EPSILON")
285
            "mininum score to aim for"
286

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

    
292
oNodeSim :: OptType
293
oNodeSim = Option "" ["simulate"]
294
            (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
295
            "simulate an empty cluster, given as 'num_nodes,disk,ram,cpu'"
296

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

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

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

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

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

    
326
oPrintNodes :: OptType
327
oPrintNodes = Option "p" ["print-nodes"]
328
              (OptArg ((\ f opts ->
329
                            let (prefix, realf) = case f of
330
                                  '+':rest -> (["+"], rest)
331
                                  _ -> ([], f)
332
                                splitted = prefix ++ sepSplit ',' realf
333
                            in Ok opts { optShowNodes = Just splitted }) .
334
                       fromMaybe []) "FIELDS")
335
              "print the final node list"
336

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

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

    
347
oSaveCluster :: OptType
348
oSaveCluster = Option "S" ["save"]
349
            (ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE")
350
            "Save cluster state at the end of the processing to FILE"
351

    
352
oShowHelp :: OptType
353
oShowHelp = Option "h" ["help"]
354
            (NoArg (\ opts -> Ok opts { optShowHelp = True}))
355
            "show help"
356

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

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

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

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

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

    
420
-- | A shell script template for autogenerated scripts.
421
shTemplate :: String
422
shTemplate =
423
    printf "#!/bin/sh\n\n\
424
           \# Auto-generated script for executing cluster rebalancing\n\n\
425
           \# To stop, touch the file /tmp/stop-htools\n\n\
426
           \set -e\n\n\
427
           \check() {\n\
428
           \  if [ -f /tmp/stop-htools ]; then\n\
429
           \    echo 'Stop requested, exiting'\n\
430
           \    exit 0\n\
431
           \  fi\n\
432
           \}\n\n"
433

    
434
-- | Optionally print the node list.
435
maybePrintNodes :: Maybe [String]       -- ^ The field list
436
                -> String               -- ^ Informational message
437
                -> ([String] -> String) -- ^ Function to generate the listing
438
                -> IO ()
439
maybePrintNodes Nothing _ _ = return ()
440
maybePrintNodes (Just fields) msg fn = do
441
  hPutStrLn stderr ""
442
  hPutStrLn stderr (msg ++ " status:")
443
  hPutStrLn stderr $ fn fields
444

    
445

    
446
-- | Optionally print the instance list.
447
maybePrintInsts :: Bool   -- ^ Whether to print the instance list
448
                -> String -- ^ Type of the instance map (e.g. initial)
449
                -> String -- ^ The instance data
450
                -> IO ()
451
maybePrintInsts do_print msg instdata =
452
  when do_print $ do
453
    hPutStrLn stderr ""
454
    hPutStrLn stderr $ msg ++ " instance map:"
455
    hPutStr stderr instdata