Revision 685935f7 Ganeti/HTools/Cluster.hs
| b/Ganeti/HTools/Cluster.hs | ||
|---|---|---|
| 45 | 45 |
, formatCmds |
| 46 | 46 |
, printNodes |
| 47 | 47 |
-- * Balacing functions |
| 48 |
, applyMove |
|
| 49 | 48 |
, checkMove |
| 50 | 49 |
, compCV |
| 51 | 50 |
, printStats |
| 52 | 51 |
-- * IAllocator functions |
| 53 |
, allocateOnSingle |
|
| 54 |
, allocateOnPair |
|
| 55 | 52 |
, tryAlloc |
| 56 | 53 |
, tryReloc |
| 57 | 54 |
) where |
| ... | ... | |
| 335 | 332 |
|
| 336 | 333 |
-- | Tries to allocate an instance on one given node. |
| 337 | 334 |
allocateOnSingle :: Node.List -> Instance.Instance -> Node.Node |
| 338 |
-> OpResult (Node.List, Instance.Instance) |
|
| 335 |
-> OpResult (Node.List, Instance.Instance, [Node.Node])
|
|
| 339 | 336 |
allocateOnSingle nl inst p = |
| 340 | 337 |
let new_pdx = Node.idx p |
| 341 | 338 |
new_inst = Instance.setBoth inst new_pdx Node.noSecondary |
| 342 | 339 |
new_nl = Node.addPri p inst >>= \new_p -> |
| 343 |
return (Container.add new_pdx new_p nl, new_inst) |
|
| 340 |
return (Container.add new_pdx new_p nl, new_inst, [new_p])
|
|
| 344 | 341 |
in new_nl |
| 345 | 342 |
|
| 346 | 343 |
-- | Tries to allocate an instance on a given pair of nodes. |
| 347 | 344 |
allocateOnPair :: Node.List -> Instance.Instance -> Node.Node -> Node.Node |
| 348 |
-> OpResult (Node.List, Instance.Instance) |
|
| 345 |
-> OpResult (Node.List, Instance.Instance, [Node.Node])
|
|
| 349 | 346 |
allocateOnPair nl inst tgt_p tgt_s = |
| 350 | 347 |
let new_pdx = Node.idx tgt_p |
| 351 | 348 |
new_sdx = Node.idx tgt_s |
| ... | ... | |
| 353 | 350 |
new_p <- Node.addPri tgt_p inst |
| 354 | 351 |
new_s <- Node.addSec tgt_s inst new_pdx |
| 355 | 352 |
let new_inst = Instance.setBoth inst new_pdx new_sdx |
| 356 |
return (Container.addTwo new_pdx new_p new_sdx new_s nl, new_inst) |
|
| 353 |
return (Container.addTwo new_pdx new_p new_sdx new_s nl, new_inst, |
|
| 354 |
[new_p, new_s]) |
|
| 357 | 355 |
in new_nl |
| 358 | 356 |
|
| 359 | 357 |
-- | Tries to perform an instance move and returns the best table |
| ... | ... | |
| 447 | 445 |
let all_nodes = getOnline nl |
| 448 | 446 |
all_pairs = liftM2 (,) all_nodes all_nodes |
| 449 | 447 |
ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs |
| 450 |
sols = map (\(p, s) -> do |
|
| 451 |
(mnl, i) <- allocateOnPair nl inst p s |
|
| 452 |
return (mnl, i, [p, s])) |
|
| 453 |
ok_pairs |
|
| 448 |
sols = map (uncurry $ allocateOnPair nl inst) ok_pairs |
|
| 454 | 449 |
in return sols |
| 455 | 450 |
|
| 456 | 451 |
tryAlloc nl _ inst 1 = |
| 457 | 452 |
let all_nodes = getOnline nl |
| 458 |
sols = map (\p -> do |
|
| 459 |
(mnl, i) <- allocateOnSingle nl inst p |
|
| 460 |
return (mnl, i, [p])) |
|
| 461 |
all_nodes |
|
| 453 |
sols = map (allocateOnSingle nl inst) all_nodes |
|
| 462 | 454 |
in return sols |
| 463 | 455 |
|
| 464 | 456 |
tryAlloc _ _ _ reqn = fail $ "Unsupported number of alllocation \ |
Also available in: Unified diff