Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / Common.hs @ 37904802

History | View | Annotate | Download (8.7 kB)

1
{-| Base common functionality.
2

    
3
This module holds common functionality shared across Ganeti daemons,
4
HTools and any other programs.
5

    
6
-}
7

    
8
{-
9

    
10
Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
11

    
12
This program is free software; you can redistribute it and/or modify
13
it under the terms of the GNU General Public License as published by
14
the Free Software Foundation; either version 2 of the License, or
15
(at your option) any later version.
16

    
17
This program is distributed in the hope that it will be useful, but
18
WITHOUT ANY WARRANTY; without even the implied warranty of
19
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
20
General Public License for more details.
21

    
22
You should have received a copy of the GNU General Public License
23
along with this program; if not, write to the Free Software
24
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
25
02110-1301, USA.
26

    
27
-}
28

    
29
module Ganeti.Common
30
  ( GenericOptType
31
  , StandardOptions(..)
32
  , OptCompletion(..)
33
  , ArgCompletion(..)
34
  , optComplYesNo
35
  , oShowHelp
36
  , oShowVer
37
  , oShowComp
38
  , usageHelp
39
  , versionInfo
40
  , reqWithConversion
41
  , parseYesNo
42
  , parseOpts
43
  , parseOptsInner
44
  ) where
45

    
46
import Control.Monad (foldM)
47
import Data.Char (toLower)
48
import Data.List (intercalate, stripPrefix)
49
import Data.Maybe (fromMaybe)
50
import qualified Data.Version
51
import System.Console.GetOpt
52
import System.Exit
53
import System.Info
54
import System.IO
55
import Text.Printf (printf)
56

    
57
import Ganeti.BasicTypes
58
import qualified Ganeti.Version as Version (version)
59

    
60
-- | Parameter type.
61
data OptCompletion = OptComplNone             -- ^ No parameter to this option
62
                   | OptComplFile             -- ^ An existing file
63
                   | OptComplDir              -- ^ An existing directory
64
                   | OptComplHost             -- ^ Host name
65
                   | OptComplInetAddr         -- ^ One ipv4\/ipv6 address
66
                   | OptComplOneNode          -- ^ One node
67
                   | OptComplManyNodes        -- ^ Many nodes, comma-sep
68
                   | OptComplOneInstance      -- ^ One instance
69
                   | OptComplManyInstances    -- ^ Many instances, comma-sep
70
                   | OptComplOneOs            -- ^ One OS name
71
                   | OptComplOneIallocator    -- ^ One iallocator
72
                   | OptComplInstAddNodes     -- ^ Either one or two nodes
73
                   | OptComplOneGroup         -- ^ One group
74
                   | OptComplInteger          -- ^ Integer values
75
                   | OptComplFloat            -- ^ Float values
76
                   | OptComplJobId            -- ^ Job Id
77
                   | OptComplCommand          -- ^ Command (executable)
78
                   | OptComplString           -- ^ Arbitrary string
79
                   | OptComplChoices [String] -- ^ List of string choices
80
                   | OptComplSuggest [String] -- ^ Suggested choices
81
                   deriving (Show, Read, Eq)
82

    
83
-- | Argument type. This differs from (and wraps) an Option by the
84
-- fact that it can (and usually does) support multiple repetitions of
85
-- the same argument, via a min and max limit.
86
data ArgCompletion = ArgCompletion OptCompletion Int (Maybe Int)
87
                     deriving (Show, Read, Eq)
88

    
89
-- | Yes\/no choices completion.
90
optComplYesNo :: OptCompletion
91
optComplYesNo = OptComplChoices ["yes", "no"]
92

    
93
-- | Text serialisation for 'OptCompletion', used on the Python side.
94
complToText :: OptCompletion -> String
95
complToText (OptComplChoices choices) = "choices=" ++ intercalate "," choices
96
complToText (OptComplSuggest choices) = "suggest=" ++ intercalate "," choices
97
complToText compl =
98
  let show_compl = show compl
99
      stripped = stripPrefix "OptCompl" show_compl
100
  in map toLower $ fromMaybe show_compl stripped
101

    
102
-- | Tex serialisation for 'ArgCompletion'.
103
argComplToText :: ArgCompletion -> String
104
argComplToText (ArgCompletion optc min_cnt max_cnt) =
105
  complToText optc ++ " " ++ show min_cnt ++ " " ++ maybe "none" show max_cnt
106

    
107
-- | Abrreviation for the option type.
108
type GenericOptType a = (OptDescr (a -> Result a), OptCompletion)
109

    
110
-- | Type class for options which support help and version.
111
class StandardOptions a where
112
  helpRequested :: a -> Bool
113
  verRequested  :: a -> Bool
114
  compRequested :: a -> Bool
115
  requestHelp   :: a -> a
116
  requestVer    :: a -> a
117
  requestComp   :: a -> a
