1 {-| Solver for N+1 cluster errors
5 module Main (main) where
12 import System.Console.GetOpt
13 import qualified System
15 import Text.Printf (printf)
17 import qualified Container
18 import qualified Instance
19 import qualified Cluster
23 -- | Command line options structure.
24 data Options = Options
25 { optShowNodes :: Bool
27 , optNodef :: FilePath
28 , optInstf :: FilePath
30 , optMaxRemovals :: Int
36 -- | Default values for the command line options.
37 defaultOptions :: Options
38 defaultOptions = Options
39 { optShowNodes = False
42 , optInstf = "instances"
50 {- | Start computing the solution at the given depth and recurse until
51 we find a valid solution or we exceed the maximum depth.
54 iterateDepth :: Cluster.NodeList
55 -> [Instance.Instance]
60 -> IO (Maybe Cluster.Solution)
61 iterateDepth nl bad_instances depth max_removals min_delta max_delta =
63 max_depth = length bad_instances
64 sol = Cluster.computeSolution nl bad_instances depth
65 max_removals min_delta max_delta
72 if depth > max_depth then
75 iterateDepth nl bad_instances (depth + 1)
76 max_removals min_delta max_delta
79 -- | Options list and functions
80 options :: [OptDescr (Options -> Options)]
82 [ Option ['p'] ["print-nodes"]
83 (NoArg (\ opts -> opts { optShowNodes = True }))
84 "print the final node list"
85 , Option ['C'] ["print-commands"]
86 (NoArg (\ opts -> opts { optShowCmds = True }))
87 "print the ganeti command list for reaching the solution"
88 , Option ['n'] ["nodes"]
89 (ReqArg (\ f opts -> opts { optNodef = f }) "FILE")
91 , Option ['i'] ["instances"]
92 (ReqArg (\ f opts -> opts { optInstf = f }) "FILE")
93 "the instance list FILE"
94 , Option ['d'] ["depth"]
95 (ReqArg (\ i opts -> opts { optMinDepth = (read i)::Int }) "D")
96 "start computing the solution at depth D"
97 , Option ['r'] ["max-removals"]
98 (ReqArg (\ i opts -> opts { optMaxRemovals = (read i)::Int }) "R")
99 "do not process more than R removal sets (useful for high depths)"
100 , Option ['L'] ["max-delta"]
101 (ReqArg (\ i opts -> opts { optMaxDelta = (read i)::Int }) "L")
102 "refuse solutions with delta higher than L"
103 , Option ['l'] ["min-delta"]
104 (ReqArg (\ i opts -> opts { optMinDelta = (read i)::Int }) "L")
105 "return once a solution with delta L or lower has been found"
106 , Option ['m'] ["master"]
107 (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
108 "collect data via RAPI at the given ADDRESS"
111 -- | Command line parser, using the 'options' structure.
112 parseOpts :: [String] -> IO (Options, [String])
114 case getOpt Permute options argv of
116 return (foldl (flip id) defaultOptions o, n)
118 ioError (userError (concat errs ++ usageInfo header options))
119 where header = "Usage: hn1 [OPTION...]"
124 cmd_args <- System.getArgs
125 (opts, _) <- parseOpts cmd_args
126 let min_depth = optMinDepth opts
127 let (node_data, inst_data) =
128 case optMaster opts of
129 "" -> (readFile $ optNodef opts,
130 readFile $ optInstf opts)
131 host -> (readData getNodes host,
132 readData getInstances host)
134 (nl, il, ktn, kti) <- liftM2 Cluster.loadData node_data inst_data
136 printf "Loaded %d nodes, %d instances\n"
139 let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
140 printf "Initial check done: %d bad nodes, %d bad instances.\n"
141 (length bad_nodes) (length bad_instances)
143 when (null bad_instances) $ do
144 putStrLn "Happy time! Cluster is fine, no need to burn CPU."
147 when (length bad_instances < min_depth) $ do
148 printf "Error: depth %d is higher than the number of bad instances.\n"
150 exitWith $ ExitFailure 2
152 putStr "Computing solution: depth "
155 result <- iterateDepth nl bad_instances min_depth (optMaxRemovals opts)
156 (optMinDelta opts) (optMaxDelta opts)
157 let (min_d, solution) =
159 Just (Cluster.Solution a b) -> (a, b)
161 when (min_d == -1) $ do
162 putStrLn "failed. Try to run with higher depth."
163 exitWith $ ExitFailure 1
165 printf "found.\nSolution (delta=%d):\n" $! min_d
166 let (sol_strs, cmd_strs) = Cluster.printSolution il ktn kti solution
167 putStr $ unlines $ sol_strs
168 when (optShowCmds opts) $
171 putStrLn "Commands to run to reach the above solution:"
172 putStr $ unlines $ map (" echo gnt-instance " ++) $ concat cmd_strs
173 when (optShowNodes opts) $
175 let (orig_mem, orig_disk) = Cluster.totalResources nl
176 ns = Cluster.applySolution nl il solution
177 (final_mem, final_disk) = Cluster.totalResources ns
179 putStrLn "Final cluster status:"
180 putStrLn $ Cluster.printNodes ktn ns
181 printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
182 printf "Final: mem=%d disk=%d\n" final_mem final_disk