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
47 import Control.Monad (foldM)
48 import Data.Char (toLower)
49 import Data.List (intercalate, stripPrefix)
50 import Data.Maybe (fromMaybe)
51 import qualified Data.Version
52 import System.Console.GetOpt
56 import Text.Printf (printf)
58 import Ganeti.BasicTypes
59 import qualified Ganeti.Version as Version (version)
62 data OptCompletion = OptComplNone -- ^ No parameter to this option
63 | OptComplFile -- ^ An existing file
64 | OptComplDir -- ^ An existing directory
65 | OptComplHost -- ^ Host name
66 | OptComplInetAddr -- ^ One ipv4\/ipv6 address
67 | OptComplOneNode -- ^ One node
68 | OptComplManyNodes -- ^ Many nodes, comma-sep
69 | OptComplOneInstance -- ^ One instance
70 | OptComplManyInstances -- ^ Many instances, comma-sep
71 | OptComplOneOs -- ^ One OS name
72 | OptComplOneIallocator -- ^ One iallocator
73 | OptComplInstAddNodes -- ^ Either one or two nodes
74 | OptComplOneGroup -- ^ One group
75 | OptComplInteger -- ^ Integer values
76 | OptComplFloat -- ^ Float values
77 | OptComplJobId -- ^ Job Id
78 | OptComplCommand -- ^ Command (executable)
79 | OptComplString -- ^ Arbitrary string
80 | OptComplChoices [String] -- ^ List of string choices
81 | OptComplSuggest [String] -- ^ Suggested choices
84 -- | Argument type. This differs from (and wraps) an Option by the
85 -- fact that it can (and usually does) support multiple repetitions of
86 -- the same argument, via a min and max limit.
87 data ArgCompletion = ArgCompletion OptCompletion Int (Maybe Int)
90 -- | A personality definition.
91 type Personality a = ( a -> [String] -> IO () -- The main function
92 , IO [GenericOptType a] -- The options
93 , [ArgCompletion] -- The description of args
96 -- | Personality lists type, common across all binaries that expose
97 -- multiple personalities.
98 type PersonalityList a = [(String, Personality a)]
100 -- | Yes\/no choices completion.
101 optComplYesNo :: OptCompletion
102 optComplYesNo = OptComplChoices ["yes", "no"]
104 -- | Text serialisation for 'OptCompletion', used on the Python side.
105 complToText :: OptCompletion -> String
106 complToText (OptComplChoices choices) = "choices=" ++ intercalate "," choices
107 complToText (OptComplSuggest choices) = "suggest=" ++ intercalate "," choices
109 let show_compl = show compl
110 stripped = stripPrefix "OptCompl" show_compl
111 in map toLower $ fromMaybe show_compl stripped
113 -- | Tex serialisation for 'ArgCompletion'.
114 argComplToText :: ArgCompletion -> String
115 argComplToText (ArgCompletion optc min_cnt max_cnt) =
116 complToText optc ++ " " ++ show min_cnt ++ " " ++ maybe "none" show max_cnt
118 -- | Abrreviation for the option type.
119 type GenericOptType a = (OptDescr (a -> Result a), OptCompletion)
121 -- | Type class for options which support help and version.
122 class StandardOptions a where
123 helpRequested :: a -> Bool
124 verRequested :: a -> Bool
125 compRequested :: a -> Bool
126 requestHelp :: a -> a
128 requestComp :: a -> a
130 -- | Option to request help output.
131 oShowHelp :: (StandardOptions a) => GenericOptType a
132 oShowHelp = (Option "h" ["help"] (NoArg (Ok . requestHelp)) "show help",
135 -- | Option to request version information.
136 oShowVer :: (StandardOptions a) => GenericOptType a
137 oShowVer = (Option "V" ["version"] (NoArg (Ok . requestVer))
138 "show the version of the program",
141 -- | Option to request completion information
142 oShowComp :: (StandardOptions a) => GenericOptType a
144 (Option "" ["help-completion"] (NoArg (Ok . requestComp) )
145 "show completion info", OptComplNone)
148 usageHelp :: String -> [GenericOptType a] -> String
150 usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
151 progname Version.version progname) . map fst
153 -- | Show the program version info.
154 versionInfo :: String -> String
155 versionInfo progname =
156 printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
157 progname Version.version compilerName
158 (Data.Version.showVersion compilerVersion)
161 -- | Show completion info.
162 completionInfo :: String -> [GenericOptType a] -> [ArgCompletion] -> String
163 completionInfo _ opts args =
165 map (\(Option shorts longs _ _, compinfo) ->
166 let all_opts = map (\c -> ['-', c]) shorts ++ map ("--" ++) longs
167 in intercalate "," all_opts ++ " " ++ complToText compinfo
169 map argComplToText args
171 -- | Helper for parsing a yes\/no command line flag.
172 parseYesNo :: Bool -- ^ Default value (when we get a @Nothing@)
173 -> Maybe String -- ^ Parameter value
174 -> Result Bool -- ^ Resulting boolean value
175 parseYesNo v Nothing = return v
176 parseYesNo _ (Just "yes") = return True
177 parseYesNo _ (Just "no") = return False
178 parseYesNo _ (Just s) = fail ("Invalid choice '" ++ s ++
179 "', pass one of 'yes' or 'no'")
181 -- | Helper function for required arguments which need to be converted
182 -- as opposed to stored just as string.
183 reqWithConversion :: (String -> Result a)
184 -> (a -> b -> Result b)
186 -> ArgDescr (b -> Result b)
187 reqWithConversion conversion_fn updater_fn =
188 ReqArg (\string_opt opts -> do
189 parsed_value <- conversion_fn string_opt
190 updater_fn parsed_value opts)
192 -- | Command line parser, using a generic 'Options' structure.
193 parseOpts :: (StandardOptions a) =>
194 a -- ^ The default options
195 -> [String] -- ^ The command line arguments
196 -> String -- ^ The program name
197 -> [GenericOptType a] -- ^ The supported command line options
198 -> [ArgCompletion] -- ^ The supported command line arguments
199 -> IO (a, [String]) -- ^ The resulting options and
200 -- leftover arguments
201 parseOpts defaults argv progname options arguments =
202 case parseOptsInner defaults argv progname options arguments of
203 Left (code, msg) -> do
204 hPutStr (if code == ExitSuccess then stdout else stderr) msg
209 -- | Inner parse options. The arguments are similar to 'parseOpts',
210 -- but it returns either a 'Left' composed of exit code and message,
211 -- or a 'Right' for the success case.
212 parseOptsInner :: (StandardOptions a) =>
216 -> [GenericOptType a]
218 -> Either (ExitCode, String) (a, [String])
219 parseOptsInner defaults argv progname options arguments =
220 case getOpt Permute (map fst options) argv of
222 case foldM (flip id) defaults opts of
223 Bad msg -> Left (ExitFailure 1,
224 "Error while parsing command line arguments:\n"
227 select (Right (parsed, args))
228 [ (helpRequested parsed,
229 Left (ExitSuccess, usageHelp progname options))
230 , (verRequested parsed,
231 Left (ExitSuccess, versionInfo progname))
232 , (compRequested parsed,
233 Left (ExitSuccess, completionInfo progname options
237 Left (ExitFailure 2, "Command line error: " ++ concat errs ++ "\n" ++
238 usageHelp progname options)