CLI.hs 4.28 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
9

-}

module Ganeti.HTools.CLI
Iustin Pop's avatar
Iustin Pop committed
10
    ( CLIOptions(..)
11
    , EToolOptions(..)
Iustin Pop's avatar
Iustin Pop committed
12
    , parseOpts
13
    , parseEnv
14
    , shTemplate
15
    , loadExternalData
16
17
18
    ) where

import System.Console.GetOpt
19
import System.Posix.Env
20
21
22
23
24
25
26
27
import System.IO
import System.Info
import System
import Monad
import Text.Printf (printf)
import qualified Data.Version

import qualified Ganeti.HTools.Version as Version(version)
28
29
30
import qualified Ganeti.HTools.Rapi as Rapi
import qualified Ganeti.HTools.Text as Text
import qualified Ganeti.HTools.Loader as Loader
31
32
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
33
34

import Ganeti.HTools.Types
35

Iustin Pop's avatar
Iustin Pop committed
36
37
38
39
40
-- | Class for types which support show help and show version
class CLIOptions a where
    showHelp    :: a -> Bool
    showVersion :: a -> Bool

41
42
43
44
45
46
47
48
49
-- | Class for types which support the -i/-n/-m options
class EToolOptions a where
    nodeFile   :: a -> FilePath
    nodeSet    :: a -> Bool
    instFile   :: a -> FilePath
    instSet    :: a -> Bool
    masterName :: a -> String
    silent     :: a -> Bool

50
-- | Command line parser, using the 'options' structure.
Iustin Pop's avatar
Iustin Pop committed
51
52
parseOpts :: (CLIOptions b) =>
             [String]            -- ^ The command line arguments
53
54
55
56
57
          -> String              -- ^ The program name
          -> [OptDescr (b -> b)] -- ^ The supported command line options
          -> b                   -- ^ The default options record
          -> IO (b, [String])    -- ^ The resulting options a leftover
                                 -- arguments
Iustin Pop's avatar
Iustin Pop committed
58
parseOpts argv progname options defaultOptions =
59
60
61
62
    case getOpt Permute options argv of
      (o, n, []) ->
          do
            let resu@(po, _) = (foldl (flip id) defaultOptions o, n)
Iustin Pop's avatar
Iustin Pop committed
63
            when (showHelp po) $ do
64
65
              putStr $ usageInfo header options
              exitWith ExitSuccess
Iustin Pop's avatar
Iustin Pop committed
66
67
68
69
70
71
            when (showVersion po) $ do
              printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
                     progname Version.version
                     compilerName (Data.Version.showVersion compilerVersion)
                     os arch
              exitWith ExitSuccess
72
73
74
75
76
77
            return resu
      (_, _, errs) ->
          ioError (userError (concat errs ++ usageInfo header options))
      where header = printf "%s %s\nUsage: %s [OPTION...]"
                     progname Version.version progname

78
79
80
81
82
83
84
-- | Parse the environment and return the node/instance names.
-- This also hardcodes here the default node/instance file names.
parseEnv :: () -> IO (String, String)
parseEnv () = do
  a <- getEnvDefault "HTOOLS_NODES" "nodes"
  b <- getEnvDefault "HTOOLS_INSTANCES" "instances"
  return (a, b)
85

86
87
88
89
90
91
92
93
94
95
96
97
98
-- | A shell script template for autogenerated scripts
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"
99
100
101
102

-- | External tool data loader from a variety of sources
loadExternalData :: (EToolOptions a) =>
                    a
103
                 -> IO (Node.List, Instance.List, String)
104
105
106
107
108
109
110
111
112
113
114
115
loadExternalData opts = do
  (env_node, env_inst) <- parseEnv ()
  let nodef = if nodeSet opts then nodeFile opts
              else env_node
      instf = if instSet opts then instFile opts
              else env_inst
  input_data <-
      case masterName opts of
        "" -> Text.loadData nodef instf
        host -> Rapi.loadData host

  let ldresult = input_data >>= Loader.mergeData
116
  (loaded_nl, il, csf) <-
117
118
119
120
121
122
      (case ldresult of
         Ok x -> return x
         Bad s -> do
           printf "Error: failed to load data. Details:\n%s\n" s
           exitWith $ ExitFailure 1
      )
123
  let (fix_msgs, fixed_nl) = Loader.checkData loaded_nl il
124
125
126
127
128

  unless (null fix_msgs || silent opts) $ do
         putStrLn "Warning: cluster has inconsistent data:"
         putStrLn . unlines . map (\s -> printf "  - %s" s) $ fix_msgs

129
  return (fixed_nl, il, csf)