1 {-| Base common functionality.
3 This module holds common functionality shared across Ganeti daemons,
4 HTools and any other programs.
10 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
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.
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.
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
49 import Control.Monad (foldM)
50 import Data.Char (toLower)
51 import Data.List (intercalate, stripPrefix, sortBy)
52 import Data.Maybe (fromMaybe)
53 import Data.Ord (comparing)
54 import qualified Data.Version
55 import System.Console.GetOpt
56 import System.Environment
60 import Text.Printf (printf)
62 import Ganeti.BasicTypes
63 import qualified Ganeti.Constants as C
64 import qualified Ganeti.Version as Version (version)
67 data OptCompletion = OptComplNone -- ^ No parameter to this option
68 | OptComplFile -- ^ An existing file
69 | OptComplDir -- ^ An existing directory
70 | OptComplHost -- ^ Host name
71 | OptComplInetAddr -- ^ One ipv4\/ipv6 address
72 | OptComplOneNode -- ^ One node
73 | OptComplManyNodes -- ^ Many nodes, comma-sep
74 | OptComplOneInstance -- ^ One instance
75 | OptComplManyInstances -- ^ Many instances, comma-sep
76 | OptComplOneOs -- ^ One OS name
77 | OptComplOneIallocator -- ^ One iallocator
78 | OptComplInstAddNodes -- ^ Either one or two nodes
79 | OptComplOneGroup -- ^ One group
80 | OptComplInteger -- ^ Integer values
81 | OptComplFloat -- ^ Float values
82 | OptComplJobId -- ^ Job Id
83 | OptComplCommand -- ^ Command (executable)
84 | OptComplString -- ^ Arbitrary string
85 | OptComplChoices [String] -- ^ List of string choices
86 | OptComplSuggest [String] -- ^ Suggested choices
89 -- | Argument type. This differs from (and wraps) an Option by the
90 -- fact that it can (and usually does) support multiple repetitions of
91 -- the same argument, via a min and max limit.
92 data ArgCompletion = ArgCompletion OptCompletion Int (Maybe Int)
95 -- | A personality definition.
96 type Personality a = ( a -> [String] -> IO () -- The main function
97 , IO [GenericOptType a] -- The options
98 , [ArgCompletion] -- The description of args
101 -- | Personality lists type, common across all binaries that expose
102 -- multiple personalities.
103 type PersonalityList a = [(String, Personality a)]
105 -- | Yes\/no choices completion.
106 optComplYesNo :: OptCompletion
107 optComplYesNo = OptComplChoices ["yes", "no"]
109 -- | Text serialisation for 'OptCompletion', used on the Python side.
110 complToText :: OptCompletion -> String
111 complToText (OptComplChoices choices) = "choices=" ++ intercalate "," choices
112 complToText (OptComplSuggest choices) = "suggest=" ++ intercalate "," choices
114 let show_compl = show compl
115 stripped = stripPrefix "OptCompl" show_compl
116 in map toLower $ fromMaybe show_compl stripped
118 -- | Tex serialisation for 'ArgCompletion'.
119 argComplToText :: ArgCompletion -> String
120 argComplToText (ArgCompletion optc min_cnt max_cnt) =
121 complToText optc ++ " " ++ show min_cnt ++ " " ++ maybe "none" show max_cnt
123 -- | Abrreviation for the option type.
124 type GenericOptType a = (OptDescr (a -> Result a), OptCompletion)
126 -- | Type class for options which support help and version.
127 class StandardOptions a where
128 helpRequested :: a -> Bool
129 verRequested :: a -> Bool
130 compRequested :: a -> Bool
131 requestHelp :: a -> a
133 requestComp :: a -> a
135 -- | Option to request help output.
136 oShowHelp :: (StandardOptions a) => GenericOptType a
137 oShowHelp = (Option "h" ["help"] (NoArg (Ok . requestHelp)) "show help",
140 -- | Option to request version information.
141 oShowVer :: (StandardOptions a) => GenericOptType a
142 oShowVer = (Option "V" ["version"] (NoArg (Ok . requestVer))
143 "show the version of the program",
146 -- | Option to request completion information
147 oShowComp :: (StandardOptions a) => GenericOptType a
149 (Option "" ["help-completion"] (NoArg (Ok . requestComp) )
150 "show completion info", OptComplNone)
153 usageHelp :: String -> [GenericOptType a] -> String
155 usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
156 progname Version.version progname) . map fst
158 -- | Show the program version info.
159 versionInfo :: String -> String
160 versionInfo progname =
161 printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
162 progname Version.version compilerName
163 (Data.Version.showVersion compilerVersion)
166 -- | Show completion info.
167 completionInfo :: String -> [GenericOptType a] -> [ArgCompletion] -> String
168 completionInfo _ opts args =
170 map (\(Option shorts longs _ _, compinfo) ->
171 let all_opts = map (\c -> ['-', c]) shorts ++ map ("--" ++) longs
172 in intercalate "," all_opts ++ " " ++ complToText compinfo
174 map argComplToText args
176 -- | Helper for parsing a yes\/no command line flag.
177 parseYesNo :: Bool -- ^ Default value (when we get a @Nothing@)
178 -> Maybe String -- ^ Parameter value
179 -> Result Bool -- ^ Resulting boolean value
180 parseYesNo v Nothing = return v
181 parseYesNo _ (Just "yes") = return True
182 parseYesNo _ (Just "no") = return False
183 parseYesNo _ (Just s) = fail ("Invalid choice '" ++ s ++
184 "', pass one of 'yes' or 'no'")
186 -- | Helper function for required arguments which need to be converted
187 -- as opposed to stored just as string.
188 reqWithConversion :: (String -> Result a)
189 -> (a -> b -> Result b)
191 -> ArgDescr (b -> Result b)
192 reqWithConversion conversion_fn updater_fn =
193 ReqArg (\string_opt opts -> do
194 parsed_value <- conversion_fn string_opt
195 updater_fn parsed_value opts)
197 -- | Max command length when formatting command list output.
201 -- | Formats usage for a multi-personality program.
202 formatCmdUsage :: (StandardOptions a) => String -> PersonalityList a -> String
203 formatCmdUsage prog personalities =
204 let mlen = min maxCmdLen . maximum $ map (length . fst) personalities
205 sorted = sortBy (comparing fst) personalities
206 header = [ printf "Usage: %s {command} [options...] [argument...]" prog
207 , printf "%s <command> --help to see details, or man %s"
212 rows = map (\(cmd, _) ->
213 printf " %-*s" mlen cmd::String) sorted
214 in unlines $ header ++ rows
216 -- | Displays usage for a program and exits.
217 showCmdUsage :: (StandardOptions a) =>
218 String -- ^ Program name
219 -> PersonalityList a -- ^ Personality list
220 -> Bool -- ^ Whether the exit code is success or not
222 showCmdUsage prog personalities success = do
223 let usage = formatCmdUsage prog personalities
227 else exitWith $ ExitFailure C.exitFailure
229 -- | Command line parser, using a generic 'Options' structure.
230 parseOpts :: (StandardOptions a) =>
231 a -- ^ The default options
232 -> [String] -- ^ The command line arguments
233 -> String -- ^ The program name
234 -> [GenericOptType a] -- ^ The supported command line options
235 -> [ArgCompletion] -- ^ The supported command line arguments
236 -> IO (a, [String]) -- ^ The resulting options and
237 -- leftover arguments
238 parseOpts defaults argv progname options arguments =
239 case parseOptsInner defaults argv progname options arguments of
240 Left (code, msg) -> do
241 hPutStr (if code == ExitSuccess then stdout else stderr) msg
246 -- | Command line parser, for programs with sub-commands.
247 parseOptsCmds :: (StandardOptions a) =>
248 a -- ^ The default options
249 -> [String] -- ^ The command line arguments
250 -> String -- ^ The program name
251 -> PersonalityList a -- ^ The supported commands
252 -> [GenericOptType a] -- ^ Generic options
253 -> IO (a, [String], a -> [String] -> IO ())
254 -- ^ The resulting options and leftover arguments
255 parseOptsCmds defaults argv progname personalities genopts = do
256 let usage = showCmdUsage progname personalities
258 -- hardcoded option strings here!
259 "--version" -> putStrLn (versionInfo progname) >> exitSuccess
260 "--help" -> usage True
262 (cmd, cmd_args) <- case argv of
265 return (cmd', cmd_args)
267 case cmd `lookup` personalities of
268 Nothing -> usage False
269 Just (mainfn, optdefs, argdefs) -> do
271 (opts, args) <- parseOpts defaults cmd_args progname
272 (optdefs' ++ genopts) argdefs
273 return (opts, args, mainfn)
275 -- | Inner parse options. The arguments are similar to 'parseOpts',
276 -- but it returns either a 'Left' composed of exit code and message,
277 -- or a 'Right' for the success case.
278 parseOptsInner :: (StandardOptions a) =>
282 -> [GenericOptType a]
284 -> Either (ExitCode, String) (a, [String])
285 parseOptsInner defaults argv progname options arguments =
286 case getOpt Permute (map fst options) argv of
288 case foldM (flip id) defaults opts of
289 Bad msg -> Left (ExitFailure 1,
290 "Error while parsing command line arguments:\n"
293 select (Right (parsed, args))
294 [ (helpRequested parsed,
295 Left (ExitSuccess, usageHelp progname options))
296 , (verRequested parsed,
297 Left (ExitSuccess, versionInfo progname))
298 , (compRequested parsed,
299 Left (ExitSuccess, completionInfo progname options
303 Left (ExitFailure 2, "Command line error: " ++ concat errs ++ "\n" ++
304 usageHelp progname options)
306 -- | Parse command line options and execute the main function of a
307 -- multi-personality binary.
308 genericMainCmds :: (StandardOptions a) =>
311 -> [GenericOptType a]
313 genericMainCmds defaults personalities genopts = do
317 parseOptsCmds defaults cmd_args prog personalities genopts