Revision 559c4a98
| b/htest/Test/Ganeti/HTools/CLI.hs | ||
|---|---|---|
| 119 | 119 |
-- | Test that all binaries support some common options. |
| 120 | 120 |
case_stdopts :: Assertion |
| 121 | 121 |
case_stdopts = |
| 122 |
mapM_ (\(name, (_, o, a)) -> do |
|
| 122 |
mapM_ (\(name, (_, o, a, _)) -> do
|
|
| 123 | 123 |
o' <- o |
| 124 | 124 |
checkEarlyExit defaultOptions name |
| 125 | 125 |
(o' ++ genericOpts) a) Program.personalities |
| b/htools/Ganeti/Common.hs | ||
|---|---|---|
| 96 | 96 |
type Personality a = ( a -> [String] -> IO () -- The main function |
| 97 | 97 |
, IO [GenericOptType a] -- The options |
| 98 | 98 |
, [ArgCompletion] -- The description of args |
| 99 |
, String -- Description |
|
| 99 | 100 |
) |
| 100 | 101 |
|
| 101 | 102 |
-- | Personality lists type, common across all binaries that expose |
| ... | ... | |
| 209 | 210 |
, "" |
| 210 | 211 |
, "Commands:" |
| 211 | 212 |
] |
| 212 |
rows = map (\(cmd, _) -> |
|
| 213 |
printf " %-*s" mlen cmd::String) sorted |
|
| 213 |
rows = map (\(cmd, (_, _, _, desc)) -> |
|
| 214 |
-- FIXME: not wrapped here |
|
| 215 |
printf " %-*s - %s" mlen cmd desc::String) sorted |
|
| 214 | 216 |
in unlines $ header ++ rows |
| 215 | 217 |
|
| 216 | 218 |
-- | Displays usage for a program and exits. |
| ... | ... | |
| 266 | 268 |
[] -> usage False |
| 267 | 269 |
case cmd `lookup` personalities of |
| 268 | 270 |
Nothing -> usage False |
| 269 |
Just (mainfn, optdefs, argdefs) -> do |
|
| 271 |
Just (mainfn, optdefs, argdefs, _) -> do
|
|
| 270 | 272 |
optdefs' <- optdefs |
| 271 | 273 |
(opts, args) <- parseOpts defaults cmd_args progname |
| 272 | 274 |
(optdefs' ++ genopts) argdefs |
| b/htools/Ganeti/DataCollectors/Program.hs | ||
|---|---|---|
| 32 | 32 |
|
| 33 | 33 |
-- | Supported binaries. |
| 34 | 34 |
personalities :: PersonalityList Options |
| 35 |
personalities = [ ("drbd", (Drbd.main, Drbd.options, Drbd.arguments))
|
|
| 35 |
personalities = [ ("drbd", (Drbd.main, Drbd.options, Drbd.arguments,
|
|
| 36 |
"gathers and displays DRBD statistics in JSON\ |
|
| 37 |
\ format")) |
|
| 36 | 38 |
] |
| b/htools/Ganeti/HTools/Program.hs | ||
|---|---|---|
| 39 | 39 |
|
| 40 | 40 |
-- | Supported binaries. |
| 41 | 41 |
personalities :: PersonalityList Options |
| 42 |
personalities = [ ("hail", (Hail.main, Hail.options, Hail.arguments))
|
|
| 43 |
, ("hbal", (Hbal.main, Hbal.options, Hbal.arguments))
|
|
| 44 |
, ("hcheck", (Hcheck.main, Hcheck.options, Hcheck.arguments))
|
|
| 45 |
, ("hscan", (Hscan.main, Hscan.options, Hscan.arguments ))
|
|
| 46 |
, ("hspace", (Hspace.main, Hspace.options, Hspace.arguments))
|
|
| 47 |
, ("hinfo", (Hinfo.main, Hinfo.options, Hinfo.arguments))
|
|
| 48 |
] |
|
| 42 |
personalities = |
|
| 43 |
[ ("hail", (Hail.main, Hail.options, Hail.arguments,
|
|
| 44 |
"Ganeti IAllocator plugin that implements the instance\ |
|
| 45 |
\ placement and movement using the same algorithm as\ |
|
| 46 |
\ hbal(1)")) |
|
| 47 |
, ("hbal", (Hbal.main, Hbal.options, Hbal.arguments,
|
|
| 48 |
"cluster balancer that looks at the current state of\ |
|
| 49 |
\ the cluster and computes a series of steps designed\ |
|
| 50 |
\ to bring the cluster into a better state")) |
|
| 51 |
, ("hcheck", (Hcheck.main, Hcheck.options, Hcheck.arguments,
|
|
| 52 |
"cluster checker; prints information about cluster's\ |
|
| 53 |
\ health and checks whether a rebalance done using\ |
|
| 54 |
\ hbal would help")) |
|
| 55 |
, ("hscan", (Hscan.main, Hscan.options, Hscan.arguments,
|
|
| 56 |
"tool for scanning clusters via RAPI and saving their\ |
|
| 57 |
\ data in the input format used by hbal(1) and hspace(1)")) |
|
| 58 |
, ("hspace", (Hspace.main, Hspace.options, Hspace.arguments,
|
|
| 59 |
"computes how many additional instances can be fit on a\ |
|
| 60 |
\ cluster, while maintaining N+1 status.")) |
|
| 61 |
, ("hinfo", (Hinfo.main, Hinfo.options, Hinfo.arguments,
|
|
| 62 |
"cluster information printer; it prints information\ |
|
| 63 |
\ about the current cluster state and its residing\ |
|
| 64 |
\ nodes/instances")) |
|
| 65 |
] |
|
| b/htools/htools.hs | ||
|---|---|---|
| 54 | 54 |
boolnames = map (\(x, y) -> (x == name, Just y)) personalities |
| 55 | 55 |
case select Nothing boolnames of |
| 56 | 56 |
Nothing -> usage name |
| 57 |
Just (fn, options, arguments) -> do |
|
| 57 |
Just (fn, options, arguments, _) -> do
|
|
| 58 | 58 |
cmd_args <- getArgs |
| 59 | 59 |
real_options <- options |
| 60 | 60 |
(opts, args) <- parseOpts cmd_args name (real_options ++ genericOpts) |
Also available in: Unified diff