Revision 5296ee23 htools/Ganeti/HTools/Program/Hspace.hs
| b/htools/Ganeti/HTools/Program/Hspace.hs | ||
|---|---|---|
| 29 | 29 |
import Data.Char (toUpper, isAlphaNum) |
| 30 | 30 |
import Data.Function (on) |
| 31 | 31 |
import Data.List |
| 32 |
import Data.Maybe (isJust, fromJust) |
|
| 33 | 32 |
import Data.Ord (comparing) |
| 34 | 33 |
import System (exitWith, ExitCode(..)) |
| 35 | 34 |
import System.IO |
| ... | ... | |
| 346 | 345 |
sortReasons :: [(FailMode, Int)] -> [(FailMode, Int)] |
| 347 | 346 |
sortReasons = reverse . sortBy (comparing snd) |
| 348 | 347 |
|
| 348 |
-- | Aborts the program if we get a bad value. |
|
| 349 |
exitIfBad :: Result a -> IO a |
|
| 350 |
exitIfBad (Bad s) = |
|
| 351 |
hPrintf stderr "Failure: %s\n" s >> exitWith (ExitFailure 1) |
|
| 352 |
exitIfBad (Ok v) = return v |
|
| 353 |
|
|
| 349 | 354 |
-- | Main function. |
| 350 | 355 |
main :: IO () |
| 351 | 356 |
main = do |
| ... | ... | |
| 365 | 370 |
|
| 366 | 371 |
(ClusterData gl fixed_nl il ctags) <- loadExternalData opts |
| 367 | 372 |
|
| 368 |
let num_instances = length $ Container.elems il |
|
| 369 |
|
|
| 370 |
let offline_passed = optOffline opts |
|
| 373 |
let num_instances = Container.size il |
|
| 371 | 374 |
all_nodes = Container.elems fixed_nl |
| 372 |
offline_lkp = map (lookupName (map Node.name all_nodes)) offline_passed |
|
| 373 |
offline_wrong = filter (not . goodLookupResult) offline_lkp |
|
| 374 |
offline_names = map lrContent offline_lkp |
|
| 375 |
offline_indices = map Node.idx $ |
|
| 376 |
filter (\n -> Node.name n `elem` offline_names) |
|
| 377 |
all_nodes |
|
| 378 | 375 |
m_cpu = optMcpu opts |
| 379 |
m_dsk = optMdsk opts |
|
| 380 |
|
|
| 381 |
when (not (null offline_wrong)) $ do |
|
| 382 |
hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n" |
|
| 383 |
(commaJoin (map lrContent offline_wrong)) :: IO () |
|
| 384 |
exitWith $ ExitFailure 1 |
|
| 385 |
|
|
| 386 |
when (req_nodes /= 1 && req_nodes /= 2) $ do |
|
| 387 |
hPrintf stderr "Error: Invalid required nodes (%d)\n" |
|
| 388 |
req_nodes :: IO () |
|
| 389 |
exitWith $ ExitFailure 1 |
|
| 390 |
|
|
| 391 |
let nm = Container.map (\n -> if Node.idx n `elem` offline_indices |
|
| 392 |
then Node.setOffline n True |
|
| 393 |
else n) fixed_nl |
|
| 394 |
nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu) |
|
| 395 |
nm |
|
| 396 | 376 |
csf = commonSuffix fixed_nl il |
| 397 | 377 |
|
| 398 |
when (length csf > 0 && verbose > 1) $ |
|
| 378 |
nl <- setNodeStatus opts fixed_nl |
|
| 379 |
|
|
| 380 |
when (not (null csf) && verbose > 1) $ |
|
| 399 | 381 |
hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf |
| 400 | 382 |
|
| 401 |
when (isJust shownodes) $ |
|
| 402 |
do |
|
| 403 |
hPutStrLn stderr "Initial cluster status:" |
|
| 404 |
hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes) |
|
| 383 |
maybePrintNodes shownodes "Initial cluster" (Cluster.printNodes nl) |
|
| 405 | 384 |
|
| 406 | 385 |
let ini_cv = Cluster.compCV nl |
| 407 | 386 |
ini_stats = Cluster.totalResources nl |
| ... | ... | |
| 415 | 394 |
printISpec machine_r ispec SpecNormal disk_template |
| 416 | 395 |
|
| 417 | 396 |
let bad_nodes = fst $ Cluster.computeBadItems nl il |
| 418 |
stop_allocation = length bad_nodes > 0
|
|
| 397 |
stop_allocation = not $ null bad_nodes
|
|
| 419 | 398 |
result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [], []) |
| 420 | 399 |
|
| 421 | 400 |
-- utility functions |
| 422 | 401 |
let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx) |
| 423 | 402 |
(rspecCpu spx) "running" [] True (-1) (-1) disk_template |
| 424 |
exitifbad val = (case val of |
|
| 425 |
Bad s -> do |
|
| 426 |
hPrintf stderr "Failure: %s\n" s :: IO () |
|
| 427 |
exitWith $ ExitFailure 1 |
|
| 428 |
Ok x -> return x) |
|
| 429 |
|
|
| 430 | 403 |
|
| 431 | 404 |
let reqinst = iofspec ispec |
| 432 | 405 |
alloclimit = if optMaxLength opts == -1 |
| 433 | 406 |
then Nothing |
| 434 | 407 |
else Just (optMaxLength opts) |
| 435 | 408 |
|
| 436 |
allocnodes <- exitifbad $ Cluster.genAllocNodes gl nl req_nodes True
|
|
| 409 |
allocnodes <- exitIfBad $ Cluster.genAllocNodes gl nl req_nodes True
|
|
| 437 | 410 |
|
| 438 | 411 |
-- Run the tiered allocation, if enabled |
| 439 | 412 |
|
| ... | ... | |
| 443 | 416 |
(treason, trl_nl, trl_il, trl_ixes, _) <- |
| 444 | 417 |
if stop_allocation |
| 445 | 418 |
then return result_noalloc |
| 446 |
else exitifbad (Cluster.tieredAlloc nl il alloclimit (iofspec tspec)
|
|
| 419 |
else exitIfBad (Cluster.tieredAlloc nl il alloclimit (iofspec tspec)
|
|
| 447 | 420 |
allocnodes [] []) |
| 448 | 421 |
let spec_map' = tieredSpecMap trl_ixes |
| 449 | 422 |
treason' = sortReasons treason |
| ... | ... | |
| 466 | 439 |
(ereason, fin_nl, fin_il, ixes, _) <- |
| 467 | 440 |
if stop_allocation |
| 468 | 441 |
then return result_noalloc |
| 469 |
else exitifbad (Cluster.iterateAlloc nl il alloclimit
|
|
| 442 |
else exitIfBad (Cluster.iterateAlloc nl il alloclimit
|
|
| 470 | 443 |
reqinst allocnodes [] []) |
| 471 | 444 |
|
| 472 | 445 |
let allocs = length ixes |
Also available in: Unified diff