root / Ganeti / HTools / CLI.hs @ 262a08a2
History | View | Annotate | Download (4.3 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 |
showHelp :: a -> Bool |
39 |
showVersion :: a -> Bool |
40 |
|
41 |
-- | Class for types which support the -i/-n/-m options |
42 |
class EToolOptions a where |
43 |
nodeFile :: a -> FilePath |
44 |
nodeSet :: a -> Bool |
45 |
instFile :: a -> FilePath |
46 |
instSet :: a -> Bool |
47 |
masterName :: a -> String |
48 |
silent :: a -> Bool |
49 |
|
50 |
-- | Command line parser, using the 'options' structure. |
51 |
parseOpts :: (CLIOptions b) => |
52 |
[String] -- ^ The command line arguments |
53 |
-> String -- ^ The program name |
54 |
-> [OptDescr (b -> b)] -- ^ The supported command line options |
55 |
-> b -- ^ The default options record |
56 |
-> IO (b, [String]) -- ^ The resulting options a leftover |
57 |
-- arguments |
58 |
parseOpts argv progname options defaultOptions = |
59 |
case getOpt Permute options argv of |
60 |
(o, n, []) -> |
61 |
do |
62 |
let resu@(po, _) = (foldl (flip id) defaultOptions o, n) |
63 |
when (showHelp po) $ do |
64 |
putStr $ usageInfo header options |
65 |
exitWith ExitSuccess |
66 |
when (showVersion po) $ do |
67 |
printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n" |
68 |
progname Version.version |
69 |
compilerName (Data.Version.showVersion compilerVersion) |
70 |
os arch |
71 |
exitWith ExitSuccess |
72 |
return resu |
73 |
(_, _, errs) -> |
74 |
ioError (userError (concat errs ++ usageInfo header options)) |
75 |
where header = printf "%s %s\nUsage: %s [OPTION...]" |
76 |
progname Version.version progname |
77 |
|
78 |
-- | Parse the environment and return the node/instance names. |
79 |
-- This also hardcodes here the default node/instance file names. |
80 |
parseEnv :: () -> IO (String, String) |
81 |
parseEnv () = do |
82 |
a <- getEnvDefault "HTOOLS_NODES" "nodes" |
83 |
b <- getEnvDefault "HTOOLS_INSTANCES" "instances" |
84 |
return (a, b) |
85 |
|
86 |
-- | A shell script template for autogenerated scripts |
87 |
shTemplate :: String |
88 |
shTemplate = |
89 |
printf "#!/bin/sh\n\n\ |
90 |
\# Auto-generated script for executing cluster rebalancing\n\n\ |
91 |
\# To stop, touch the file /tmp/stop-htools\n\n\ |
92 |
\set -e\n\n\ |
93 |
\check() {\n\ |
94 |
\ if [ -f /tmp/stop-htools ]; then\n\ |
95 |
\ echo 'Stop requested, exiting'\n\ |
96 |
\ exit 0\n\ |
97 |
\ fi\n\ |
98 |
\}\n\n" |
99 |
|
100 |
-- | External tool data loader from a variety of sources |
101 |
loadExternalData :: (EToolOptions a) => |
102 |
a |
103 |
-> IO (Node.List, Instance.List, String) |
104 |
loadExternalData opts = do |
105 |
(env_node, env_inst) <- parseEnv () |
106 |
let nodef = if nodeSet opts then nodeFile opts |
107 |
else env_node |
108 |
instf = if instSet opts then instFile opts |
109 |
else env_inst |
110 |
input_data <- |
111 |
case masterName opts of |
112 |
"" -> Text.loadData nodef instf |
113 |
host -> Rapi.loadData host |
114 |
|
115 |
let ldresult = input_data >>= Loader.mergeData |
116 |
(loaded_nl, il, csf) <- |
117 |
(case ldresult of |
118 |
Ok x -> return x |
119 |
Bad s -> do |
120 |
printf "Error: failed to load data. Details:\n%s\n" s |
121 |
exitWith $ ExitFailure 1 |
122 |
) |
123 |
let (fix_msgs, fixed_nl) = Loader.checkData loaded_nl il |
124 |
|
125 |
unless (null fix_msgs || silent opts) $ do |
126 |
putStrLn "Warning: cluster has inconsistent data:" |
127 |
putStrLn . unlines . map (\s -> printf " - %s" s) $ fix_msgs |
128 |
|
129 |
return (fixed_nl, il, csf) |