Fix totalResources avail disk computation
[ganeti-local] / hspace.hs
1 {-| Cluster space sizing
2
3 -}
4
5 {-
6
7 Copyright (C) 2009 Google Inc.
8
9 This program is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2 of the License, or
12 (at your option) any later version.
13
14 This program is distributed in the hope that it will be useful, but
15 WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 General Public License for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with this program; if not, write to the Free Software
21 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22 02110-1301, USA.
23
24 -}
25
26 module Main (main) where
27
28 import Data.List
29 import Data.Function
30 import Data.Maybe (isJust, fromJust, isNothing)
31 import Monad
32 import System
33 import System.IO
34 import System.Console.GetOpt
35 import qualified System
36
37 import Text.Printf (printf)
38
39 import qualified Ganeti.HTools.Container as Container
40 import qualified Ganeti.HTools.Cluster as Cluster
41 import qualified Ganeti.HTools.Node as Node
42 import qualified Ganeti.HTools.Instance as Instance
43 import qualified Ganeti.HTools.CLI as CLI
44
45 import Ganeti.HTools.Utils
46
47 -- | Command line options structure.
48 data Options = Options
49     { optShowNodes :: Bool           -- ^ Whether to show node status
50     , optNodef     :: FilePath       -- ^ Path to the nodes file
51     , optNodeSet   :: Bool           -- ^ The nodes have been set by options
52     , optInstf     :: FilePath       -- ^ Path to the instances file
53     , optInstSet   :: Bool           -- ^ The insts have been set by options
54     , optMaster    :: String         -- ^ Collect data from RAPI
55     , optVerbose   :: Int            -- ^ Verbosity level
56     , optOffline   :: [String]       -- ^ Names of offline nodes
57     , optIMem      :: Int            -- ^ Instance memory
58     , optIDsk      :: Int            -- ^ Instance disk
59     , optIVCPUs    :: Int            -- ^ Instance VCPUs
60     , optINodes    :: Int            -- ^ Nodes required for an instance
61     , optMcpu      :: Double         -- ^ Max cpu ratio for nodes
62     , optMdsk      :: Double         -- ^ Max disk usage ratio for nodes
63     , optShowVer   :: Bool           -- ^ Just show the program version
64     , optShowHelp  :: Bool           -- ^ Just show the help
65     } deriving Show
66
67 instance CLI.CLIOptions Options where
68     showVersion = optShowVer
69     showHelp    = optShowHelp
70
71 instance CLI.EToolOptions Options where
72     nodeFile   = optNodef
73     nodeSet    = optNodeSet
74     instFile   = optInstf
75     instSet    = optInstSet
76     masterName = optMaster
77     silent a   = (optVerbose a) == 0
78
79 -- | Default values for the command line options.
80 defaultOptions :: Options
81 defaultOptions  = Options
82  { optShowNodes = False
83  , optNodef     = "nodes"
84  , optNodeSet   = False
85  , optInstf     = "instances"
86  , optInstSet   = False
87  , optMaster    = ""
88  , optVerbose   = 1
89  , optOffline   = []
90  , optIMem      = 4096
91  , optIDsk      = 102400
92  , optIVCPUs    = 1
93  , optINodes    = 2
94  , optMcpu      = -1
95  , optMdsk      = -1
96  , optShowVer   = False
97  , optShowHelp  = False
98  }
99
100 -- | Options list and functions
101 options :: [OptDescr (Options -> Options)]
102 options =
103     [ Option ['p']     ["print-nodes"]
104       (NoArg (\ opts -> opts { optShowNodes = True }))
105       "print the final node list"
106     , Option ['n']     ["nodes"]
107       (ReqArg (\ f opts -> opts { optNodef = f, optNodeSet = True }) "FILE")
108       "the node list FILE"
109     , Option ['i']     ["instances"]
110       (ReqArg (\ f opts -> opts { optInstf =  f, optInstSet = True }) "FILE")
111       "the instance list FILE"
112     , Option ['m']     ["master"]
113       (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
114       "collect data via RAPI at the given ADDRESS"
115     , Option ['v']     ["verbose"]
116       (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 }))
117       "increase the verbosity level"
118     , Option ['q']     ["quiet"]
119       (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) - 1 }))
120       "decrease the verbosity level"
121     , Option ['O']     ["offline"]
122       (ReqArg (\ n opts -> opts { optOffline = n:optOffline opts }) "NODE")
123       "set node as offline"
124     , Option []        ["memory"]
125       (ReqArg (\ m opts -> opts { optIMem = read m }) "MEMORY")
126       "memory size for instances"
127     , Option []        ["disk"]
128       (ReqArg (\ d opts -> opts { optIDsk = read d }) "DISK")
129       "disk size for instances"
130     , Option []        ["vcpus"]
131       (ReqArg (\ p opts -> opts { optIVCPUs = read p }) "NUM")
132       "number of virtual cpus for instances"
133     , Option []        ["req-nodes"]
134       (ReqArg (\ n opts -> opts { optINodes = read n }) "NODES")
135       "number of nodes for the new instances (1=plain, 2=mirrored)"
136     , Option []        ["max-cpu"]
137       (ReqArg (\ n opts -> opts { optMcpu = read n }) "RATIO")
138       "maximum virtual-to-physical cpu ratio for nodes"
139     , Option []        ["min-disk"]
140       (ReqArg (\ n opts -> opts { optMdsk = read n }) "RATIO")
141       "minimum free disk space for nodes (between 0 and 1)"
142     , Option ['V']     ["version"]
143       (NoArg (\ opts -> opts { optShowVer = True}))
144       "show the version of the program"
145     , Option ['h']     ["help"]
146       (NoArg (\ opts -> opts { optShowHelp = True}))
147       "show help"
148     ]
149
150 filterFails :: Cluster.AllocSolution
151             -> Maybe [(Node.List, Instance.Instance, [Node.Node])]
152 filterFails sols =
153     if null sols then Nothing -- No nodes onto which to allocate at all
154     else let sols' = filter (isJust . fst3) sols
155          in if null sols' then
156                 Nothing -- No valid allocation solutions
157             else
158                 return $ map (\(x, y, z) -> (fromJust x, y, z)) sols'
159
160 processResults :: (Monad m) => [(Node.List, Instance.Instance, [Node.Node])]
161                -> m (Node.List, Instance.Instance, [Node.Node])
162 processResults sols =
163     let sols' = map (\e@(nl', _, _) -> (Cluster.compCV  nl', e)) sols
164         sols'' = sortBy (compare `on` fst) sols'
165     in return $ snd $ head sols''
166
167 iterateDepth :: Node.List
168              -> Instance.List
169              -> Instance.Instance
170              -> Int
171              -> [Instance.Instance]
172              -> (Node.List, [Instance.Instance])
173 iterateDepth nl il newinst nreq ixes =
174       let depth = length ixes
175           newname = (printf "new-%d" depth)::String
176           newidx = (length $ Container.elems il) + depth
177           newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
178           sols = (Cluster.tryAlloc nl il newi2 nreq)::
179                  Maybe Cluster.AllocSolution
180           orig = (nl, ixes)
181       in
182         if isNothing sols then orig
183         else let sols' = fromJust sols
184                  sols'' = filterFails sols'
185              in if isNothing sols'' then orig
186                 else let (xnl, xi, _) = fromJust $ processResults $
187                                         fromJust sols''
188                      in iterateDepth xnl il newinst nreq (xi:ixes)
189
190 printStats :: String -> Cluster.CStats -> IO ()
191 printStats kind cs = do
192   printf "%s free RAM: %d\n" kind (Cluster.cs_fmem cs)
193   printf "%s allocatable RAM: %d\n" kind (Cluster.cs_amem cs)
194   printf "%s free disk: %d\n" kind (Cluster.cs_fdsk cs)
195   printf "%s allocatable disk: %d\n" kind (Cluster.cs_adsk cs)
196   printf "%s max node allocatable RAM: %d\n" kind (Cluster.cs_mmem cs)
197   printf "%s max node allocatable disk: %d\n" kind (Cluster.cs_mdsk cs)
198
199 -- | Main function.
200 main :: IO ()
201 main = do
202   cmd_args <- System.getArgs
203   (opts, args) <- CLI.parseOpts cmd_args "hspace" options defaultOptions
204
205   unless (null args) $ do
206          hPutStrLn stderr "Error: this program doesn't take any arguments."
207          exitWith $ ExitFailure 1
208
209   let verbose = optVerbose opts
210
211   (fixed_nl, il, csf) <- CLI.loadExternalData opts
212   let num_instances = length $ Container.elems il
213
214   let offline_names = optOffline opts
215       all_nodes = Container.elems fixed_nl
216       all_names = map Node.name all_nodes
217       offline_wrong = filter (\n -> not $ elem n all_names) offline_names
218       offline_indices = map Node.idx $
219                         filter (\n -> elem (Node.name n) offline_names)
220                                all_nodes
221       req_nodes = optINodes opts
222       m_cpu = optMcpu opts
223       m_dsk = optMdsk opts
224
225   when (length offline_wrong > 0) $ do
226          printf "Error: Wrong node name(s) set as offline: %s\n"
227                 (commaJoin offline_wrong)
228          exitWith $ ExitFailure 1
229
230   when (req_nodes /= 1 && req_nodes /= 2) $ do
231          printf "Error: Invalid required nodes (%d)\n" req_nodes
232          exitWith $ ExitFailure 1
233
234   let nm = Container.map (\n -> if elem (Node.idx n) offline_indices
235                                 then Node.setOffline n True
236                                 else n) fixed_nl
237       nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
238            nm
239
240   when (length csf > 0 && verbose > 1) $ do
241          printf "Note: Stripping common suffix of '%s' from names\n" csf
242
243   let bad_nodes = fst $ Cluster.computeBadItems nl il
244   when (length bad_nodes > 0) $ do
245          putStrLn "Error: Cluster not N+1, no space to allocate."
246          exitWith $ ExitFailure 1
247
248   when (optShowNodes opts) $
249        do
250          putStrLn "Initial cluster status:"
251          putStrLn $ Cluster.printNodes nl
252
253   let ini_cv = Cluster.compCV nl
254       ini_stats = Cluster.totalResources nl
255
256   (if verbose > 2 then
257        printf "Initial coefficients: overall %.8f, %s\n"
258        ini_cv (Cluster.printStats nl)
259    else
260        printf "Initial score: %.8f\n" ini_cv)
261   printf "Initial instances: %d\n" num_instances
262   printStats "Initial" ini_stats
263
264   let nmlen = Container.maxNameLen nl
265       newinst = Instance.create "new" (optIMem opts) (optIDsk opts)
266                 (optIVCPUs opts) "ADMIN_down" (-1) (-1)
267
268   let (fin_nl, ixes) = iterateDepth nl il newinst req_nodes []
269       allocs = length ixes
270       fin_instances = num_instances + allocs
271       fin_ixes = reverse ixes
272       ix_namelen = maximum . map (length . Instance.name) $ fin_ixes
273       fin_stats = Cluster.totalResources fin_nl
274
275   printf "Final score: %.8f\n" (Cluster.compCV fin_nl)
276   printf "Final instances: %d\n" (num_instances + allocs)
277   printStats "Final" fin_stats
278   printf "Usage: %.5f\n" (((fromIntegral num_instances)::Double) /
279                           (fromIntegral fin_instances))
280   printf "Allocations: %d\n" allocs
281   when (verbose > 1) $ do
282          putStr . unlines . map (\i -> printf "Inst: %*s %-*s %-*s"
283                      ix_namelen (Instance.name i)
284                      nmlen (Container.nameOf fin_nl $ Instance.pnode i)
285                      nmlen (let sdx = Instance.snode i
286                             in if sdx == Node.noSecondary then ""
287                                else Container.nameOf fin_nl sdx))
288          $ fin_ixes
289
290   when (optShowNodes opts) $
291        do
292          putStrLn ""
293          putStrLn "Final cluster status:"
294          putStrLn $ Cluster.printNodes fin_nl