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
99 , String -- Description
102 -- | Personality lists type, common across all binaries that expose
103 -- multiple personalities.
104 type PersonalityList a = [(String, Personality a)]
106 -- | Yes\/no choices completion.
107 optComplYesNo :: OptCompletion
108 optComplYesNo = OptComplChoices ["yes", "no"]
110 -- | Text serialisation for 'OptCompletion', used on the Python side.
111 complToText :: OptCompletion -> String
112 complToText (OptComplChoices choices) = "choices=" ++ intercalate "," choices
113 complToText (OptComplSuggest choices) = "suggest=" ++ intercalate "," choices
115 let show_compl = show compl
116 stripped = stripPrefix "OptCompl" show_compl
117 in map toLower $ fromMaybe show_compl stripped
119 -- | Tex serialisation for 'ArgCompletion'.
120 argComplToText :: ArgCompletion -> String
121 argComplToText (ArgCompletion optc min_cnt max_cnt) =
122 complToText optc ++ " " ++ show min_cnt ++ " " ++ maybe "none" show max_cnt
124 -- | Abrreviation for the option type.
125 type GenericOptType a = (OptDescr (a -> Result a), OptCompletion)
127 -- | Type class for options which support help and version.
128 class StandardOptions a where
129 helpRequested :: a -> Bool
130 verRequested :: a -> Bool
131 compRequested :: a -> Bool
132 requestHelp :: a -> a
134 requestComp :: a -> a
136 -- | Option to request help output.
137 oShowHelp :: (StandardOptions a) => GenericOptType a
138 oShowHelp = (Option "h" ["help"] (NoArg (Ok . requestHelp)) "show help",
141 -- | Option to request version information.
142 oShowVer :: (StandardOptions a) => GenericOptType a
143 oShowVer = (Option "V" ["version"] (NoArg (Ok . requestVer))
144 "show the version of the program",
147 -- | Option to request completion information
148 oShowComp :: (StandardOptions a) => GenericOptType a
150 (Option "" ["help-completion"] (NoArg (Ok . requestComp) )
151 "show completion info", OptComplNone)
154 usageHelp :: String -> [GenericOptType a] -> String
156 usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
157 progname Version.version progname) . map fst
159 -- | Show the program version info.
160 versionInfo :: String -> String
161 versionInfo progname =
162 printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
163 progname Version.version compilerName
164 (Data.Version.showVersion compilerVersion)
167 -- | Show completion info.
168 completionInfo :: String -> [GenericOptType a] -> [ArgCompletion] -> String
169 completionInfo _ opts args =
171 map (\(Option shorts longs _ _, compinfo) ->
172 let all_opts = map (\c -> ['-', c]) shorts ++ map ("--" ++) longs
173 in intercalate "," all_opts ++ " " ++ complToText compinfo
175 map argComplToText args
177 -- | Helper for parsing a yes\/no command line flag.
178 parseYesNo :: Bool -- ^ Default value (when we get a @Nothing@)
179 -> Maybe String -- ^ Parameter value
180 -> Result Bool -- ^ Resulting boolean value
181 parseYesNo v Nothing = return v
182 parseYesNo _ (Just "yes") = return True
183 parseYesNo _ (Just "no") = return False
184 parseYesNo _ (Just s) = fail ("Invalid choice '" ++ s ++
185 "', pass one of 'yes' or 'no'")
187 -- | Helper function for required arguments which need to be converted
188 -- as opposed to stored just as string.
189 reqWithConversion :: (String -> Result a)
190 -> (a -> b -> Result b)
192 -> ArgDescr (b -> Result b)
193 reqWithConversion conversion_fn updater_fn =
194 ReqArg (\string_opt opts -> do
195 parsed_value <- conversion_fn string_opt
196 updater_fn parsed_value opts)
198 -- | Max command length when formatting command list output.
202 -- | Formats usage for a multi-personality program.
203 formatCmdUsage :: (StandardOptions a) => String -> PersonalityList a -> String
204 formatCmdUsage prog personalities =
205 let mlen = min maxCmdLen . maximum $ map (length . fst) personalities
206 sorted = sortBy (comparing fst) personalities
207 header = [ printf "Usage: %s {command} [options...] [argument...]" prog
208 , printf "%s <command> --help to see details, or man %s"
213 rows = map (\(cmd, (_, _, _, desc)) ->
214 -- FIXME: not wrapped here
215 printf " %-*s - %s" mlen cmd desc::String) sorted
216 in unlines $ header ++ rows
218 -- | Displays usage for a program and exits.
219 showCmdUsage :: (StandardOptions a) =>
220 String -- ^ Program name
221 -> PersonalityList a -- ^ Personality list
222 -> Bool -- ^ Whether the exit code is success or not
224 showCmdUsage prog personalities success = do
225 let usage = formatCmdUsage prog personalities
229 else exitWith $ ExitFailure C.exitFailure
231 -- | Command line parser, using a generic 'Options' structure.
232 parseOpts :: (StandardOptions a) =>
233 a -- ^ The default options
234 -> [String] -- ^ The command line arguments
235 -> String -- ^ The program name
236 -> [GenericOptType a] -- ^ The supported command line options
237 -> [ArgCompletion] -- ^ The supported command line arguments
238 -> IO (a, [String]) -- ^ The resulting options and
239 -- leftover arguments
240 parseOpts defaults argv progname options arguments =
241 case parseOptsInner defaults argv progname options arguments of
242 Left (code, msg) -> do
243 hPutStr (if code == ExitSuccess then stdout else stderr) msg
248 -- | Command line parser, for programs with sub-commands.
249 parseOptsCmds :: (StandardOptions a) =>
250 a -- ^ The default options
251 -> [String] -- ^ The command line arguments
252 -> String -- ^ The program name
253 -> PersonalityList a -- ^ The supported commands
254 -> [GenericOptType a] -- ^ Generic options
255 -> IO (a, [String], a -> [String] -> IO ())
256 -- ^ The resulting options and leftover arguments
257 parseOptsCmds defaults argv progname personalities genopts = do
258 let usage = showCmdUsage progname personalities
260 -- hardcoded option strings here!
261 "--version" -> putStrLn (versionInfo progname) >> exitSuccess
262 "--help" -> usage True
264 (cmd, cmd_args) <- case argv of
267 return (cmd', cmd_args)
269 case cmd `lookup` personalities of
270 Nothing -> usage False
271 Just (mainfn, optdefs, argdefs, _) -> do
273 (opts, args) <- parseOpts defaults cmd_args progname
274 (optdefs' ++ genopts) argdefs
275 return (opts, args, mainfn)
277 -- | Inner parse options. The arguments are similar to 'parseOpts',
278 -- but it returns either a 'Left' composed of exit code and message,
279 -- or a 'Right' for the success case.
280 parseOptsInner :: (StandardOptions a) =>
284 -> [GenericOptType a]
286 -> Either (ExitCode, String) (a, [String])
287 parseOptsInner defaults argv progname options arguments =
288 case getOpt Permute (map fst options) argv of
290 case foldM (flip id) defaults opts of
291 Bad msg -> Left (ExitFailure 1,
292 "Error while parsing command line arguments:\n"
295 select (Right (parsed, args))
296 [ (helpRequested parsed,
297 Left (ExitSuccess, usageHelp progname options))
298 , (verRequested parsed,
299 Left (ExitSuccess, versionInfo progname))
300 , (compRequested parsed,
301 Left (ExitSuccess, completionInfo progname options
305 Left (ExitFailure 2, "Command line error: " ++ concat errs ++ "\n" ++
306 usageHelp progname options)
308 -- | Parse command line options and execute the main function of a
309 -- multi-personality binary.
310 genericMainCmds :: (StandardOptions a) =>
313 -> [GenericOptType a]
315 genericMainCmds defaults personalities genopts = do
319 parseOptsCmds defaults cmd_args prog personalities genopts