Revision e86f7f65 htools/Ganeti/HTools/Program/Hspace.hs
| b/htools/Ganeti/HTools/Program/Hspace.hs | ||
|---|---|---|
| 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 |
|
Also available in: Unified diff