26 |
26 |
module Ganeti.HTools.Program.Hspace (main) where
|
27 |
27 |
|
28 |
28 |
import Control.Monad
|
29 |
|
import Data.Char (toUpper, isAlphaNum)
|
|
29 |
import Data.Char (toUpper, isAlphaNum, toLower)
|
30 |
30 |
import Data.Function (on)
|
31 |
31 |
import Data.List
|
32 |
32 |
import Data.Ord (comparing)
|
... | ... | |
89 |
89 |
|
90 |
90 |
-- | The description of a spec.
|
91 |
91 |
specDescription :: SpecType -> String
|
92 |
|
specDescription SpecNormal = "Normal (fixed-size)"
|
|
92 |
specDescription SpecNormal = "Standard (fixed-size)"
|
93 |
93 |
specDescription SpecTiered = "Tiered (initial size)"
|
94 |
94 |
|
95 |
95 |
-- | Efficiency generic function.
|
... | ... | |
262 |
262 |
-> Node.List -> [Instance.Instance] -> IO ()
|
263 |
263 |
printAllocationMap verbose msg nl ixes =
|
264 |
264 |
when (verbose > 1) $ do
|
265 |
|
hPutStrLn stderr msg
|
|
265 |
hPutStrLn stderr (msg ++ " map")
|
266 |
266 |
hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
|
267 |
267 |
formatTable (map (printInstance nl) (reverse ixes))
|
268 |
268 |
-- This is the numberic-or-not field
|
... | ... | |
351 |
351 |
hPrintf stderr "Failure: %s\n" s >> exitWith (ExitFailure 1)
|
352 |
352 |
exitIfBad (Ok v) = return v
|
353 |
353 |
|
|
354 |
-- | Runs an allocation algorithm and saves cluster state.
|
|
355 |
runAllocation :: ClusterData -- ^ Cluster data
|
|
356 |
-> Maybe Cluster.AllocResult -- ^ Optional stop-allocation
|
|
357 |
-> Result Cluster.AllocResult -- ^ Allocation result
|
|
358 |
-> RSpec -- ^ Requested instance spec
|
|
359 |
-> SpecType -- ^ Allocation type
|
|
360 |
-> Options -- ^ CLI options
|
|
361 |
-> IO (FailStats, Node.List, Int, [(RSpec, Int)])
|
|
362 |
runAllocation cdata stop_allocation actual_result spec mode opts = do
|
|
363 |
(reasons, new_nl, new_il, new_ixes, _) <-
|
|
364 |
case stop_allocation of
|
|
365 |
Just result_noalloc -> return result_noalloc
|
|
366 |
Nothing -> exitIfBad actual_result
|
|
367 |
|
|
368 |
let name = head . words . specDescription $ mode
|
|
369 |
descr = name ++ " allocation"
|
|
370 |
ldescr = "after " ++ map toLower descr
|
|
371 |
|
|
372 |
printISpec (optMachineReadable opts) spec mode (optDiskTemplate opts)
|
|
373 |
|
|
374 |
printAllocationMap (optVerbose opts) descr new_nl new_ixes
|
|
375 |
|
|
376 |
maybePrintNodes (optShowNodes opts) descr (Cluster.printNodes new_nl)
|
|
377 |
|
|
378 |
maybeSaveData (optSaveCluster opts) (map toLower name) ldescr
|
|
379 |
(cdata { cdNodes = new_nl, cdInstances = new_il})
|
|
380 |
|
|
381 |
return (sortReasons reasons, new_nl, length new_ixes, tieredSpecMap new_ixes)
|
|
382 |
|
354 |
383 |
-- | Main function.
|
355 |
384 |
main :: IO ()
|
356 |
385 |
main = do
|
... | ... | |
363 |
392 |
|
364 |
393 |
let verbose = optVerbose opts
|
365 |
394 |
ispec = optISpec opts
|
366 |
|
shownodes = optShowNodes opts
|
367 |
395 |
disk_template = optDiskTemplate opts
|
368 |
396 |
req_nodes = Instance.requiredNodes disk_template
|
369 |
397 |
machine_r = optMachineReadable opts
|
370 |
398 |
|
371 |
399 |
(ClusterData gl fixed_nl il ctags) <- loadExternalData opts
|
|
400 |
nl <- setNodeStatus opts fixed_nl
|
372 |
401 |
|
373 |
402 |
let num_instances = Container.size il
|
374 |
403 |
all_nodes = Container.elems fixed_nl
|
375 |
|
m_cpu = optMcpu opts
|
|
404 |
cdata = ClusterData gl nl il ctags
|
376 |
405 |
csf = commonSuffix fixed_nl il
|
377 |
406 |
|
378 |
|
nl <- setNodeStatus opts fixed_nl
|
379 |
|
|
380 |
407 |
when (not (null csf) && verbose > 1) $
|
381 |
408 |
hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
|
382 |
409 |
|
383 |
|
maybePrintNodes shownodes "Initial cluster" (Cluster.printNodes nl)
|
384 |
|
|
385 |
|
let ini_cv = Cluster.compCV nl
|
386 |
|
ini_stats = Cluster.totalResources nl
|
|
410 |
maybePrintNodes (optShowNodes opts) "Initial cluster" (Cluster.printNodes nl)
|
387 |
411 |
|
388 |
412 |
when (verbose > 2) $
|
389 |
413 |
hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
|
390 |
|
ini_cv (Cluster.printStats nl)
|
|
414 |
(Cluster.compCV nl) (Cluster.printStats nl)
|
391 |
415 |
|
392 |
|
printCluster machine_r ini_stats (length all_nodes)
|
|
416 |
printCluster machine_r (Cluster.totalResources nl) (length all_nodes)
|
393 |
417 |
|
394 |
|
printISpec machine_r ispec SpecNormal disk_template
|
395 |
|
|
396 |
|
let bad_nodes = fst $ Cluster.computeBadItems nl il
|
397 |
|
stop_allocation = not $ null bad_nodes
|
398 |
|
result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [], [])
|
|
418 |
let stop_allocation = case Cluster.computeBadItems nl il of
|
|
419 |
([], _) -> Nothing
|
|
420 |
_ -> Just ([(FailN1, 1)]::FailStats, nl, il, [], [])
|
|
421 |
alloclimit = if optMaxLength opts == -1
|
|
422 |
then Nothing
|
|
423 |
else Just (optMaxLength opts)
|
399 |
424 |
|
400 |
425 |
-- utility functions
|
401 |
426 |
let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
|
402 |
427 |
(rspecCpu spx) "running" [] True (-1) (-1) disk_template
|
403 |
428 |
|
404 |
|
let reqinst = iofspec ispec
|
405 |
|
alloclimit = if optMaxLength opts == -1
|
406 |
|
then Nothing
|
407 |
|
else Just (optMaxLength opts)
|
408 |
|
|
409 |
429 |
allocnodes <- exitIfBad $ Cluster.genAllocNodes gl nl req_nodes True
|
410 |
430 |
|
411 |
431 |
-- Run the tiered allocation, if enabled
|
... | ... | |
413 |
433 |
(case optTieredSpec opts of
|
414 |
434 |
Nothing -> return ()
|
415 |
435 |
Just tspec -> do
|
416 |
|
(treason, trl_nl, trl_il, trl_ixes, _) <-
|
417 |
|
if stop_allocation
|
418 |
|
then return result_noalloc
|
419 |
|
else exitIfBad (Cluster.tieredAlloc nl il alloclimit (iofspec tspec)
|
420 |
|
allocnodes [] [])
|
421 |
|
let spec_map' = tieredSpecMap trl_ixes
|
422 |
|
treason' = sortReasons treason
|
423 |
|
|
424 |
|
printAllocationMap verbose "Tiered allocation map" trl_nl trl_ixes
|
425 |
|
|
426 |
|
maybePrintNodes shownodes "Tiered allocation"
|
427 |
|
(Cluster.printNodes trl_nl)
|
|
436 |
(treason, trl_nl, _, spec_map) <-
|
|
437 |
runAllocation cdata stop_allocation
|
|
438 |
(Cluster.tieredAlloc nl il alloclimit (iofspec tspec)
|
|
439 |
allocnodes [] []) tspec SpecTiered opts
|
428 |
440 |
|
429 |
|
maybeSaveData (optSaveCluster opts) "tiered" "after tiered allocation"
|
430 |
|
(ClusterData gl trl_nl trl_il ctags)
|
431 |
|
|
432 |
|
printISpec machine_r tspec SpecTiered disk_template
|
433 |
|
|
434 |
|
printTiered machine_r spec_map' m_cpu nl trl_nl treason'
|
|
441 |
printTiered machine_r spec_map (optMcpu opts) nl trl_nl treason
|
435 |
442 |
)
|
436 |
443 |
|
437 |
444 |
-- Run the standard (avg-mode) allocation
|
438 |
445 |
|
439 |
|
(ereason, fin_nl, fin_il, ixes, _) <-
|
440 |
|
if stop_allocation
|
441 |
|
then return result_noalloc
|
442 |
|
else exitIfBad (Cluster.iterateAlloc nl il alloclimit
|
443 |
|
reqinst allocnodes [] [])
|
444 |
|
|
445 |
|
let allocs = length ixes
|
446 |
|
sreason = sortReasons ereason
|
447 |
|
|
448 |
|
printAllocationMap verbose "Standard allocation map" fin_nl ixes
|
449 |
|
|
450 |
|
maybePrintNodes shownodes "Standard allocation" (Cluster.printNodes fin_nl)
|
451 |
|
|
452 |
|
maybeSaveData (optSaveCluster opts) "alloc" "after standard allocation"
|
453 |
|
(ClusterData gl fin_nl fin_il ctags)
|
|
446 |
(sreason, fin_nl, allocs, _) <-
|
|
447 |
runAllocation cdata stop_allocation
|
|
448 |
(Cluster.iterateAlloc nl il alloclimit (iofspec ispec)
|
|
449 |
allocnodes [] []) ispec SpecNormal opts
|
454 |
450 |
|
455 |
451 |
printResults machine_r nl fin_nl num_instances allocs sreason
|
456 |
452 |
|