Add a new vcpus attribute to instances
[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, fromMaybe, 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     , optShowVer   :: Bool           -- ^ Just show the program version
62     , optShowHelp  :: Bool           -- ^ Just show the help
63     } deriving Show
64
65 instance CLI.CLIOptions Options where
66     showVersion = optShowVer
67     showHelp    = optShowHelp
68
69 instance CLI.EToolOptions Options where
70     nodeFile   = optNodef
71     nodeSet    = optNodeSet
72     instFile   = optInstf
73     instSet    = optInstSet
74     masterName = optMaster
75     silent a   = (optVerbose a) == 0
76
77 -- | Default values for the command line options.
78 defaultOptions :: Options
79 defaultOptions  = Options
80  { optShowNodes = False
81  , optNodef     = "nodes"
82  , optNodeSet   = False
83  , optInstf     = "instances"
84  , optInstSet   = False
85  , optMaster    = ""
86  , optVerbose   = 1
87  , optOffline   = []
88  , optIMem      = 4096
89  , optIDsk      = 102400
90  , optIVCPUs    = 1
91  , optINodes    = 2
92  , optShowVer   = False
93  , optShowHelp  = False
94  }
95
96 -- | Options list and functions
97 options :: [OptDescr (Options -> Options)]
98 options =
99     [ Option ['p']     ["print-nodes"]
100       (NoArg (\ opts -> opts { optShowNodes = True }))
101       "print the final node list"
102     , Option ['n']     ["nodes"]
103       (ReqArg (\ f opts -> opts { optNodef = f, optNodeSet = True }) "FILE")
104       "the node list FILE"
105     , Option ['i']     ["instances"]
106       (ReqArg (\ f opts -> opts { optInstf =  f, optInstSet = True }) "FILE")
107       "the instance list FILE"
108     , Option ['m']     ["master"]
109       (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
110       "collect data via RAPI at the given ADDRESS"
111     , Option ['v']     ["verbose"]
112       (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 }))
113       "increase the verbosity level"
114     , Option ['q']     ["quiet"]
115       (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) - 1 }))
116       "decrease the verbosity level"
117     , Option ['O']     ["offline"]
118       (ReqArg (\ n opts -> opts { optOffline = n:optOffline opts }) "NODE")
119       "set node as offline"
120     , Option []        ["memory"]
121       (ReqArg (\ m opts -> opts { optIMem = read m }) "MEMORY")
122       "memory size for instances"
123     , Option []        ["disk"]
124       (ReqArg (\ d opts -> opts { optIDsk = read d }) "DISK")
125       "disk size for instances"
126     , Option []        ["vcpus"]
127       (ReqArg (\ p opts -> opts { optIVCPUs = read p }) "NUM")
128       "number of virtual cpus for instances"
129     , Option []        ["req-nodes"]
130       (ReqArg (\ n opts -> opts { optINodes = read n }) "NODES")
131       "number of nodes for the new instances (1=plain, 2=mirrored)"
132     , Option ['V']     ["version"]
133       (NoArg (\ opts -> opts { optShowVer = True}))
134       "show the version of the program"
135     , Option ['h']     ["help"]
136       (NoArg (\ opts -> opts { optShowHelp = True}))
137       "show help"
138     ]
139
140 filterFails :: (Monad m) => [(Maybe Node.List, Instance.Instance, [Node.Node])]
141             -> m [(Node.List, Instance.Instance, [Node.Node])]
142 filterFails sols =
143     if null sols then fail "No nodes onto which to allocate at all"
144     else let sols' = filter (isJust . fst3) sols
145          in if null sols' then
146                 fail "No valid allocation solutions"
147             else
148                 return $ map (\(x, y, z) -> (fromJust x, y, z)) sols'
149
150 processResults :: (Monad m) => [(Node.List, Instance.Instance, [Node.Node])]
151                -> m (Node.List, Instance.Instance, [Node.Node])
152 processResults sols =
153     let sols' = map (\e@(nl', _, _) -> (Cluster.compCV  nl', e)) sols
154         sols'' = sortBy (compare `on` fst) sols'
155     in return $ snd $ head sols''
156
157 iterateDepth :: Node.List
158              -> Instance.List
159              -> Instance.Instance
160              -> Int
161              -> [Instance.Instance]
162              -> (Node.List, [Instance.Instance])
163 iterateDepth nl il newinst nreq ixes =
164       let depth = length ixes
165           newname = printf "new-%d" depth
166           newidx = (length $ Container.elems il) + depth
167           newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
168           sols = Cluster.tryAlloc nl il newi2 nreq
169           orig = (nl, ixes)
170       in
171         if isNothing sols then orig
172         else let sols' = fromJust sols
173                  sols'' = filterFails sols'
174              in if isNothing sols'' then orig
175                 else let (xnl, xi, _) = fromJust $ processResults $
176                                         fromJust sols''
177                      in iterateDepth xnl il newinst nreq (xi:ixes)
178
179
180 -- | Main function.
181 main :: IO ()
182 main = do
183   cmd_args <- System.getArgs
184   (opts, args) <- CLI.parseOpts cmd_args "hspace" options defaultOptions
185
186   unless (null args) $ do
187          hPutStrLn stderr "Error: this program doesn't take any arguments."
188          exitWith $ ExitFailure 1
189
190   let verbose = optVerbose opts
191
192   (fixed_nl, il, csf) <- CLI.loadExternalData opts
193   let num_instances = length $ Container.elems il
194
195   let offline_names = optOffline opts
196       all_nodes = Container.elems fixed_nl
197       all_names = map Node.name all_nodes
198       offline_wrong = filter (\n -> not $ elem n all_names) offline_names
199       offline_indices = map Node.idx $
200                         filter (\n -> elem (Node.name n) offline_names)
201                                all_nodes
202       req_nodes = optINodes opts
203
204   when (length offline_wrong > 0) $ do
205          printf "Error: Wrong node name(s) set as offline: %s\n"
206                 (commaJoin offline_wrong)
207          exitWith $ ExitFailure 1
208
209   when (req_nodes /= 1 && req_nodes /= 2) $ do
210          printf "Error: Invalid required nodes (%d)\n" req_nodes
211          exitWith $ ExitFailure 1
212
213   let nl = Container.map (\n -> if elem (Node.idx n) offline_indices
214                                 then Node.setOffline n True
215                                 else n) fixed_nl
216
217   when (length csf > 0 && verbose > 1) $ do
218          printf "Note: Stripping common suffix of '%s' from names\n" csf
219
220   let bad_nodes = fst $ Cluster.computeBadItems nl il
221   when (length bad_nodes > 0) $ do
222          putStrLn "Error: Cluster not N+1, no space to allocate."
223          exitWith $ ExitFailure 1
224
225   when (optShowNodes opts) $
226        do
227          putStrLn "Initial cluster status:"
228          putStrLn $ Cluster.printNodes nl
229
230   let ini_cv = Cluster.compCV nl
231       (orig_mem, orig_disk) = Cluster.totalResources nl
232
233   (if verbose > 2 then
234        printf "Initial coefficients: overall %.8f, %s\n"
235        ini_cv (Cluster.printStats nl)
236    else
237        printf "Initial score: %.8f\n" ini_cv)
238   printf "Initial instances: %d\n" num_instances
239   printf "Initial free RAM: %d\n" orig_mem
240   printf "Initial free disk: %d\n" orig_disk
241
242   let nmlen = Container.maxNameLen nl
243       newinst = Instance.create "new" (optIMem opts) (optIDsk opts)
244                 (optIVCPUs opts) "ADMIN_down" (-1) (-1)
245
246   let (fin_nl, ixes) = iterateDepth nl il newinst req_nodes []
247       allocs = length ixes
248       fin_instances = num_instances + allocs
249       fin_ixes = reverse ixes
250       ix_namelen = maximum . map (length . Instance.name) $ fin_ixes
251       (final_mem, final_disk) = Cluster.totalResources fin_nl
252
253   printf "Final score: %.8f\n" (Cluster.compCV fin_nl)
254   printf "Final instances: %d\n" (num_instances + allocs)
255   printf "Final free RAM: %d\n" final_mem
256   printf "Final free disk: %d\n" final_disk
257   printf "Usage: %.5f\n" (((fromIntegral num_instances)::Double) /
258                           (fromIntegral fin_instances))
259   printf "Allocations: %d\n" allocs
260   when (verbose > 1) $ do
261          putStr . unlines . map (\i -> printf "Inst: %*s %-*s %-*s"
262                      ix_namelen (Instance.name i)
263                      nmlen (Container.nameOf fin_nl $ Instance.pnode i)
264                      nmlen (let sdx = Instance.snode i
265                             in if sdx == Node.noSecondary then ""
266                                else Container.nameOf fin_nl sdx))
267          $ fin_ixes
268
269   when (optShowNodes opts) $
270        do
271          let (orig_mem, orig_disk) = Cluster.totalResources nl
272              (final_mem, final_disk) = Cluster.totalResources fin_nl
273          putStrLn ""
274          putStrLn "Final cluster status:"
275          putStrLn $ Cluster.printNodes fin_nl
276          when (verbose > 3) $
277               do
278                 printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
279                 printf "Final:    mem=%d disk=%d\n" final_mem final_disk