Revision 1494a4cc
b/.gitignore | ||
---|---|---|
98 | 98 |
/htools/.hpc |
99 | 99 |
/htools/coverage |
100 | 100 |
|
101 |
/htools/hspace |
|
102 | 101 |
/htools/htools |
103 | 102 |
/htools/test |
104 | 103 |
/htools/*.prof* |
b/Makefile.am | ||
---|---|---|
306 | 306 |
doc/upgrade.rst \ |
307 | 307 |
doc/walkthrough.rst |
308 | 308 |
|
309 |
HS_PROGS = \ |
|
310 |
htools/hspace \ |
|
311 |
htools/htools |
|
312 |
HS_BIN_ROLES = hbal hscan |
|
309 |
HS_PROGS = htools/htools |
|
310 |
HS_BIN_ROLES = hbal hscan hspace |
|
313 | 311 |
|
314 | 312 |
HS_ALL_PROGS = $(HS_PROGS) htools/test |
315 | 313 |
HS_PROG_SRCS = $(patsubst %,%.hs,$(HS_ALL_PROGS)) |
... | ... | |
344 | 342 |
htools/Ganeti/HTools/Program/Hail.hs \ |
345 | 343 |
htools/Ganeti/HTools/Program/Hbal.hs \ |
346 | 344 |
htools/Ganeti/HTools/Program/Hscan.hs \ |
345 |
htools/Ganeti/HTools/Program/Hspace.hs \ |
|
347 | 346 |
htools/Ganeti/Jobs.hs \ |
348 | 347 |
htools/Ganeti/Luxi.hs \ |
349 | 348 |
htools/Ganeti/OpCodes.hs |
b/htools/Ganeti/HTools/Program/Hspace.hs | ||
---|---|---|
1 |
{-| Cluster space sizing |
|
2 |
|
|
3 |
-} |
|
4 |
|
|
5 |
{- |
|
6 |
|
|
7 |
Copyright (C) 2009, 2010, 2011 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 Ganeti.HTools.Program.Hspace (main) where |
|
27 |
|
|
28 |
import Control.Monad |
|
29 |
import Data.Char (toUpper, isAlphaNum) |
|
30 |
import Data.List |
|
31 |
import Data.Maybe (isJust, fromJust) |
|
32 |
import Data.Ord (comparing) |
|
33 |
import System (exitWith, ExitCode(..)) |
|
34 |
import System.IO |
|
35 |
import qualified System |
|
36 |
|
|
37 |
import Text.Printf (printf, hPrintf) |
|
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 |
|
|
44 |
import Ganeti.HTools.Utils |
|
45 |
import Ganeti.HTools.Types |
|
46 |
import Ganeti.HTools.CLI |
|
47 |
import Ganeti.HTools.ExtLoader |
|
48 |
import Ganeti.HTools.Loader (ClusterData(..)) |
|
49 |
|
|
50 |
-- | Options list and functions |
|
51 |
options :: [OptType] |
|
52 |
options = |
|
53 |
[ oPrintNodes |
|
54 |
, oDataFile |
|
55 |
, oDiskTemplate |
|
56 |
, oNodeSim |
|
57 |
, oRapiMaster |
|
58 |
, oLuxiSocket |
|
59 |
, oVerbose |
|
60 |
, oQuiet |
|
61 |
, oOfflineNode |
|
62 |
, oIMem |
|
63 |
, oIDisk |
|
64 |
, oIVcpus |
|
65 |
, oMaxCpu |
|
66 |
, oMinDisk |
|
67 |
, oTieredSpec |
|
68 |
, oSaveCluster |
|
69 |
, oShowVer |
|
70 |
, oShowHelp |
|
71 |
] |
|
72 |
|
|
73 |
-- | The allocation phase we're in (initial, after tiered allocs, or |
|
74 |
-- after regular allocation). |
|
75 |
data Phase = PInitial |
|
76 |
| PFinal |
|
77 |
| PTiered |
|
78 |
|
|
79 |
statsData :: [(String, Cluster.CStats -> String)] |
|
80 |
statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore) |
|
81 |
, ("INST_CNT", printf "%d" . Cluster.csNinst) |
|
82 |
, ("MEM_FREE", printf "%d" . Cluster.csFmem) |
|
83 |
, ("MEM_AVAIL", printf "%d" . Cluster.csAmem) |
|
84 |
, ("MEM_RESVD", |
|
85 |
\cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs)) |
|
86 |
, ("MEM_INST", printf "%d" . Cluster.csImem) |
|
87 |
, ("MEM_OVERHEAD", |
|
88 |
\cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs)) |
|
89 |
, ("MEM_EFF", |
|
90 |
\cs -> printf "%.8f" (fromIntegral (Cluster.csImem cs) / |
|
91 |
Cluster.csTmem cs)) |
|
92 |
, ("DSK_FREE", printf "%d" . Cluster.csFdsk) |
|
93 |
, ("DSK_AVAIL", printf "%d". Cluster.csAdsk) |
|
94 |
, ("DSK_RESVD", |
|
95 |
\cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs)) |
|
96 |
, ("DSK_INST", printf "%d" . Cluster.csIdsk) |
|
97 |
, ("DSK_EFF", |
|
98 |
\cs -> printf "%.8f" (fromIntegral (Cluster.csIdsk cs) / |
|
99 |
Cluster.csTdsk cs)) |
|
100 |
, ("CPU_INST", printf "%d" . Cluster.csIcpu) |
|
101 |
, ("CPU_EFF", |
|
102 |
\cs -> printf "%.8f" (fromIntegral (Cluster.csIcpu cs) / |
|
103 |
Cluster.csTcpu cs)) |
|
104 |
, ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem) |
|
105 |
, ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk) |
|
106 |
] |
|
107 |
|
|
108 |
specData :: [(String, RSpec -> String)] |
|
109 |
specData = [ ("MEM", printf "%d" . rspecMem) |
|
110 |
, ("DSK", printf "%d" . rspecDsk) |
|
111 |
, ("CPU", printf "%d" . rspecCpu) |
|
112 |
] |
|
113 |
|
|
114 |
clusterData :: [(String, Cluster.CStats -> String)] |
|
115 |
clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem) |
|
116 |
, ("DSK", printf "%.0f" . Cluster.csTdsk) |
|
117 |
, ("CPU", printf "%.0f" . Cluster.csTcpu) |
|
118 |
, ("VCPU", printf "%d" . Cluster.csVcpu) |
|
119 |
] |
|
120 |
|
|
121 |
-- | Function to print stats for a given phase |
|
122 |
printStats :: Phase -> Cluster.CStats -> [(String, String)] |
|
123 |
printStats ph cs = |
|
124 |
map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData |
|
125 |
where kind = case ph of |
|
126 |
PInitial -> "INI" |
|
127 |
PFinal -> "FIN" |
|
128 |
PTiered -> "TRL" |
|
129 |
|
|
130 |
-- | Print final stats and related metrics |
|
131 |
printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO () |
|
132 |
printResults fin_nl num_instances allocs sreason = do |
|
133 |
let fin_stats = Cluster.totalResources fin_nl |
|
134 |
fin_instances = num_instances + allocs |
|
135 |
|
|
136 |
when (num_instances + allocs /= Cluster.csNinst fin_stats) $ |
|
137 |
do |
|
138 |
hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\ |
|
139 |
\ != counted (%d)\n" (num_instances + allocs) |
|
140 |
(Cluster.csNinst fin_stats) :: IO () |
|
141 |
exitWith $ ExitFailure 1 |
|
142 |
|
|
143 |
printKeys $ printStats PFinal fin_stats |
|
144 |
printKeys [ ("ALLOC_USAGE", printf "%.8f" |
|
145 |
((fromIntegral num_instances::Double) / |
|
146 |
fromIntegral fin_instances)) |
|
147 |
, ("ALLOC_INSTANCES", printf "%d" allocs) |
|
148 |
, ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason) |
|
149 |
] |
|
150 |
printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x), |
|
151 |
printf "%d" y)) sreason |
|
152 |
-- this should be the final entry |
|
153 |
printKeys [("OK", "1")] |
|
154 |
|
|
155 |
formatRSpec :: Double -> String -> RSpec -> [(String, String)] |
|
156 |
formatRSpec m_cpu s r = |
|
157 |
[ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r) |
|
158 |
, ("KM_" ++ s ++ "_NPU", show $ fromIntegral (rspecCpu r) / m_cpu) |
|
159 |
, ("KM_" ++ s ++ "_MEM", show $ rspecMem r) |
|
160 |
, ("KM_" ++ s ++ "_DSK", show $ rspecDsk r) |
|
161 |
] |
|
162 |
|
|
163 |
printAllocationStats :: Double -> Node.List -> Node.List -> IO () |
|
164 |
printAllocationStats m_cpu ini_nl fin_nl = do |
|
165 |
let ini_stats = Cluster.totalResources ini_nl |
|
166 |
fin_stats = Cluster.totalResources fin_nl |
|
167 |
(rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats |
|
168 |
printKeys $ formatRSpec m_cpu "USED" rini |
|
169 |
printKeys $ formatRSpec m_cpu "POOL"ralo |
|
170 |
printKeys $ formatRSpec m_cpu "UNAV" runa |
|
171 |
|
|
172 |
-- | Ensure a value is quoted if needed |
|
173 |
ensureQuoted :: String -> String |
|
174 |
ensureQuoted v = if not (all (\c -> isAlphaNum c || c == '.') v) |
|
175 |
then '\'':v ++ "'" |
|
176 |
else v |
|
177 |
|
|
178 |
-- | Format a list of key\/values as a shell fragment |
|
179 |
printKeys :: [(String, String)] -> IO () |
|
180 |
printKeys = mapM_ (\(k, v) -> |
|
181 |
printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v)) |
|
182 |
|
|
183 |
printInstance :: Node.List -> Instance.Instance -> [String] |
|
184 |
printInstance nl i = [ Instance.name i |
|
185 |
, Container.nameOf nl $ Instance.pNode i |
|
186 |
, let sdx = Instance.sNode i |
|
187 |
in if sdx == Node.noSecondary then "" |
|
188 |
else Container.nameOf nl sdx |
|
189 |
, show (Instance.mem i) |
|
190 |
, show (Instance.dsk i) |
|
191 |
, show (Instance.vcpus i) |
|
192 |
] |
|
193 |
|
|
194 |
-- | Optionally print the allocation map |
|
195 |
printAllocationMap :: Int -> String |
|
196 |
-> Node.List -> [Instance.Instance] -> IO () |
|
197 |
printAllocationMap verbose msg nl ixes = |
|
198 |
when (verbose > 1) $ do |
|
199 |
hPutStrLn stderr msg |
|
200 |
hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $ |
|
201 |
formatTable (map (printInstance nl) (reverse ixes)) |
|
202 |
-- This is the numberic-or-not field |
|
203 |
-- specification; the first three fields are |
|
204 |
-- strings, whereas the rest are numeric |
|
205 |
[False, False, False, True, True, True] |
|
206 |
|
|
207 |
-- | Main function. |
|
208 |
main :: IO () |
|
209 |
main = do |
|
210 |
cmd_args <- System.getArgs |
|
211 |
(opts, args) <- parseOpts cmd_args "hspace" options |
|
212 |
|
|
213 |
unless (null args) $ do |
|
214 |
hPutStrLn stderr "Error: this program doesn't take any arguments." |
|
215 |
exitWith $ ExitFailure 1 |
|
216 |
|
|
217 |
let verbose = optVerbose opts |
|
218 |
ispec = optISpec opts |
|
219 |
shownodes = optShowNodes opts |
|
220 |
disk_template = optDiskTemplate opts |
|
221 |
req_nodes = Instance.requiredNodes disk_template |
|
222 |
|
|
223 |
(ClusterData gl fixed_nl il ctags) <- loadExternalData opts |
|
224 |
|
|
225 |
printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData |
|
226 |
printKeys [ ("SPEC_RQN", printf "%d" req_nodes) ] |
|
227 |
printKeys [ ("SPEC_DISK_TEMPLATE", dtToString disk_template) ] |
|
228 |
|
|
229 |
let num_instances = length $ Container.elems il |
|
230 |
|
|
231 |
let offline_names = optOffline opts |
|
232 |
all_nodes = Container.elems fixed_nl |
|
233 |
all_names = map Node.name all_nodes |
|
234 |
offline_wrong = filter (`notElem` all_names) offline_names |
|
235 |
offline_indices = map Node.idx $ |
|
236 |
filter (\n -> |
|
237 |
Node.name n `elem` offline_names || |
|
238 |
Node.alias n `elem` offline_names) |
|
239 |
all_nodes |
|
240 |
m_cpu = optMcpu opts |
|
241 |
m_dsk = optMdsk opts |
|
242 |
|
|
243 |
when (length offline_wrong > 0) $ do |
|
244 |
hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n" |
|
245 |
(commaJoin offline_wrong) :: IO () |
|
246 |
exitWith $ ExitFailure 1 |
|
247 |
|
|
248 |
when (req_nodes /= 1 && req_nodes /= 2) $ do |
|
249 |
hPrintf stderr "Error: Invalid required nodes (%d)\n" |
|
250 |
req_nodes :: IO () |
|
251 |
exitWith $ ExitFailure 1 |
|
252 |
|
|
253 |
let nm = Container.map (\n -> if Node.idx n `elem` offline_indices |
|
254 |
then Node.setOffline n True |
|
255 |
else n) fixed_nl |
|
256 |
nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu) |
|
257 |
nm |
|
258 |
csf = commonSuffix fixed_nl il |
|
259 |
|
|
260 |
when (length csf > 0 && verbose > 1) $ |
|
261 |
hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf |
|
262 |
|
|
263 |
when (isJust shownodes) $ |
|
264 |
do |
|
265 |
hPutStrLn stderr "Initial cluster status:" |
|
266 |
hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes) |
|
267 |
|
|
268 |
let ini_cv = Cluster.compCV nl |
|
269 |
ini_stats = Cluster.totalResources nl |
|
270 |
|
|
271 |
when (verbose > 2) $ |
|
272 |
hPrintf stderr "Initial coefficients: overall %.8f, %s\n" |
|
273 |
ini_cv (Cluster.printStats nl) |
|
274 |
|
|
275 |
printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData |
|
276 |
printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))] |
|
277 |
printKeys $ printStats PInitial ini_stats |
|
278 |
|
|
279 |
let bad_nodes = fst $ Cluster.computeBadItems nl il |
|
280 |
stop_allocation = length bad_nodes > 0 |
|
281 |
result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [], []) |
|
282 |
|
|
283 |
-- utility functions |
|
284 |
let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx) |
|
285 |
(rspecCpu spx) "running" [] True (-1) (-1) disk_template |
|
286 |
exitifbad val = (case val of |
|
287 |
Bad s -> do |
|
288 |
hPrintf stderr "Failure: %s\n" s :: IO () |
|
289 |
exitWith $ ExitFailure 1 |
|
290 |
Ok x -> return x) |
|
291 |
|
|
292 |
|
|
293 |
let reqinst = iofspec ispec |
|
294 |
|
|
295 |
allocnodes <- exitifbad $ Cluster.genAllocNodes gl nl req_nodes True |
|
296 |
|
|
297 |
-- Run the tiered allocation, if enabled |
|
298 |
|
|
299 |
(case optTieredSpec opts of |
|
300 |
Nothing -> return () |
|
301 |
Just tspec -> do |
|
302 |
(_, trl_nl, trl_il, trl_ixes, _) <- |
|
303 |
if stop_allocation |
|
304 |
then return result_noalloc |
|
305 |
else exitifbad (Cluster.tieredAlloc nl il Nothing (iofspec tspec) |
|
306 |
allocnodes [] []) |
|
307 |
let spec_map' = Cluster.tieredSpecMap trl_ixes |
|
308 |
|
|
309 |
printAllocationMap verbose "Tiered allocation map" trl_nl trl_ixes |
|
310 |
|
|
311 |
maybePrintNodes shownodes "Tiered allocation" |
|
312 |
(Cluster.printNodes trl_nl) |
|
313 |
|
|
314 |
maybeSaveData (optSaveCluster opts) "tiered" "after tiered allocation" |
|
315 |
(ClusterData gl trl_nl trl_il ctags) |
|
316 |
|
|
317 |
printKeys $ map (\(a, fn) -> ("TSPEC_INI_" ++ a, fn tspec)) specData |
|
318 |
printKeys $ printStats PTiered (Cluster.totalResources trl_nl) |
|
319 |
printKeys [("TSPEC", intercalate " " spec_map')] |
|
320 |
printAllocationStats m_cpu nl trl_nl) |
|
321 |
|
|
322 |
-- Run the standard (avg-mode) allocation |
|
323 |
|
|
324 |
(ereason, fin_nl, fin_il, ixes, _) <- |
|
325 |
if stop_allocation |
|
326 |
then return result_noalloc |
|
327 |
else exitifbad (Cluster.iterateAlloc nl il Nothing |
|
328 |
reqinst allocnodes [] []) |
|
329 |
|
|
330 |
let allocs = length ixes |
|
331 |
sreason = reverse $ sortBy (comparing snd) ereason |
|
332 |
|
|
333 |
printAllocationMap verbose "Standard allocation map" fin_nl ixes |
|
334 |
|
|
335 |
maybePrintNodes shownodes "Standard allocation" (Cluster.printNodes fin_nl) |
|
336 |
|
|
337 |
maybeSaveData (optSaveCluster opts) "alloc" "after standard allocation" |
|
338 |
(ClusterData gl fin_nl fin_il ctags) |
|
339 |
|
|
340 |
printResults fin_nl num_instances allocs sreason |
/dev/null | ||
---|---|---|
1 |
{-| Cluster space sizing |
|
2 |
|
|
3 |
-} |
|
4 |
|
|
5 |
{- |
|
6 |
|
|
7 |
Copyright (C) 2009, 2010, 2011 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 Control.Monad |
|
29 |
import Data.Char (toUpper, isAlphaNum) |
|
30 |
import Data.List |
|
31 |
import Data.Maybe (isJust, fromJust) |
|
32 |
import Data.Ord (comparing) |
|
33 |
import System (exitWith, ExitCode(..)) |
|
34 |
import System.IO |
|
35 |
import qualified System |
|
36 |
|
|
37 |
import Text.Printf (printf, hPrintf) |
|
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 |
|
|
44 |
import Ganeti.HTools.Utils |
|
45 |
import Ganeti.HTools.Types |
|
46 |
import Ganeti.HTools.CLI |
|
47 |
import Ganeti.HTools.ExtLoader |
|
48 |
import Ganeti.HTools.Loader (ClusterData(..)) |
|
49 |
|
|
50 |
-- | Options list and functions |
|
51 |
options :: [OptType] |
|
52 |
options = |
|
53 |
[ oPrintNodes |
|
54 |
, oDataFile |
|
55 |
, oDiskTemplate |
|
56 |
, oNodeSim |
|
57 |
, oRapiMaster |
|
58 |
, oLuxiSocket |
|
59 |
, oVerbose |
|
60 |
, oQuiet |
|
61 |
, oOfflineNode |
|
62 |
, oIMem |
|
63 |
, oIDisk |
|
64 |
, oIVcpus |
|
65 |
, oMaxCpu |
|
66 |
, oMinDisk |
|
67 |
, oTieredSpec |
|
68 |
, oSaveCluster |
|
69 |
, oShowVer |
|
70 |
, oShowHelp |
|
71 |
] |
|
72 |
|
|
73 |
-- | The allocation phase we're in (initial, after tiered allocs, or |
|
74 |
-- after regular allocation). |
|
75 |
data Phase = PInitial |
|
76 |
| PFinal |
|
77 |
| PTiered |
|
78 |
|
|
79 |
statsData :: [(String, Cluster.CStats -> String)] |
|
80 |
statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore) |
|
81 |
, ("INST_CNT", printf "%d" . Cluster.csNinst) |
|
82 |
, ("MEM_FREE", printf "%d" . Cluster.csFmem) |
|
83 |
, ("MEM_AVAIL", printf "%d" . Cluster.csAmem) |
|
84 |
, ("MEM_RESVD", |
|
85 |
\cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs)) |
|
86 |
, ("MEM_INST", printf "%d" . Cluster.csImem) |
|
87 |
, ("MEM_OVERHEAD", |
|
88 |
\cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs)) |
|
89 |
, ("MEM_EFF", |
|
90 |
\cs -> printf "%.8f" (fromIntegral (Cluster.csImem cs) / |
|
91 |
Cluster.csTmem cs)) |
|
92 |
, ("DSK_FREE", printf "%d" . Cluster.csFdsk) |
|
93 |
, ("DSK_AVAIL", printf "%d". Cluster.csAdsk) |
|
94 |
, ("DSK_RESVD", |
|
95 |
\cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs)) |
|
96 |
, ("DSK_INST", printf "%d" . Cluster.csIdsk) |
|
97 |
, ("DSK_EFF", |
|
98 |
\cs -> printf "%.8f" (fromIntegral (Cluster.csIdsk cs) / |
|
99 |
Cluster.csTdsk cs)) |
|
100 |
, ("CPU_INST", printf "%d" . Cluster.csIcpu) |
|
101 |
, ("CPU_EFF", |
|
102 |
\cs -> printf "%.8f" (fromIntegral (Cluster.csIcpu cs) / |
|
103 |
Cluster.csTcpu cs)) |
|
104 |
, ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem) |
|
105 |
, ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk) |
|
106 |
] |
|
107 |
|
|
108 |
specData :: [(String, RSpec -> String)] |
|
109 |
specData = [ ("MEM", printf "%d" . rspecMem) |
|
110 |
, ("DSK", printf "%d" . rspecDsk) |
|
111 |
, ("CPU", printf "%d" . rspecCpu) |
|
112 |
] |
|
113 |
|
|
114 |
clusterData :: [(String, Cluster.CStats -> String)] |
|
115 |
clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem) |
|
116 |
, ("DSK", printf "%.0f" . Cluster.csTdsk) |
|
117 |
, ("CPU", printf "%.0f" . Cluster.csTcpu) |
|
118 |
, ("VCPU", printf "%d" . Cluster.csVcpu) |
|
119 |
] |
|
120 |
|
|
121 |
-- | Function to print stats for a given phase |
|
122 |
printStats :: Phase -> Cluster.CStats -> [(String, String)] |
|
123 |
printStats ph cs = |
|
124 |
map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData |
|
125 |
where kind = case ph of |
|
126 |
PInitial -> "INI" |
|
127 |
PFinal -> "FIN" |
|
128 |
PTiered -> "TRL" |
|
129 |
|
|
130 |
-- | Print final stats and related metrics |
|
131 |
printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO () |
|
132 |
printResults fin_nl num_instances allocs sreason = do |
|
133 |
let fin_stats = Cluster.totalResources fin_nl |
|
134 |
fin_instances = num_instances + allocs |
|
135 |
|
|
136 |
when (num_instances + allocs /= Cluster.csNinst fin_stats) $ |
|
137 |
do |
|
138 |
hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\ |
|
139 |
\ != counted (%d)\n" (num_instances + allocs) |
|
140 |
(Cluster.csNinst fin_stats) :: IO () |
|
141 |
exitWith $ ExitFailure 1 |
|
142 |
|
|
143 |
printKeys $ printStats PFinal fin_stats |
|
144 |
printKeys [ ("ALLOC_USAGE", printf "%.8f" |
|
145 |
((fromIntegral num_instances::Double) / |
|
146 |
fromIntegral fin_instances)) |
|
147 |
, ("ALLOC_INSTANCES", printf "%d" allocs) |
|
148 |
, ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason) |
|
149 |
] |
|
150 |
printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x), |
|
151 |
printf "%d" y)) sreason |
|
152 |
-- this should be the final entry |
|
153 |
printKeys [("OK", "1")] |
|
154 |
|
|
155 |
formatRSpec :: Double -> String -> RSpec -> [(String, String)] |
|
156 |
formatRSpec m_cpu s r = |
|
157 |
[ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r) |
|
158 |
, ("KM_" ++ s ++ "_NPU", show $ fromIntegral (rspecCpu r) / m_cpu) |
|
159 |
, ("KM_" ++ s ++ "_MEM", show $ rspecMem r) |
|
160 |
, ("KM_" ++ s ++ "_DSK", show $ rspecDsk r) |
|
161 |
] |
|
162 |
|
|
163 |
printAllocationStats :: Double -> Node.List -> Node.List -> IO () |
|
164 |
printAllocationStats m_cpu ini_nl fin_nl = do |
|
165 |
let ini_stats = Cluster.totalResources ini_nl |
|
166 |
fin_stats = Cluster.totalResources fin_nl |
|
167 |
(rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats |
|
168 |
printKeys $ formatRSpec m_cpu "USED" rini |
|
169 |
printKeys $ formatRSpec m_cpu "POOL"ralo |
|
170 |
printKeys $ formatRSpec m_cpu "UNAV" runa |
|
171 |
|
|
172 |
-- | Ensure a value is quoted if needed |
|
173 |
ensureQuoted :: String -> String |
|
174 |
ensureQuoted v = if not (all (\c -> isAlphaNum c || c == '.') v) |
|
175 |
then '\'':v ++ "'" |
|
176 |
else v |
|
177 |
|
|
178 |
-- | Format a list of key\/values as a shell fragment |
|
179 |
printKeys :: [(String, String)] -> IO () |
|
180 |
printKeys = mapM_ (\(k, v) -> |
|
181 |
printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v)) |
|
182 |
|
|
183 |
printInstance :: Node.List -> Instance.Instance -> [String] |
|
184 |
printInstance nl i = [ Instance.name i |
|
185 |
, Container.nameOf nl $ Instance.pNode i |
|
186 |
, let sdx = Instance.sNode i |
|
187 |
in if sdx == Node.noSecondary then "" |
|
188 |
else Container.nameOf nl sdx |
|
189 |
, show (Instance.mem i) |
|
190 |
, show (Instance.dsk i) |
|
191 |
, show (Instance.vcpus i) |
|
192 |
] |
|
193 |
|
|
194 |
-- | Optionally print the allocation map |
|
195 |
printAllocationMap :: Int -> String |
|
196 |
-> Node.List -> [Instance.Instance] -> IO () |
|
197 |
printAllocationMap verbose msg nl ixes = |
|
198 |
when (verbose > 1) $ do |
|
199 |
hPutStrLn stderr msg |
|
200 |
hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $ |
|
201 |
formatTable (map (printInstance nl) (reverse ixes)) |
|
202 |
-- This is the numberic-or-not field |
|
203 |
-- specification; the first three fields are |
|
204 |
-- strings, whereas the rest are numeric |
|
205 |
[False, False, False, True, True, True] |
|
206 |
|
|
207 |
-- | Main function. |
|
208 |
main :: IO () |
|
209 |
main = do |
|
210 |
cmd_args <- System.getArgs |
|
211 |
(opts, args) <- parseOpts cmd_args "hspace" options |
|
212 |
|
|
213 |
unless (null args) $ do |
|
214 |
hPutStrLn stderr "Error: this program doesn't take any arguments." |
|
215 |
exitWith $ ExitFailure 1 |
|
216 |
|
|
217 |
let verbose = optVerbose opts |
|
218 |
ispec = optISpec opts |
|
219 |
shownodes = optShowNodes opts |
|
220 |
disk_template = optDiskTemplate opts |
|
221 |
req_nodes = Instance.requiredNodes disk_template |
|
222 |
|
|
223 |
(ClusterData gl fixed_nl il ctags) <- loadExternalData opts |
|
224 |
|
|
225 |
printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData |
|
226 |
printKeys [ ("SPEC_RQN", printf "%d" req_nodes) ] |
|
227 |
printKeys [ ("SPEC_DISK_TEMPLATE", dtToString disk_template) ] |
|
228 |
|
|
229 |
let num_instances = length $ Container.elems il |
|
230 |
|
|
231 |
let offline_names = optOffline opts |
|
232 |
all_nodes = Container.elems fixed_nl |
|
233 |
all_names = map Node.name all_nodes |
|
234 |
offline_wrong = filter (`notElem` all_names) offline_names |
|
235 |
offline_indices = map Node.idx $ |
|
236 |
filter (\n -> |
|
237 |
Node.name n `elem` offline_names || |
|
238 |
Node.alias n `elem` offline_names) |
|
239 |
all_nodes |
|
240 |
m_cpu = optMcpu opts |
|
241 |
m_dsk = optMdsk opts |
|
242 |
|
|
243 |
when (length offline_wrong > 0) $ do |
|
244 |
hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n" |
|
245 |
(commaJoin offline_wrong) :: IO () |
|
246 |
exitWith $ ExitFailure 1 |
|
247 |
|
|
248 |
when (req_nodes /= 1 && req_nodes /= 2) $ do |
|
249 |
hPrintf stderr "Error: Invalid required nodes (%d)\n" |
|
250 |
req_nodes :: IO () |
|
251 |
exitWith $ ExitFailure 1 |
|
252 |
|
|
253 |
let nm = Container.map (\n -> if Node.idx n `elem` offline_indices |
|
254 |
then Node.setOffline n True |
|
255 |
else n) fixed_nl |
|
256 |
nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu) |
|
257 |
nm |
|
258 |
csf = commonSuffix fixed_nl il |
|
259 |
|
|
260 |
when (length csf > 0 && verbose > 1) $ |
|
261 |
hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf |
|
262 |
|
|
263 |
when (isJust shownodes) $ |
|
264 |
do |
|
265 |
hPutStrLn stderr "Initial cluster status:" |
|
266 |
hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes) |
|
267 |
|
|
268 |
let ini_cv = Cluster.compCV nl |
|
269 |
ini_stats = Cluster.totalResources nl |
|
270 |
|
|
271 |
when (verbose > 2) $ |
|
272 |
hPrintf stderr "Initial coefficients: overall %.8f, %s\n" |
|
273 |
ini_cv (Cluster.printStats nl) |
|
274 |
|
|
275 |
printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData |
|
276 |
printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))] |
|
277 |
printKeys $ printStats PInitial ini_stats |
|
278 |
|
|
279 |
let bad_nodes = fst $ Cluster.computeBadItems nl il |
|
280 |
stop_allocation = length bad_nodes > 0 |
|
281 |
result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [], []) |
|
282 |
|
|
283 |
-- utility functions |
|
284 |
let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx) |
|
285 |
(rspecCpu spx) "running" [] True (-1) (-1) disk_template |
|
286 |
exitifbad val = (case val of |
|
287 |
Bad s -> do |
|
288 |
hPrintf stderr "Failure: %s\n" s :: IO () |
|
289 |
exitWith $ ExitFailure 1 |
|
290 |
Ok x -> return x) |
|
291 |
|
|
292 |
|
|
293 |
let reqinst = iofspec ispec |
|
294 |
|
|
295 |
allocnodes <- exitifbad $ Cluster.genAllocNodes gl nl req_nodes True |
|
296 |
|
|
297 |
-- Run the tiered allocation, if enabled |
|
298 |
|
|
299 |
(case optTieredSpec opts of |
|
300 |
Nothing -> return () |
|
301 |
Just tspec -> do |
|
302 |
(_, trl_nl, trl_il, trl_ixes, _) <- |
|
303 |
if stop_allocation |
|
304 |
then return result_noalloc |
|
305 |
else exitifbad (Cluster.tieredAlloc nl il Nothing (iofspec tspec) |
|
306 |
allocnodes [] []) |
|
307 |
let spec_map' = Cluster.tieredSpecMap trl_ixes |
|
308 |
|
|
309 |
printAllocationMap verbose "Tiered allocation map" trl_nl trl_ixes |
|
310 |
|
|
311 |
maybePrintNodes shownodes "Tiered allocation" |
|
312 |
(Cluster.printNodes trl_nl) |
|
313 |
|
|
314 |
maybeSaveData (optSaveCluster opts) "tiered" "after tiered allocation" |
|
315 |
(ClusterData gl trl_nl trl_il ctags) |
|
316 |
|
|
317 |
printKeys $ map (\(a, fn) -> ("TSPEC_INI_" ++ a, fn tspec)) specData |
|
318 |
printKeys $ printStats PTiered (Cluster.totalResources trl_nl) |
|
319 |
printKeys [("TSPEC", intercalate " " spec_map')] |
|
320 |
printAllocationStats m_cpu nl trl_nl) |
|
321 |
|
|
322 |
-- Run the standard (avg-mode) allocation |
|
323 |
|
|
324 |
(ereason, fin_nl, fin_il, ixes, _) <- |
|
325 |
if stop_allocation |
|
326 |
then return result_noalloc |
|
327 |
else exitifbad (Cluster.iterateAlloc nl il Nothing |
|
328 |
reqinst allocnodes [] []) |
|
329 |
|
|
330 |
let allocs = length ixes |
|
331 |
sreason = reverse $ sortBy (comparing snd) ereason |
|
332 |
|
|
333 |
printAllocationMap verbose "Standard allocation map" fin_nl ixes |
|
334 |
|
|
335 |
maybePrintNodes shownodes "Standard allocation" (Cluster.printNodes fin_nl) |
|
336 |
|
|
337 |
maybeSaveData (optSaveCluster opts) "alloc" "after standard allocation" |
|
338 |
(ClusterData gl fin_nl fin_il ctags) |
|
339 |
|
|
340 |
printResults fin_nl num_instances allocs sreason |
b/htools/htools.hs | ||
---|---|---|
33 | 33 |
import qualified Ganeti.HTools.Program.Hail as Hail |
34 | 34 |
import qualified Ganeti.HTools.Program.Hbal as Hbal |
35 | 35 |
import qualified Ganeti.HTools.Program.Hscan as Hscan |
36 |
import qualified Ganeti.HTools.Program.Hspace as Hspace |
|
36 | 37 |
|
37 | 38 |
-- | Supported binaries. |
38 | 39 |
personalities :: [(String, IO ())] |
39 | 40 |
personalities = [ ("hail", Hail.main) |
40 | 41 |
, ("hbal", Hbal.main) |
41 | 42 |
, ("hscan", Hscan.main) |
43 |
, ("hspace", Hspace.main) |
|
42 | 44 |
] |
43 | 45 |
|
44 | 46 |
-- | Display usage and exit. |
Also available in: Unified diff