6efbf8dda9621da248bdfe1a5078a1183a9213c6
[ganeti-local] / src / hn1.hs
1 {-| Solver for N+1 cluster errors
2
3 -}
4
5 module Main (main) where
6
7 import Data.List
8 import Data.Function
9 import Monad
10 import System
11 import System.IO
12 import System.Console.GetOpt
13 import qualified System
14
15 import Text.Printf (printf)
16
17 import qualified Container
18 import qualified Instance
19 import qualified Cluster
20 import Utils
21 import Rapi
22
23 -- | Command line options structure.
24 data Options = Options
25     { optShowNodes   :: Bool
26     , optShowCmds    :: Bool
27     , optNodef       :: FilePath
28     , optInstf       :: FilePath
29     , optMinDepth    :: Int
30     , optMaxRemovals :: Int
31     , optMinDelta    :: Int
32     , optMaxDelta    :: Int
33     , optMaster    :: String
34     } deriving Show
35
36 -- | Default values for the command line options.
37 defaultOptions :: Options
38 defaultOptions    = Options
39  { optShowNodes   = False
40  , optShowCmds    = False
41  , optNodef       = "nodes"
42  , optInstf       = "instances"
43  , optMinDepth    = 1
44  , optMaxRemovals = -1
45  , optMinDelta    = 0
46  , optMaxDelta    = -1
47  , optMaster    = ""
48  }
49
50 {- | Start computing the solution at the given depth and recurse until
51 we find a valid solution or we exceed the maximum depth.
52
53 -}
54 iterateDepth :: Cluster.NodeList
55              -> [Instance.Instance]
56              -> Int
57              -> Int
58              -> Int
59              -> Int
60              -> IO (Maybe Cluster.Solution)
61 iterateDepth nl bad_instances depth max_removals min_delta max_delta =
62     let
63         max_depth = length bad_instances
64         sol = Cluster.computeSolution nl bad_instances depth
65               max_removals min_delta max_delta
66     in
67       do
68         printf "%d " depth
69         hFlush stdout
70         case sol `seq` sol of
71           Nothing ->
72               if depth > max_depth then
73                   return Nothing
74               else
75                   iterateDepth nl bad_instances (depth + 1)
76                                max_removals min_delta max_delta
77           _ -> return sol
78
79 -- | Options list and functions
80 options :: [OptDescr (Options -> Options)]
81 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")
90       "the node list 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"
109      ]
110
111 -- | Command line parser, using the 'options' structure.
112 parseOpts :: [String] -> IO (Options, [String])
113 parseOpts argv =
114     case getOpt Permute options argv of
115       (o,n,[]  ) ->
116           return (foldl (flip id) defaultOptions o, n)
117       (_,_,errs) ->
118           ioError (userError (concat errs ++ usageInfo header options))
119       where header = "Usage: hn1 [OPTION...]"
120
121 -- | Main function.
122 main :: IO ()
123 main = do
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)
133
134   (nl, il, ktn, kti) <- liftM2 Cluster.loadData node_data inst_data
135
136   printf "Loaded %d nodes, %d instances\n"
137              (Container.size nl)
138              (Container.size il)
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)
142
143   when (null bad_instances) $ do
144          putStrLn "Happy time! Cluster is fine, no need to burn CPU."
145          exitWith ExitSuccess
146
147   when (length bad_instances < min_depth) $ do
148          printf "Error: depth %d is higher than the number of bad instances.\n"
149                 min_depth
150          exitWith $ ExitFailure 2
151
152   putStr "Computing solution: depth "
153   hFlush stdout
154
155   result <- iterateDepth nl bad_instances min_depth (optMaxRemovals opts)
156             (optMinDelta opts) (optMaxDelta opts)
157   let (min_d, solution) =
158           case result of
159             Just (Cluster.Solution a b) -> (a, b)
160             Nothing -> (-1, [])
161   when (min_d == -1) $ do
162          putStrLn "failed. Try to run with higher depth."
163          exitWith $ ExitFailure 1
164
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) $
169        do
170          putStrLn ""
171          putStrLn "Commands to run to reach the above solution:"
172          putStr $ unlines $ map ("  echo gnt-instance " ++) $ concat cmd_strs
173   when (optShowNodes opts) $
174        do
175          let (orig_mem, orig_disk) = Cluster.totalResources nl
176              ns = Cluster.applySolution nl il solution
177              (final_mem, final_disk) = Cluster.totalResources ns
178          putStrLn ""
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