Revision 51000365
b/Makefile.am | ||
---|---|---|
412 | 412 |
htools/Ganeti/HTools/Program/Hscan.hs \ |
413 | 413 |
htools/Ganeti/HTools/Program/Hspace.hs \ |
414 | 414 |
htools/Ganeti/BasicTypes.hs \ |
415 |
htools/Ganeti/Common.hs \ |
|
415 | 416 |
htools/Ganeti/Compat.hs \ |
416 | 417 |
htools/Ganeti/Confd.hs \ |
417 | 418 |
htools/Ganeti/Confd/Server.hs \ |
... | ... | |
439 | 440 |
|
440 | 441 |
HS_TEST_SRCS = \ |
441 | 442 |
htest/Test/Ganeti/BasicTypes.hs \ |
443 |
htest/Test/Ganeti/Common.hs \ |
|
444 |
htest/Test/Ganeti/Daemon.hs \ |
|
442 | 445 |
htest/Test/Ganeti/Confd/Utils.hs \ |
443 | 446 |
htest/Test/Ganeti/HTools/CLI.hs \ |
444 | 447 |
htest/Test/Ganeti/HTools/Cluster.hs \ |
b/htest/Test/Ganeti/Common.hs | ||
---|---|---|
1 |
{-# LANGUAGE TemplateHaskell #-} |
|
2 |
{-# OPTIONS_GHC -fno-warn-orphans #-} |
|
3 |
|
|
4 |
{-| Unittests for the 'Ganeti.Common' module. |
|
5 |
|
|
6 |
-} |
|
7 |
|
|
8 |
{- |
|
9 |
|
|
10 |
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
|
11 |
|
|
12 |
This program is free software; you can redistribute it and/or modify |
|
13 |
it under the terms of the GNU General Public License as published by |
|
14 |
the Free Software Foundation; either version 2 of the License, or |
|
15 |
(at your option) any later version. |
|
16 |
|
|
17 |
This program is distributed in the hope that it will be useful, but |
|
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
20 |
General Public License for more details. |
|
21 |
|
|
22 |
You should have received a copy of the GNU General Public License |
|
23 |
along with this program; if not, write to the Free Software |
|
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
25 |
02110-1301, USA. |
|
26 |
|
|
27 |
-} |
|
28 |
|
|
29 |
module Test.Ganeti.Common |
|
30 |
( testCommon |
|
31 |
, checkOpt |
|
32 |
, passFailOpt |
|
33 |
, checkEarlyExit |
|
34 |
) where |
|
35 |
|
|
36 |
import Test.QuickCheck hiding (Result) |
|
37 |
import Test.HUnit |
|
38 |
|
|
39 |
import qualified System.Console.GetOpt as GetOpt |
|
40 |
import System.Exit |
|
41 |
|
|
42 |
import Test.Ganeti.TestHelper |
|
43 |
import Test.Ganeti.TestCommon |
|
44 |
|
|
45 |
import Ganeti.BasicTypes |
|
46 |
import Ganeti.Common |
|
47 |
|
|
48 |
-- | Helper to check for correct parsing of an option. |
|
49 |
checkOpt :: (StandardOptions b) => |
|
50 |
(a -> Maybe String) -- ^ Converts the value into a cmdline form |
|
51 |
-> b -- ^ The default options |
|
52 |
-> (String -> c) -- ^ Fail test function |
|
53 |
-> (String -> d -> d -> c) -- ^ Check for equality function |
|
54 |
-> (a -> d) -- ^ Transforms the value to a compare val |
|
55 |
-> (a, GenericOptType b, b -> d) -- ^ Triple of value, the |
|
56 |
-- option, function to |
|
57 |
-- extract the set value |
|
58 |
-- from the options |
|
59 |
-> c |
|
60 |
checkOpt repr defaults failfn eqcheck valfn |
|
61 |
(val, opt@(GetOpt.Option _ longs _ _), fn) = |
|
62 |
case longs of |
|
63 |
[] -> failfn "no long options?" |
|
64 |
cmdarg:_ -> |
|
65 |
case parseOptsInner defaults |
|
66 |
["--" ++ cmdarg ++ maybe "" ("=" ++) (repr val)] |
|
67 |
"prog" [opt] of |
|
68 |
Left e -> failfn $ "Failed to parse option '" ++ cmdarg ++ ": " ++ |
|
69 |
show e |
|
70 |
Right (options, _) -> eqcheck ("Wrong value in option " ++ |
|
71 |
cmdarg ++ "?") (valfn val) (fn options) |
|
72 |
|
|
73 |
-- | Helper to check for correct and incorrect parsing of an option. |
|
74 |
passFailOpt :: (StandardOptions b) => |
|
75 |
b -- ^ The default options |
|
76 |
-> (String -> c) -- ^ Fail test function |
|
77 |
-> c -- ^ Pass function |
|
78 |
-> (GenericOptType b, String, String) |
|
79 |
-- ^ The list of enabled options, fail value and pass value |
|
80 |
-> c |
|
81 |
passFailOpt defaults failfn passfn |
|
82 |
(opt@(GetOpt.Option _ longs _ _), bad, good) = |
|
83 |
let prefix = "--" ++ head longs ++ "=" |
|
84 |
good_cmd = prefix ++ good |
|
85 |
bad_cmd = prefix ++ bad in |
|
86 |
case (parseOptsInner defaults [bad_cmd] "prog" [opt], |
|
87 |
parseOptsInner defaults [good_cmd] "prog" [opt]) of |
|
88 |
(Left _, Right _) -> passfn |
|
89 |
(Right _, Right _) -> failfn $ "Command line '" ++ bad_cmd ++ |
|
90 |
"' succeeded when it shouldn't" |
|
91 |
(Left _, Left _) -> failfn $ "Command line '" ++ good_cmd ++ |
|
92 |
"' failed when it shouldn't" |
|
93 |
(Right _, Left _) -> |
|
94 |
failfn $ "Command line '" ++ bad_cmd ++ |
|
95 |
"' succeeded when it shouldn't, while command line '" ++ |
|
96 |
good_cmd ++ "' failed when it shouldn't" |
|
97 |
|
|
98 |
-- | Helper to test that a given option is accepted OK with quick exit. |
|
99 |
checkEarlyExit :: (StandardOptions a) => |
|
100 |
a -> String -> [GenericOptType a] -> Assertion |
|
101 |
checkEarlyExit defaults name options = |
|
102 |
mapM_ (\param -> |
|
103 |
case parseOptsInner defaults [param] name options of |
|
104 |
Left (code, _) -> |
|
105 |
assertEqual ("Program " ++ name ++ |
|
106 |
" returns invalid code " ++ show code ++ |
|
107 |
" for option " ++ param) ExitSuccess code |
|
108 |
_ -> assertFailure $ "Program " ++ name ++ |
|
109 |
" doesn't consider option " ++ |
|
110 |
param ++ " as early exit one" |
|
111 |
) ["-h", "--help", "-V", "--version"] |
|
112 |
|
|
113 |
-- | Test parseYesNo. |
|
114 |
prop_parse_yes_no :: Bool -> Bool -> String -> Property |
|
115 |
prop_parse_yes_no def testval val = |
|
116 |
forAll (elements [val, "yes", "no"]) $ \actual_val -> |
|
117 |
if testval |
|
118 |
then parseYesNo def Nothing ==? Ok def |
|
119 |
else let result = parseYesNo def (Just actual_val) |
|
120 |
in if actual_val `elem` ["yes", "no"] |
|
121 |
then result ==? Ok (actual_val == "yes") |
|
122 |
else property $ isBad result |
|
123 |
|
|
124 |
|
|
125 |
testSuite "Common" |
|
126 |
[ 'prop_parse_yes_no |
|
127 |
] |
b/htest/Test/Ganeti/Daemon.hs | ||
---|---|---|
1 |
{-# LANGUAGE TemplateHaskell #-} |
|
2 |
{-# OPTIONS_GHC -fno-warn-orphans #-} |
|
3 |
|
|
4 |
{-| Unittests for ganeti-htools. |
|
5 |
|
|
6 |
-} |
|
7 |
|
|
8 |
{- |
|
9 |
|
|
10 |
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
|
11 |
|
|
12 |
This program is free software; you can redistribute it and/or modify |
|
13 |
it under the terms of the GNU General Public License as published by |
|
14 |
the Free Software Foundation; either version 2 of the License, or |
|
15 |
(at your option) any later version. |
|
16 |
|
|
17 |
This program is distributed in the hope that it will be useful, but |
|
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
20 |
General Public License for more details. |
|
21 |
|
|
22 |
You should have received a copy of the GNU General Public License |
|
23 |
along with this program; if not, write to the Free Software |
|
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
25 |
02110-1301, USA. |
|
26 |
|
|
27 |
-} |
|
28 |
|
|
29 |
module Test.Ganeti.Daemon (testDaemon) where |
|
30 |
|
|
31 |
import Test.QuickCheck hiding (Result) |
|
32 |
import Test.HUnit |
|
33 |
|
|
34 |
import Test.Ganeti.TestHelper |
|
35 |
import Test.Ganeti.TestCommon |
|
36 |
import Test.Ganeti.Common |
|
37 |
|
|
38 |
import Ganeti.Common |
|
39 |
import Ganeti.Daemon as Daemon |
|
40 |
|
|
41 |
-- | Test a few string arguments. |
|
42 |
prop_string_arg :: String -> Property |
|
43 |
prop_string_arg argument = |
|
44 |
let args = [ (argument, oBindAddress, optBindAddress) |
|
45 |
] |
|
46 |
in conjoin $ |
|
47 |
map (checkOpt Just defaultOptions failTest (const (==?)) Just) args |
|
48 |
|
|
49 |
-- | Test a few integer arguments (only one for now). |
|
50 |
prop_numeric_arg :: Int -> Property |
|
51 |
prop_numeric_arg argument = |
|
52 |
checkOpt (Just . show) defaultOptions |
|
53 |
failTest (const (==?)) (Just . fromIntegral) |
|
54 |
(argument, oPort 0, optPort) |
|
55 |
|
|
56 |
-- | Test a few boolean arguments. |
|
57 |
case_bool_arg :: Assertion |
|
58 |
case_bool_arg = |
|
59 |
mapM_ (checkOpt (const Nothing) defaultOptions assertFailure |
|
60 |
assertEqual id) |
|
61 |
[ (False, oNoDaemonize, optDaemonize) |
|
62 |
, (True, oDebug, optDebug) |
|
63 |
, (True, oNoUserChecks, optNoUserChecks) |
|
64 |
] |
|
65 |
|
|
66 |
-- | Tests a few invalid arguments. |
|
67 |
case_wrong_arg :: Assertion |
|
68 |
case_wrong_arg = do |
|
69 |
mapM_ (passFailOpt defaultOptions assertFailure (return ())) |
|
70 |
[ (oSyslogUsage, "foo", "yes") |
|
71 |
, (oPort 0, "x", "10") |
|
72 |
] |
|
73 |
|
|
74 |
-- | Test that the option list supports some common options. |
|
75 |
case_stdopts :: Assertion |
|
76 |
case_stdopts = |
|
77 |
checkEarlyExit defaultOptions "prog" [oShowHelp, oShowVer] |
|
78 |
|
|
79 |
testSuite "Daemon" |
|
80 |
[ 'prop_string_arg |
|
81 |
, 'prop_numeric_arg |
|
82 |
, 'case_bool_arg |
|
83 |
, 'case_wrong_arg |
|
84 |
, 'case_stdopts |
|
85 |
] |
b/htest/Test/Ganeti/HTools/CLI.hs | ||
---|---|---|
28 | 28 |
|
29 | 29 |
module Test.Ganeti.HTools.CLI (testHTools_CLI) where |
30 | 30 |
|
31 |
import Test.HUnit |
|
31 | 32 |
import Test.QuickCheck |
32 | 33 |
|
33 | 34 |
import Control.Monad |
34 | 35 |
import Data.List |
35 | 36 |
import Text.Printf (printf) |
36 |
import qualified System.Console.GetOpt as GetOpt |
|
37 | 37 |
|
38 | 38 |
import Test.Ganeti.TestHelper |
39 | 39 |
import Test.Ganeti.TestCommon |
40 |
import Test.Ganeti.Common |
|
40 | 41 |
|
41 |
import qualified Ganeti.HTools.CLI as CLI
|
|
42 |
import Ganeti.HTools.CLI as CLI |
|
42 | 43 |
import qualified Ganeti.HTools.Program as Program |
43 | 44 |
import qualified Ganeti.HTools.Types as Types |
44 | 45 |
|
... | ... | |
46 | 47 |
prop_parseISpec :: String -> Int -> Int -> Int -> Property |
47 | 48 |
prop_parseISpec descr dsk mem cpu = |
48 | 49 |
let str = printf "%d,%d,%d" dsk mem cpu::String |
49 |
in CLI.parseISpecString descr str ==? Types.Ok (Types.RSpec cpu mem dsk)
|
|
50 |
in parseISpecString descr str ==? Types.Ok (Types.RSpec cpu mem dsk) |
|
50 | 51 |
|
51 | 52 |
-- | Test parsing failure due to wrong section count. |
52 | 53 |
prop_parseISpecFail :: String -> Property |
... | ... | |
54 | 55 |
forAll (choose (0,100) `suchThat` ((/=) 3)) $ \nelems -> |
55 | 56 |
forAll (replicateM nelems arbitrary) $ \values -> |
56 | 57 |
let str = intercalate "," $ map show (values::[Int]) |
57 |
in case CLI.parseISpecString descr str of
|
|
58 |
in case parseISpecString descr str of |
|
58 | 59 |
Types.Ok v -> failTest $ "Expected failure, got " ++ show v |
59 | 60 |
_ -> passTest |
60 | 61 |
|
61 |
-- | Test parseYesNo. |
|
62 |
prop_parseYesNo :: Bool -> Bool -> [Char] -> Property |
|
63 |
prop_parseYesNo def testval val = |
|
64 |
forAll (elements [val, "yes", "no"]) $ \actual_val -> |
|
65 |
if testval |
|
66 |
then CLI.parseYesNo def Nothing ==? Types.Ok def |
|
67 |
else let result = CLI.parseYesNo def (Just actual_val) |
|
68 |
in if actual_val `elem` ["yes", "no"] |
|
69 |
then result ==? Types.Ok (actual_val == "yes") |
|
70 |
else property $ Types.isBad result |
|
71 |
|
|
72 |
-- | Helper to check for correct parsing of string arg. |
|
73 |
checkStringArg :: [Char] |
|
74 |
-> (GetOpt.OptDescr (CLI.Options -> Types.Result CLI.Options), |
|
75 |
CLI.Options -> Maybe [Char]) |
|
76 |
-> Property |
|
77 |
checkStringArg val (opt, fn) = |
|
78 |
let GetOpt.Option _ longs _ _ = opt |
|
79 |
in case longs of |
|
80 |
[] -> failTest "no long options?" |
|
81 |
cmdarg:_ -> |
|
82 |
case CLI.parseOptsInner ["--" ++ cmdarg ++ "=" ++ val] "prog" [opt] of |
|
83 |
Left e -> failTest $ "Failed to parse option: " ++ show e |
|
84 |
Right (options, _) -> fn options ==? Just val |
|
85 |
|
|
86 | 62 |
-- | Test a few string arguments. |
87 |
prop_StringArg :: [Char] -> Property |
|
88 |
prop_StringArg argument = |
|
89 |
let args = [ (CLI.oDataFile, CLI.optDataFile) |
|
90 |
, (CLI.oDynuFile, CLI.optDynuFile) |
|
91 |
, (CLI.oSaveCluster, CLI.optSaveCluster) |
|
92 |
, (CLI.oReplay, CLI.optReplay) |
|
93 |
, (CLI.oPrintCommands, CLI.optShowCmds) |
|
94 |
, (CLI.oLuxiSocket, CLI.optLuxi) |
|
63 |
prop_string_arg :: String -> Property |
|
64 |
prop_string_arg argument = |
|
65 |
let args = [ (oDataFile, optDataFile) |
|
66 |
, (oDynuFile, optDynuFile) |
|
67 |
, (oSaveCluster, optSaveCluster) |
|
68 |
, (oPrintCommands, optShowCmds) |
|
69 |
, (oLuxiSocket, optLuxi) |
|
70 |
, (oIAllocSrc, optIAllocSrc) |
|
71 |
] |
|
72 |
in conjoin $ map (\(o, opt) -> |
|
73 |
checkOpt Just defaultOptions |
|
74 |
failTest (const (==?)) Just (argument, o, opt)) args |
|
75 |
|
|
76 |
-- | Test a few positive arguments. |
|
77 |
prop_numeric_arg :: Positive Double -> Property |
|
78 |
prop_numeric_arg (Positive argument) = |
|
79 |
let args = [ (oMaxCpu, optMcpu) |
|
80 |
, (oMinDisk, Just . optMdsk) |
|
81 |
, (oMinGain, Just . optMinGain) |
|
82 |
, (oMinGainLim, Just . optMinGainLim) |
|
83 |
, (oMinScore, Just . optMinScore) |
|
95 | 84 |
] |
96 |
in conjoin $ map (checkStringArg argument) args |
|
97 |
|
|
98 |
-- | Helper to test that a given option is accepted OK with quick exit. |
|
99 |
checkEarlyExit :: String -> [CLI.OptType] -> String -> Property |
|
100 |
checkEarlyExit name options param = |
|
101 |
case CLI.parseOptsInner [param] name options of |
|
102 |
Left (code, _) -> |
|
103 |
printTestCase ("Program " ++ name ++ |
|
104 |
" returns invalid code " ++ show code ++ |
|
105 |
" for option " ++ param) (code == 0) |
|
106 |
_ -> failTest $ "Program " ++ name ++ " doesn't consider option " ++ |
|
107 |
param ++ " as early exit one" |
|
108 |
|
|
109 |
-- | Test that all binaries support some common options. There is |
|
110 |
-- nothing actually random about this test... |
|
111 |
prop_stdopts :: Property |
|
112 |
prop_stdopts = |
|
113 |
let params = ["-h", "--help", "-V", "--version"] |
|
114 |
opts = map (\(name, (_, o)) -> (name, o)) Program.personalities |
|
115 |
-- apply checkEarlyExit across the cartesian product of params and opts |
|
116 |
in conjoin [checkEarlyExit n o p | p <- params, (n, o) <- opts] |
|
85 |
in conjoin $ |
|
86 |
map (\(x, y) -> checkOpt (Just . show) defaultOptions |
|
87 |
failTest (const (==?)) Just (argument, x, y)) args |
|
88 |
|
|
89 |
-- | Test a few boolean arguments. |
|
90 |
case_bool_arg :: Assertion |
|
91 |
case_bool_arg = |
|
92 |
mapM_ (checkOpt (const Nothing) defaultOptions assertFailure |
|
93 |
assertEqual id) |
|
94 |
[ (False, oDiskMoves, optDiskMoves) |
|
95 |
, (False, oInstMoves, optInstMoves) |
|
96 |
, (True, oEvacMode, optEvacMode) |
|
97 |
, (True, oExecJobs, optExecJobs) |
|
98 |
, (True, oNoHeaders, optNoHeaders) |
|
99 |
, (True, oNoSimulation, optNoSimulation) |
|
100 |
] |
|
101 |
|
|
102 |
-- | Tests a few invalid arguments. |
|
103 |
case_wrong_arg :: Assertion |
|
104 |
case_wrong_arg = do |
|
105 |
mapM_ (passFailOpt defaultOptions assertFailure (return ())) |
|
106 |
[ (oSpindleUse, "-1", "1") |
|
107 |
, (oSpindleUse, "a", "1") |
|
108 |
, (oMaxCpu, "-1", "1") |
|
109 |
, (oMinDisk, "a", "1") |
|
110 |
, (oMinGainLim, "a", "1") |
|
111 |
, (oMaxSolLength, "x", "10") |
|
112 |
, (oStdSpec, "no-such-spec", "1,1,1") |
|
113 |
, (oTieredSpec, "no-such-spec", "1,1,1") |
|
114 |
] |
|
115 |
|
|
116 |
-- | Test that all binaries support some common options. |
|
117 |
case_stdopts :: Assertion |
|
118 |
case_stdopts = |
|
119 |
mapM_ (\(name, (_, o)) -> checkEarlyExit defaultOptions name o) |
|
120 |
Program.personalities |
|
117 | 121 |
|
118 | 122 |
testSuite "HTools/CLI" |
119 | 123 |
[ 'prop_parseISpec |
120 | 124 |
, 'prop_parseISpecFail |
121 |
, 'prop_parseYesNo |
|
122 |
, 'prop_StringArg |
|
123 |
, 'prop_stdopts |
|
125 |
, 'prop_string_arg |
|
126 |
, 'prop_numeric_arg |
|
127 |
, 'case_bool_arg |
|
128 |
, 'case_wrong_arg |
|
129 |
, 'case_stdopts |
|
124 | 130 |
] |
b/htest/test.hs | ||
---|---|---|
32 | 32 |
import Test.Ganeti.TestImports () |
33 | 33 |
import Test.Ganeti.BasicTypes |
34 | 34 |
import Test.Ganeti.Confd.Utils |
35 |
import Test.Ganeti.Common |
|
36 |
import Test.Ganeti.Daemon |
|
35 | 37 |
import Test.Ganeti.HTools.CLI |
36 | 38 |
import Test.Ganeti.HTools.Cluster |
37 | 39 |
import Test.Ganeti.HTools.Container |
... | ... | |
78 | 80 |
allTests = |
79 | 81 |
[ (True, testBasicTypes) |
80 | 82 |
, (True, testConfd_Utils) |
83 |
, (True, testCommon) |
|
84 |
, (True, testDaemon) |
|
81 | 85 |
, (True, testHTools_CLI) |
82 | 86 |
, (True, testHTools_Container) |
83 | 87 |
, (True, testHTools_Instance) |
b/htools/Ganeti/Common.hs | ||
---|---|---|
1 |
{-| Base common functionality. |
|
2 |
|
|
3 |
This module holds common functionality shared across Ganeti daemons, |
|
4 |
HTools and any other programs. |
|
5 |
|
|
6 |
-} |
|
7 |
|
|
8 |
{- |
|
9 |
|
|
10 |
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
|
11 |
|
|
12 |
This program is free software; you can redistribute it and/or modify |
|
13 |
it under the terms of the GNU General Public License as published by |
|
14 |
the Free Software Foundation; either version 2 of the License, or |
|
15 |
(at your option) any later version. |
|
16 |
|
|
17 |
This program is distributed in the hope that it will be useful, but |
|
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
20 |
General Public License for more details. |
|
21 |
|
|
22 |
You should have received a copy of the GNU General Public License |
|
23 |
along with this program; if not, write to the Free Software |
|
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
25 |
02110-1301, USA. |
|
26 |
|
|
27 |
-} |
|
28 |
|
|
29 |
module Ganeti.Common |
|
30 |
( GenericOptType |
|
31 |
, StandardOptions(..) |
|
32 |
, oShowHelp |
|
33 |
, oShowVer |
|
34 |
, usageHelp |
|
35 |
, versionInfo |
|
36 |
, reqWithConversion |
|
37 |
, parseYesNo |
|
38 |
, parseOpts |
|
39 |
, parseOptsInner |
|
40 |
) where |
|
41 |
|
|
42 |
import Control.Monad (foldM) |
|
43 |
import qualified Data.Version |
|
44 |
import System.Console.GetOpt |
|
45 |
import System.Exit |
|
46 |
import System.Info |
|
47 |
import System.IO |
|
48 |
import Text.Printf (printf) |
|
49 |
|
|
50 |
import Ganeti.BasicTypes |
|
51 |
import qualified Ganeti.Version as Version (version) |
|
52 |
|
|
53 |
-- | Abrreviation for the option type. |
|
54 |
type GenericOptType a = OptDescr (a -> Result a) |
|
55 |
|
|
56 |
-- | Type class for options which support help and version. |
|
57 |
class StandardOptions a where |
|
58 |
helpRequested :: a -> Bool |
|
59 |
verRequested :: a -> Bool |
|
60 |
requestHelp :: a -> a |
|
61 |
requestVer :: a -> a |
|
62 |
|
|
63 |
-- | Options to request help output. |
|
64 |
oShowHelp :: (StandardOptions a) => GenericOptType a |
|
65 |
oShowHelp = Option "h" ["help"] (NoArg (Ok . requestHelp)) |
|
66 |
"show help" |
|
67 |
|
|
68 |
oShowVer :: (StandardOptions a) => GenericOptType a |
|
69 |
oShowVer = Option "V" ["version"] (NoArg (Ok . requestVer)) |
|
70 |
"show the version of the program" |
|
71 |
|
|
72 |
-- | Usage info. |
|
73 |
usageHelp :: String -> [GenericOptType a] -> String |
|
74 |
usageHelp progname = |
|
75 |
usageInfo (printf "%s %s\nUsage: %s [OPTION...]" |
|
76 |
progname Version.version progname) |
|
77 |
|
|
78 |
-- | Show the program version info. |
|
79 |
versionInfo :: String -> String |
|
80 |
versionInfo progname = |
|
81 |
printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n" |
|
82 |
progname Version.version compilerName |
|
83 |
(Data.Version.showVersion compilerVersion) |
|
84 |
os arch |
|
85 |
|
|
86 |
-- | Helper for parsing a yes\/no command line flag. |
|
87 |
parseYesNo :: Bool -- ^ Default value (when we get a @Nothing@) |
|
88 |
-> Maybe String -- ^ Parameter value |
|
89 |
-> Result Bool -- ^ Resulting boolean value |
|
90 |
parseYesNo v Nothing = return v |
|
91 |
parseYesNo _ (Just "yes") = return True |
|
92 |
parseYesNo _ (Just "no") = return False |
|
93 |
parseYesNo _ (Just s) = fail ("Invalid choice '" ++ s ++ |
|
94 |
"', pass one of 'yes' or 'no'") |
|
95 |
|
|
96 |
-- | Helper function for required arguments which need to be converted |
|
97 |
-- as opposed to stored just as string. |
|
98 |
reqWithConversion :: (String -> Result a) |
|
99 |
-> (a -> b -> Result b) |
|
100 |
-> String |
|
101 |
-> ArgDescr (b -> Result b) |
|
102 |
reqWithConversion conversion_fn updater_fn metavar = |
|
103 |
ReqArg (\string_opt opts -> do |
|
104 |
parsed_value <- conversion_fn string_opt |
|
105 |
updater_fn parsed_value opts) metavar |
|
106 |
|
|
107 |
-- | Command line parser, using a generic 'Options' structure. |
|
108 |
parseOpts :: (StandardOptions a) => |
|
109 |
a -- ^ The default options |
|
110 |
-> [String] -- ^ The command line arguments |
|
111 |
-> String -- ^ The program name |
|
112 |
-> [GenericOptType a] -- ^ The supported command line options |
|
113 |
-> IO (a, [String]) -- ^ The resulting options and |
|
114 |
-- leftover arguments |
|
115 |
parseOpts defaults argv progname options = |
|
116 |
case parseOptsInner defaults argv progname options of |
|
117 |
Left (code, msg) -> do |
|
118 |
hPutStr (if code == ExitSuccess then stdout else stderr) msg |
|
119 |
exitWith code |
|
120 |
Right result -> |
|
121 |
return result |
|
122 |
|
|
123 |
-- | Inner parse options. The arguments are similar to 'parseOpts', |
|
124 |
-- but it returns either a 'Left' composed of exit code and message, |
|
125 |
-- or a 'Right' for the success case. |
|
126 |
parseOptsInner :: (StandardOptions a) => |
|
127 |
a |
|
128 |
-> [String] |
|
129 |
-> String |
|
130 |
-> [GenericOptType a] |
|
131 |
-> Either (ExitCode, String) (a, [String]) |
|
132 |
parseOptsInner defaults argv progname options = |
|
133 |
case getOpt Permute options argv of |
|
134 |
(opts, args, []) -> |
|
135 |
case foldM (flip id) defaults opts of |
|
136 |
Bad msg -> Left (ExitFailure 1, |
|
137 |
"Error while parsing command line arguments:\n" |
|
138 |
++ msg ++ "\n") |
|
139 |
Ok parsed -> |
|
140 |
select (Right (parsed, args)) |
|
141 |
[ (helpRequested parsed, |
|
142 |
Left (ExitSuccess, usageHelp progname options)) |
|
143 |
, (verRequested parsed, |
|
144 |
Left (ExitSuccess, versionInfo progname)) |
|
145 |
] |
|
146 |
(_, _, errs) -> |
|
147 |
Left (ExitFailure 2, "Command line error: " ++ concat errs ++ "\n" ++ |
|
148 |
usageHelp progname options) |
b/htools/Ganeti/Daemon.hs | ||
---|---|---|
45 | 45 |
import Control.Exception |
46 | 46 |
import Control.Monad |
47 | 47 |
import Data.Maybe (fromMaybe) |
48 |
import qualified Data.Version |
|
49 | 48 |
import Data.Word |
50 | 49 |
import GHC.IO.Handle (hDuplicateTo) |
51 | 50 |
import qualified Network.Socket as Socket |
... | ... | |
53 | 52 |
import System.Console.GetOpt |
54 | 53 |
import System.Exit |
55 | 54 |
import System.Environment |
56 |
import System.Info |
|
57 | 55 |
import System.IO |
58 | 56 |
import System.IO.Error (isDoesNotExistError) |
59 | 57 |
import System.Posix.Directory |
... | ... | |
62 | 60 |
import System.Posix.Process |
63 | 61 |
import System.Posix.Types |
64 | 62 |
import System.Posix.Signals |
65 |
import Text.Printf |
|
66 | 63 |
|
64 |
import Ganeti.Common as Common |
|
67 | 65 |
import Ganeti.Logging |
68 | 66 |
import Ganeti.Runtime |
69 | 67 |
import Ganeti.BasicTypes |
70 | 68 |
import Ganeti.HTools.Utils |
71 |
import qualified Ganeti.Version as Version (version) |
|
72 | 69 |
import qualified Ganeti.Constants as C |
73 | 70 |
import qualified Ganeti.Ssconf as Ssconf |
74 | 71 |
|
... | ... | |
105 | 102 |
, optSyslogUsage = Nothing |
106 | 103 |
} |
107 | 104 |
|
105 |
instance StandardOptions DaemonOptions where |
|
106 |
helpRequested = optShowHelp |
|
107 |
verRequested = optShowVer |
|
108 |
requestHelp = \opts -> opts { optShowHelp = True } |
|
109 |
requestVer = \opts -> opts { optShowVer = True } |
|
110 |
|
|
108 | 111 |
-- | Abrreviation for the option type. |
109 |
type OptType = OptDescr (DaemonOptions -> Result DaemonOptions) |
|
110 |
|
|
111 |
-- | Helper function for required arguments which need to be converted |
|
112 |
-- as opposed to stored just as string. |
|
113 |
reqWithConversion :: (String -> Result a) |
|
114 |
-> (a -> DaemonOptions -> Result DaemonOptions) |
|
115 |
-> String |
|
116 |
-> ArgDescr (DaemonOptions -> Result DaemonOptions) |
|
117 |
reqWithConversion conversion_fn updater_fn metavar = |
|
118 |
ReqArg (\string_opt opts -> do |
|
119 |
parsed_value <- conversion_fn string_opt |
|
120 |
updater_fn parsed_value opts) metavar |
|
112 |
type OptType = GenericOptType DaemonOptions |
|
121 | 113 |
|
122 | 114 |
-- * Command line options |
123 | 115 |
|
124 |
oShowHelp :: OptType |
|
125 |
oShowHelp = Option "h" ["help"] |
|
126 |
(NoArg (\ opts -> Ok opts { optShowHelp = True})) |
|
127 |
"Show the help message and exit" |
|
128 |
|
|
129 |
oShowVer :: OptType |
|
130 |
oShowVer = Option "V" ["version"] |
|
131 |
(NoArg (\ opts -> Ok opts { optShowVer = True})) |
|
132 |
"Show the version of the program and exit" |
|
133 |
|
|
134 | 116 |
oNoDaemonize :: OptType |
135 | 117 |
oNoDaemonize = Option "f" ["foreground"] |
136 | 118 |
(NoArg (\ opts -> Ok opts { optDaemonize = False})) |
... | ... | |
167 | 149 |
\messages); one of 'no', 'yes' or 'only' [" ++ C.syslogUsage ++ |
168 | 150 |
"]") |
169 | 151 |
|
170 |
-- | Usage info. |
|
171 |
usageHelp :: String -> [OptType] -> String |
|
172 |
usageHelp progname = |
|
173 |
usageInfo (printf "%s %s\nUsage: %s [OPTION...]" |
|
174 |
progname Version.version progname) |
|
175 |
|
|
176 |
-- | Command line parser, using the 'Options' structure. |
|
177 |
parseOpts :: [String] -- ^ The command line arguments |
|
178 |
-> String -- ^ The program name |
|
179 |
-> [OptType] -- ^ The supported command line options |
|
180 |
-> IO (DaemonOptions, [String]) -- ^ The resulting options |
|
181 |
-- and leftover arguments |
|
182 |
parseOpts argv progname options = |
|
183 |
case getOpt Permute options argv of |
|
184 |
(opt_list, args, []) -> |
|
185 |
do |
|
186 |
parsed_opts <- |
|
187 |
exitIfBad "Error while parsing command line arguments" $ |
|
188 |
foldM (flip id) defaultOptions opt_list |
|
189 |
return (parsed_opts, args) |
|
190 |
(_, _, errs) -> do |
|
191 |
hPutStrLn stderr $ "Command line error: " ++ concat errs |
|
192 |
hPutStrLn stderr $ usageHelp progname options |
|
193 |
exitWith $ ExitFailure 2 |
|
194 |
|
|
195 | 152 |
-- | Small wrapper over getArgs and 'parseOpts'. |
196 | 153 |
parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String]) |
197 | 154 |
parseArgs cmd options = do |
198 | 155 |
cmd_args <- getArgs |
199 |
parseOpts cmd_args cmd options |
|
156 |
parseOpts defaultOptions cmd_args cmd options
|
|
200 | 157 |
|
201 | 158 |
-- * Daemon-related functions |
202 | 159 |
-- | PID file mode. |
... | ... | |
321 | 278 |
let progname = daemonName daemon |
322 | 279 |
(opts, args) <- parseArgs progname options |
323 | 280 |
|
324 |
when (optShowHelp opts) $ do |
|
325 |
putStr $ usageHelp progname options |
|
326 |
exitSuccess |
|
327 |
when (optShowVer opts) $ do |
|
328 |
printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n" |
|
329 |
progname Version.version |
|
330 |
compilerName (Data.Version.showVersion compilerVersion) |
|
331 |
os arch :: IO () |
|
332 |
exitSuccess |
|
333 |
|
|
334 | 281 |
exitUnless (null args) "This program doesn't take any arguments" |
335 | 282 |
|
336 | 283 |
unless (optNoUserChecks opts) $ do |
b/htools/Ganeti/HTools/CLI.hs | ||
---|---|---|
30 | 30 |
module Ganeti.HTools.CLI |
31 | 31 |
( Options(..) |
32 | 32 |
, OptType |
33 |
, parseOpts |
|
33 |
, defaultOptions |
|
34 |
, Ganeti.HTools.CLI.parseOpts |
|
34 | 35 |
, parseOptsInner |
35 | 36 |
, parseYesNo |
36 | 37 |
, parseISpecString |
... | ... | |
73 | 74 |
, oPrintNodes |
74 | 75 |
, oQuiet |
75 | 76 |
, oRapiMaster |
76 |
, oReplay |
|
77 | 77 |
, oSaveCluster |
78 | 78 |
, oSelInst |
79 | 79 |
, oShowHelp |
80 | 80 |
, oShowVer |
81 | 81 |
, oStdSpec |
82 |
, oTestCount |
|
83 | 82 |
, oTieredSpec |
84 | 83 |
, oVerbose |
85 | 84 |
) where |
... | ... | |
87 | 86 |
import Control.Monad |
88 | 87 |
import Data.Char (toUpper) |
89 | 88 |
import Data.Maybe (fromMaybe) |
90 |
import qualified Data.Version |
|
91 | 89 |
import System.Console.GetOpt |
92 | 90 |
import System.IO |
93 |
import System.Info |
|
94 |
import System.Exit |
|
95 | 91 |
import Text.Printf (printf) |
96 | 92 |
|
97 |
import qualified Ganeti.Version as Version (version) |
|
98 | 93 |
import qualified Ganeti.HTools.Container as Container |
99 | 94 |
import qualified Ganeti.HTools.Node as Node |
100 | 95 |
import qualified Ganeti.Constants as C |
101 | 96 |
import Ganeti.HTools.Types |
102 | 97 |
import Ganeti.HTools.Utils |
103 | 98 |
import Ganeti.BasicTypes |
99 |
import Ganeti.Common as Common |
|
104 | 100 |
|
105 | 101 |
-- * Constants |
106 | 102 |
|
... | ... | |
198 | 194 |
} |
199 | 195 |
|
200 | 196 |
-- | Abrreviation for the option type. |
201 |
type OptType = OptDescr (Options -> Result Options) |
|
197 |
type OptType = GenericOptType Options |
|
198 |
|
|
199 |
instance StandardOptions Options where |
|
200 |
helpRequested = optShowHelp |
|
201 |
verRequested = optShowVer |
|
202 |
requestHelp = \opts -> opts { optShowHelp = True } |
|
203 |
requestVer = \opts -> opts { optShowVer = True } |
|
202 | 204 |
|
203 | 205 |
-- * Helper functions |
204 | 206 |
|
... | ... | |
232 | 234 |
|
233 | 235 |
oDiskTemplate :: OptType |
234 | 236 |
oDiskTemplate = Option "" ["disk-template"] |
235 |
(ReqArg (\ t opts -> do |
|
236 |
dt <- diskTemplateFromRaw t |
|
237 |
return $ opts { optDiskTemplate = Just dt }) |
|
237 |
(reqWithConversion diskTemplateFromRaw |
|
238 |
(\dt opts -> Ok opts { optDiskTemplate = Just dt }) |
|
238 | 239 |
"TEMPLATE") "select the desired disk template" |
239 | 240 |
|
240 | 241 |
oSpindleUse :: OptType |
241 | 242 |
oSpindleUse = Option "" ["spindle-use"] |
242 |
(ReqArg (\ n opts -> do
|
|
243 |
su <- tryRead "parsing spindle-use" n
|
|
244 |
when (su < 0) $
|
|
245 |
fail "Invalid value of the spindle-use\
|
|
246 |
\ (expected >= 0)"
|
|
247 |
return $ opts { optSpindleUse = Just su })
|
|
243 |
(reqWithConversion (tryRead "parsing spindle-use")
|
|
244 |
(\su opts -> do
|
|
245 |
when (su < 0) $ |
|
246 |
fail "Invalid value of the spindle-use\ |
|
247 |
\ (expected >= 0)" |
|
248 |
return $ opts { optSpindleUse = Just su }) |
|
248 | 249 |
"SPINDLES") "select how many virtual spindle instances use\ |
249 | 250 |
\ [default read from cluster]" |
250 | 251 |
|
... | ... | |
314 | 315 |
|
315 | 316 |
oMaxCpu :: OptType |
316 | 317 |
oMaxCpu = Option "" ["max-cpu"] |
317 |
(ReqArg (\ n opts -> do
|
|
318 |
mcpu <- tryRead "parsing max-cpu" n
|
|
319 |
when (mcpu <= 0) $
|
|
320 |
fail "Invalid value of the max-cpu ratio,\
|
|
321 |
\ expected >0"
|
|
322 |
return $ opts { optMcpu = Just mcpu }) "RATIO")
|
|
318 |
(reqWithConversion (tryRead "parsing max-cpu")
|
|
319 |
(\mcpu opts -> do
|
|
320 |
when (mcpu <= 0) $ |
|
321 |
fail "Invalid value of the max-cpu ratio,\ |
|
322 |
\ expected >0" |
|
323 |
return $ opts { optMcpu = Just mcpu }) "RATIO") |
|
323 | 324 |
"maximum virtual-to-physical cpu ratio for nodes (from 0\ |
324 | 325 |
\ upwards) [default read from cluster]" |
325 | 326 |
|
326 | 327 |
oMaxSolLength :: OptType |
327 | 328 |
oMaxSolLength = Option "l" ["max-length"] |
328 |
(ReqArg (\ i opts -> Ok opts { optMaxLength = read i }) "N") |
|
329 |
(reqWithConversion (tryRead "max solution length") |
|
330 |
(\i opts -> Ok opts { optMaxLength = i }) "N") |
|
329 | 331 |
"cap the solution at this many balancing or allocation \ |
330 | 332 |
\ rounds (useful for very unbalanced clusters or empty \ |
331 | 333 |
\ clusters)" |
332 | 334 |
|
333 | 335 |
oMinDisk :: OptType |
334 | 336 |
oMinDisk = Option "" ["min-disk"] |
335 |
(ReqArg (\ n opts -> Ok opts { optMdsk = read n }) "RATIO") |
|
337 |
(reqWithConversion (tryRead "min free disk space") |
|
338 |
(\n opts -> Ok opts { optMdsk = n }) "RATIO") |
|
336 | 339 |
"minimum free disk space for nodes (between 0 and 1) [0]" |
337 | 340 |
|
338 | 341 |
oMinGain :: OptType |
339 | 342 |
oMinGain = Option "g" ["min-gain"] |
340 |
(ReqArg (\ g opts -> Ok opts { optMinGain = read g }) "DELTA") |
|
343 |
(reqWithConversion (tryRead "min gain") |
|
344 |
(\g opts -> Ok opts { optMinGain = g }) "DELTA") |
|
341 | 345 |
"minimum gain to aim for in a balancing step before giving up" |
342 | 346 |
|
343 | 347 |
oMinGainLim :: OptType |
344 | 348 |
oMinGainLim = Option "" ["min-gain-limit"] |
345 |
(ReqArg (\ g opts -> Ok opts { optMinGainLim = read g }) "SCORE") |
|
349 |
(reqWithConversion (tryRead "min gain limit") |
|
350 |
(\g opts -> Ok opts { optMinGainLim = g }) "SCORE") |
|
346 | 351 |
"minimum cluster score for which we start checking the min-gain" |
347 | 352 |
|
348 | 353 |
oMinScore :: OptType |
349 | 354 |
oMinScore = Option "e" ["min-score"] |
350 |
(ReqArg (\ e opts -> Ok opts { optMinScore = read e }) "EPSILON") |
|
355 |
(reqWithConversion (tryRead "min score") |
|
356 |
(\e opts -> Ok opts { optMinScore = e }) "EPSILON") |
|
351 | 357 |
"mininum score to aim for" |
352 | 358 |
|
353 | 359 |
oNoHeaders :: OptType |
... | ... | |
416 | 422 |
(ReqArg (\ f opts -> Ok opts { optSaveCluster = Just f }) "FILE") |
417 | 423 |
"Save cluster state at the end of the processing to FILE" |
418 | 424 |
|
419 |
oShowHelp :: OptType |
|
420 |
oShowHelp = Option "h" ["help"] |
|
421 |
(NoArg (\ opts -> Ok opts { optShowHelp = True})) |
|
422 |
"show help" |
|
423 |
|
|
424 |
oShowVer :: OptType |
|
425 |
oShowVer = Option "V" ["version"] |
|
426 |
(NoArg (\ opts -> Ok opts { optShowVer = True})) |
|
427 |
"show the version of the program" |
|
428 |
|
|
429 | 425 |
oStdSpec :: OptType |
430 | 426 |
oStdSpec = Option "" ["standard-alloc"] |
431 | 427 |
(ReqArg (\ inp opts -> do |
... | ... | |
434 | 430 |
"STDSPEC") |
435 | 431 |
"enable standard specs allocation, given as 'disk,ram,cpu'" |
436 | 432 |
|
437 |
oTestCount :: OptType |
|
438 |
oTestCount = Option "" ["test-count"] |
|
439 |
(ReqArg (\ inp opts -> do |
|
440 |
tcount <- tryRead "parsing test count" inp |
|
441 |
return $ opts { optTestCount = Just tcount } ) |
|
442 |
"COUNT") |
|
443 |
"override the target test count" |
|
444 |
|
|
445 | 433 |
oTieredSpec :: OptType |
446 | 434 |
oTieredSpec = Option "" ["tiered-alloc"] |
447 | 435 |
(ReqArg (\ inp opts -> do |
... | ... | |
450 | 438 |
"TSPEC") |
451 | 439 |
"enable tiered specs allocation, given as 'disk,ram,cpu'" |
452 | 440 |
|
453 |
oReplay :: OptType |
|
454 |
oReplay = Option "" ["replay"] |
|
455 |
(ReqArg (\ stat opts -> Ok opts { optReplay = Just stat } ) "STATE") |
|
456 |
"Pre-seed the random number generator with STATE" |
|
457 |
|
|
458 | 441 |
oVerbose :: OptType |
459 | 442 |
oVerbose = Option "v" ["verbose"] |
460 | 443 |
(NoArg (\ opts -> Ok opts { optVerbose = optVerbose opts + 1 })) |
... | ... | |
462 | 445 |
|
463 | 446 |
-- * Functions |
464 | 447 |
|
465 |
-- | Helper for parsing a yes\/no command line flag. |
|
466 |
parseYesNo :: Bool -- ^ Default value (when we get a @Nothing@) |
|
467 |
-> Maybe String -- ^ Parameter value |
|
468 |
-> Result Bool -- ^ Resulting boolean value |
|
469 |
parseYesNo v Nothing = return v |
|
470 |
parseYesNo _ (Just "yes") = return True |
|
471 |
parseYesNo _ (Just "no") = return False |
|
472 |
parseYesNo _ (Just s) = fail ("Invalid choice '" ++ s ++ |
|
473 |
"', pass one of 'yes' or 'no'") |
|
474 |
|
|
475 |
-- | Usage info. |
|
476 |
usageHelp :: String -> [OptType] -> String |
|
477 |
usageHelp progname = |
|
478 |
usageInfo (printf "%s %s\nUsage: %s [OPTION...]" |
|
479 |
progname Version.version progname) |
|
480 |
|
|
481 |
-- | Show the program version info. |
|
482 |
versionInfo :: String -> String |
|
483 |
versionInfo progname = |
|
484 |
printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n" |
|
485 |
progname Version.version compilerName |
|
486 |
(Data.Version.showVersion compilerVersion) |
|
487 |
os arch |
|
488 |
|
|
489 |
-- | Command line parser, using the 'Options' structure. |
|
448 |
-- | Wrapper over 'Common.parseOpts' with our custom options. |
|
490 | 449 |
parseOpts :: [String] -- ^ The command line arguments |
491 | 450 |
-> String -- ^ The program name |
492 | 451 |
-> [OptType] -- ^ The supported command line options |
493 | 452 |
-> IO (Options, [String]) -- ^ The resulting options and leftover |
494 | 453 |
-- arguments |
495 |
parseOpts argv progname options = |
|
496 |
case parseOptsInner argv progname options of |
|
497 |
Left (code, msg) -> do |
|
498 |
hPutStr (if code == 0 then stdout else stderr) msg |
|
499 |
exitWith (if code == 0 then ExitSuccess else ExitFailure code) |
|
500 |
Right result -> |
|
501 |
return result |
|
502 |
|
|
503 |
-- | Inner parse options. The arguments are similar to 'parseOpts', |
|
504 |
-- but it returns either a 'Left' composed of exit code and message, |
|
505 |
-- or a 'Right' for the success case. |
|
506 |
parseOptsInner :: [String] -> String -> [OptType] |
|
507 |
-> Either (Int, String) (Options, [String]) |
|
508 |
parseOptsInner argv progname options = |
|
509 |
case getOpt Permute options argv of |
|
510 |
(o, n, []) -> |
|
511 |
let (pr, args) = (foldM (flip id) defaultOptions o, n) |
|
512 |
in case pr of |
|
513 |
Bad msg -> Left (1, "Error while parsing command\ |
|
514 |
\line arguments:\n" ++ msg ++ "\n") |
|
515 |
Ok po -> |
|
516 |
select (Right (po, args)) |
|
517 |
[ (optShowHelp po, Left (0, usageHelp progname options)) |
|
518 |
, (optShowVer po, Left (0, versionInfo progname)) |
|
519 |
] |
|
520 |
(_, _, errs) -> |
|
521 |
Left (2, "Command line error: " ++ concat errs ++ "\n" ++ |
|
522 |
usageHelp progname options) |
|
454 |
parseOpts = Common.parseOpts defaultOptions |
|
455 |
|
|
523 | 456 |
|
524 | 457 |
-- | A shell script template for autogenerated scripts. |
525 | 458 |
shTemplate :: String |
... | ... | |
546 | 479 |
hPutStrLn stderr (msg ++ " status:") |
547 | 480 |
hPutStrLn stderr $ fn fields |
548 | 481 |
|
549 |
|
|
550 | 482 |
-- | Optionally print the instance list. |
551 | 483 |
maybePrintInsts :: Bool -- ^ Whether to print the instance list |
552 | 484 |
-> String -- ^ Type of the instance map (e.g. initial) |
... | ... | |
571 | 503 |
printKeys :: String -- ^ Prefix to printed variables |
572 | 504 |
-> [(String, String)] -- ^ List of (key, value) pairs to be printed |
573 | 505 |
-> IO () |
574 |
printKeys prefix = mapM_ (\(k, v) -> |
|
575 |
printf "%s_%s=%s\n" prefix (map toUpper k) (ensureQuoted v)) |
|
506 |
printKeys prefix = |
|
507 |
mapM_ (\(k, v) -> |
|
508 |
printf "%s_%s=%s\n" prefix (map toUpper k) (ensureQuoted v)) |
|
576 | 509 |
|
577 | 510 |
-- | Prints the final @OK@ marker in machine readable output. |
578 | 511 |
printFinal :: String -- ^ Prefix to printed variable |
579 |
-> Bool -- ^ Whether output should be machine readable |
|
580 |
-- Note: if not, there is nothing to print
|
|
512 |
-> Bool -- ^ Whether output should be machine readable;
|
|
513 |
-- note: if not, there is nothing to print
|
|
581 | 514 |
-> IO () |
582 | 515 |
printFinal prefix True = |
583 | 516 |
-- this should be the final entry |
Also available in: Unified diff