root / Ganeti / HTools / CLI.hs @ 9188aeef
History | View | Annotate | Download (4.7 kB)
1 |
{-| Implementation of command-line functions. |
---|---|
2 |
|
3 |
This module holds the common cli-related functions for the binaries, |
4 |
separated into this module since Utils.hs is used in many other places |
5 |
and this is more IO oriented. |
6 |
|
7 |
-} |
8 |
|
9 |
module Ganeti.HTools.CLI |
10 |
( CLIOptions(..) |
11 |
, EToolOptions(..) |
12 |
, parseOpts |
13 |
, parseEnv |
14 |
, shTemplate |
15 |
, loadExternalData |
16 |
) where |
17 |
|
18 |
import System.Console.GetOpt |
19 |
import System.Posix.Env |
20 |
import System.IO |
21 |
import System.Info |
22 |
import System |
23 |
import Monad |
24 |
import Text.Printf (printf) |
25 |
import qualified Data.Version |
26 |
|
27 |
import qualified Ganeti.HTools.Version as Version(version) |
28 |
import qualified Ganeti.HTools.Rapi as Rapi |
29 |
import qualified Ganeti.HTools.Text as Text |
30 |
import qualified Ganeti.HTools.Loader as Loader |
31 |
import qualified Ganeti.HTools.Instance as Instance |
32 |
import qualified Ganeti.HTools.Node as Node |
33 |
|
34 |
import Ganeti.HTools.Types |
35 |
|
36 |
-- | Class for types which support show help and show version. |
37 |
class CLIOptions a where |
38 |
-- | Denotes whether the show help option has been passed. |
39 |
showHelp :: a -> Bool |
40 |
-- | Denotes whether the show version option has been passed. |
41 |
showVersion :: a -> Bool |
42 |
|
43 |
-- | Class for types which support the -i\/-n\/-m options. |
44 |
class EToolOptions a where |
45 |
-- | Returns the node file name. |
46 |
nodeFile :: a -> FilePath |
47 |
-- | Tells whether the node file has been passed as an option. |
48 |
nodeSet :: a -> Bool |
49 |
-- | Returns the instance file name. |
50 |
instFile :: a -> FilePath |
51 |
-- | Tells whether the instance file has been passed as an option. |
52 |
instSet :: a -> Bool |
53 |
-- | Rapi target, if one has been passed. |
54 |
masterName :: a -> String |
55 |
-- | Whether to be less verbose. |
56 |
silent :: a -> Bool |
57 |
|
58 |
-- | Command line parser, using the 'options' structure. |
59 |
parseOpts :: (CLIOptions b) => |
60 |
[String] -- ^ The command line arguments |
61 |
-> String -- ^ The program name |
62 |
-> [OptDescr (b -> b)] -- ^ The supported command line options |
63 |
-> b -- ^ The default options record |
64 |
-> IO (b, [String]) -- ^ The resulting options a leftover |
65 |
-- arguments |
66 |
parseOpts argv progname options defaultOptions = |
67 |
case getOpt Permute options argv of |
68 |
(o, n, []) -> |
69 |
do |
70 |
let resu@(po, _) = (foldl (flip id) defaultOptions o, n) |
71 |
when (showHelp po) $ do |
72 |
putStr $ usageInfo header options |
73 |
exitWith ExitSuccess |
74 |
when (showVersion po) $ do |
75 |
printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n" |
76 |
progname Version.version |
77 |
compilerName (Data.Version.showVersion compilerVersion) |
78 |
os arch |
79 |
exitWith ExitSuccess |
80 |
return resu |
81 |
(_, _, errs) -> |
82 |
ioError (userError (concat errs ++ usageInfo header options)) |
83 |
where header = printf "%s %s\nUsage: %s [OPTION...]" |
84 |
progname Version.version progname |
85 |
|
86 |
-- | Parse the environment and return the node\/instance names. |
87 |
-- |
88 |
-- This also hardcodes here the default node\/instance file names. |
89 |
parseEnv :: () -> IO (String, String) |
90 |
parseEnv () = do |
91 |
a <- getEnvDefault "HTOOLS_NODES" "nodes" |
92 |
b <- getEnvDefault "HTOOLS_INSTANCES" "instances" |
93 |
return (a, b) |
94 |
|
95 |
-- | A shell script template for autogenerated scripts. |
96 |
shTemplate :: String |
97 |
shTemplate = |
98 |
printf "#!/bin/sh\n\n\ |
99 |
\# Auto-generated script for executing cluster rebalancing\n\n\ |
100 |
\# To stop, touch the file /tmp/stop-htools\n\n\ |
101 |
\set -e\n\n\ |
102 |
\check() {\n\ |
103 |
\ if [ -f /tmp/stop-htools ]; then\n\ |
104 |
\ echo 'Stop requested, exiting'\n\ |
105 |
\ exit 0\n\ |
106 |
\ fi\n\ |
107 |
\}\n\n" |
108 |
|
109 |
-- | External tool data loader from a variety of sources. |
110 |
loadExternalData :: (EToolOptions a) => |
111 |
a |
112 |
-> IO (Node.List, Instance.List, String) |
113 |
loadExternalData opts = do |
114 |
(env_node, env_inst) <- parseEnv () |
115 |
let nodef = if nodeSet opts then nodeFile opts |
116 |
else env_node |
117 |
instf = if instSet opts then instFile opts |
118 |
else env_inst |
119 |
input_data <- |
120 |
case masterName opts of |
121 |
"" -> Text.loadData nodef instf |
122 |
host -> Rapi.loadData host |
123 |
|
124 |
let ldresult = input_data >>= Loader.mergeData |
125 |
(loaded_nl, il, csf) <- |
126 |
(case ldresult of |
127 |
Ok x -> return x |
128 |
Bad s -> do |
129 |
printf "Error: failed to load data. Details:\n%s\n" s |
130 |
exitWith $ ExitFailure 1 |
131 |
) |
132 |
let (fix_msgs, fixed_nl) = Loader.checkData loaded_nl il |
133 |
|
134 |
unless (null fix_msgs || silent opts) $ do |
135 |
putStrLn "Warning: cluster has inconsistent data:" |
136 |
putStrLn . unlines . map (\s -> printf " - %s" s) $ fix_msgs |
137 |
|
138 |
return (fixed_nl, il, csf) |