118

    
119
-- | Option to request help output.
120
oShowHelp :: (StandardOptions a) => GenericOptType a
121
oShowHelp = (Option "h" ["help"] (NoArg (Ok . requestHelp)) "show help",
122
             OptComplNone)
123

    
124
-- | Option to request version information.
125
oShowVer :: (StandardOptions a) => GenericOptType a
126
oShowVer = (Option "V" ["version"] (NoArg (Ok . requestVer))
127
            "show the version of the program",
128
            OptComplNone)
129

    
130
-- | Option to request completion information
131
oShowComp :: (StandardOptions a) => GenericOptType a
132
oShowComp =
133
  (Option "" ["help-completion"] (NoArg (Ok . requestComp) )
134
   "show completion info", OptComplNone)
135

    
136
-- | Usage info.
137
usageHelp :: String -> [GenericOptType a] -> String
138
usageHelp progname =
139
  usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
140
             progname Version.version progname) . map fst
141

    
142
-- | Show the program version info.
143
versionInfo :: String -> String
144
versionInfo progname =
145
  printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
146
         progname Version.version compilerName
147
         (Data.Version.showVersion compilerVersion)
148
         os arch
149

    
150
-- | Show completion info.
151
completionInfo :: String -> [GenericOptType a] -> [ArgCompletion] -> String
152
completionInfo _ opts args =
153
  unlines $
154
  map (\(Option shorts longs _ _, compinfo) ->
155
         let all_opts = map (\c -> ['-', c]) shorts ++ map ("--" ++) longs
156
         in intercalate "," all_opts ++ " " ++ complToText compinfo
157
      ) opts ++
158
  map argComplToText args
159

    
160
-- | Helper for parsing a yes\/no command line flag.
161
parseYesNo :: Bool         -- ^ Default value (when we get a @Nothing@)
162
           -> Maybe String -- ^ Parameter value
163
           -> Result Bool  -- ^ Resulting boolean value
164
parseYesNo v Nothing      = return v
165
parseYesNo _ (Just "yes") = return True
166
parseYesNo _ (Just "no")  = return False
167
parseYesNo _ (Just s)     = fail ("Invalid choice '" ++ s ++
168
                                  "', pass one of 'yes' or 'no'")
169

    
170
-- | Helper function for required arguments which need to be converted
171
-- as opposed to stored just as string.
172
reqWithConversion :: (String -> Result a)
173
                  -> (a -> b -> Result b)
174
                  -> String
175
                  -> ArgDescr (b -> Result b)
176
reqWithConversion conversion_fn updater_fn =
177
  ReqArg (\string_opt opts -> do
178
            parsed_value <- conversion_fn string_opt
179
            updater_fn parsed_value opts)
180

    
181
-- | Command line parser, using a generic 'Options' structure.
182
parseOpts :: (StandardOptions a) =>
183
             a                      -- ^ The default options
184
          -> [String]               -- ^ The command line arguments
185
          -> String                 -- ^ The program name
186
          -> [GenericOptType a]     -- ^ The supported command line options
187
          -> [ArgCompletion]        -- ^ The supported command line arguments
188
          -> IO (a, [String])       -- ^ The resulting options and
189
                                    -- leftover arguments
190
parseOpts defaults argv progname options arguments =
191
  case parseOptsInner defaults argv progname options arguments of
192
    Left (code, msg) -> do
193
      hPutStr (if code == ExitSuccess then stdout else stderr) msg
194
      exitWith code
195
    Right result ->
196
      return result
197

    
198
-- | Inner parse options. The arguments are similar to 'parseOpts',
199
-- but it returns either a 'Left' composed of exit code and message,
200
-- or a 'Right' for the success case.
201
parseOptsInner :: (StandardOptions a) =>
202
                  a
203
               -> [String]
204
               -> String
205
               -> [GenericOptType a]
206
               -> [ArgCompletion]
207
               -> Either (ExitCode, String) (a, [String])
208
parseOptsInner defaults argv progname options arguments  =
209
  case getOpt Permute (map fst options) argv of
210
    (opts, args, []) ->
211
      case foldM (flip id) defaults opts of
212
           Bad msg -> Left (ExitFailure 1,
213
                            "Error while parsing command line arguments:\n"
214
                            ++ msg ++ "\n")
215
           Ok parsed ->
216
             select (Right (parsed, args))
217
                 [ (helpRequested parsed,
218
                    Left (ExitSuccess, usageHelp progname options))
219
                 , (verRequested parsed,
220
                    Left (ExitSuccess, versionInfo progname))
221
                 , (compRequested parsed,
222
                    Left (ExitSuccess, completionInfo progname options
223
                                         arguments))
224
                 ]
225
    (_, _, errs) ->
226
      Left (ExitFailure 2, "Command line error: "  ++ concat errs ++ "\n" ++
227
            usageHelp progname options)