root / Ganeti / HTools / CLI.hs @ 8032b3b5
History | View | Annotate | Download (2.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 |
( |
11 |
parseOpts |
12 |
, parseEnv |
13 |
, showVersion |
14 |
, shTemplate |
15 |
) where |
16 |
|
17 |
import System.Console.GetOpt |
18 |
import System.Posix.Env |
19 |
import System.IO |
20 |
import System.Info |
21 |
import System |
22 |
import Monad |
23 |
import Text.Printf (printf) |
24 |
import qualified Data.Version |
25 |
|
26 |
import qualified Ganeti.HTools.Version as Version(version) |
27 |
|
28 |
-- | Command line parser, using the 'options' structure. |
29 |
parseOpts :: [String] -- ^ The command line arguments |
30 |
-> String -- ^ The program name |
31 |
-> [OptDescr (b -> b)] -- ^ The supported command line options |
32 |
-> b -- ^ The default options record |
33 |
-> (b -> Bool) -- ^ The function which given the options |
34 |
-- tells us whether we need to show help |
35 |
-> IO (b, [String]) -- ^ The resulting options a leftover |
36 |
-- arguments |
37 |
parseOpts argv progname options defaultOptions fn = |
38 |
case getOpt Permute options argv of |
39 |
(o, n, []) -> |
40 |
do |
41 |
let resu@(po, _) = (foldl (flip id) defaultOptions o, n) |
42 |
when (fn po) $ do |
43 |
putStr $ usageInfo header options |
44 |
exitWith ExitSuccess |
45 |
return resu |
46 |
(_, _, errs) -> |
47 |
ioError (userError (concat errs ++ usageInfo header options)) |
48 |
where header = printf "%s %s\nUsage: %s [OPTION...]" |
49 |
progname Version.version progname |
50 |
|
51 |
-- | Parse the environment and return the node/instance names. |
52 |
-- This also hardcodes here the default node/instance file names. |
53 |
parseEnv :: () -> IO (String, String) |
54 |
parseEnv () = do |
55 |
a <- getEnvDefault "HTOOLS_NODES" "nodes" |
56 |
b <- getEnvDefault "HTOOLS_INSTANCES" "instances" |
57 |
return (a, b) |
58 |
|
59 |
-- | Return a version string for the program |
60 |
showVersion :: String -- ^ The program name |
61 |
-> String -- ^ The formatted version and other information data |
62 |
showVersion name = |
63 |
printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n" |
64 |
name Version.version |
65 |
compilerName (Data.Version.showVersion compilerVersion) |
66 |
os arch |
67 |
|
68 |
-- | A shell script template for autogenerated scripts |
69 |
shTemplate :: String |
70 |
shTemplate = |
71 |
printf "#!/bin/sh\n\n\ |
72 |
\# Auto-generated script for executing cluster rebalancing\n\n\ |
73 |
\# To stop, touch the file /tmp/stop-htools\n\n\ |
74 |
\set -e\n\n\ |
75 |
\check() {\n\ |
76 |
\ if [ -f /tmp/stop-htools ]; then\n\ |
77 |
\ echo 'Stop requested, exiting'\n\ |
78 |
\ exit 0\n\ |
79 |
\ fi\n\ |
80 |
\}\n\n" |