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