Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / Common.hs @ fad06963

History | View | Annotate | Download (8.5 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
                   | OptComplNumeric          -- ^ Float values
75
                   | OptComplJobId            -- ^ Job Id
76
                   | OptComplCommand          -- ^ Command (executable)
77
                   | OptComplString           -- ^ Arbitrary string
78
                   | OptComplChoices [String] -- ^ List of string choices
79
                   | OptComplSuggest [String] -- ^ Suggested choices
80
                   deriving (Show, Read, Eq)
81

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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