Revision 23f9ab76
| b/Ganeti/HTools/Cluster.hs | ||
|---|---|---|
| 73 | 73 |
-- * Types |
| 74 | 74 |
|
| 75 | 75 |
-- | Allocation\/relocation solution. |
| 76 |
type AllocSolution = ([FailMode], Int, Maybe (Score, AllocElement))
|
|
| 76 |
type AllocSolution = ([FailMode], Int, [(Score, AllocElement)])
|
|
| 77 | 77 |
|
| 78 | 78 |
-- | Allocation\/relocation element. |
| 79 | 79 |
type AllocElement = (Node.List, Instance.Instance, [Node.Node]) |
| ... | ... | |
| 499 | 499 |
let nscore = compCV nl |
| 500 | 500 |
-- Choose the old or new solution, based on the cluster score |
| 501 | 501 |
nsols = case osols of |
| 502 |
Nothing -> Just (nscore, ns)
|
|
| 503 |
Just (oscore, _) ->
|
|
| 502 |
[] -> [(nscore, ns)]
|
|
| 503 |
(oscore, _):[] ->
|
|
| 504 | 504 |
if oscore < nscore |
| 505 | 505 |
then osols |
| 506 |
else Just (nscore, ns) |
|
| 506 |
else [(nscore, ns)] |
|
| 507 |
-- FIXME: here we simply concat to lists with more |
|
| 508 |
-- than one element; we should instead abort, since |
|
| 509 |
-- this is not a valid usage of this function |
|
| 510 |
xs -> (nscore, ns):xs |
|
| 507 | 511 |
nsuc = cntok + 1 |
| 508 | 512 |
-- Note: we force evaluation of nsols here in order to keep the |
| 509 | 513 |
-- memory profile low - we know that we will need nsols for sure |
| ... | ... | |
| 525 | 529 |
ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs |
| 526 | 530 |
sols = foldl' (\cstate (p, s) -> |
| 527 | 531 |
concatAllocs cstate $ allocateOnPair nl inst p s |
| 528 |
) ([], 0, Nothing) ok_pairs
|
|
| 532 |
) ([], 0, []) ok_pairs
|
|
| 529 | 533 |
in return sols |
| 530 | 534 |
|
| 531 | 535 |
tryAlloc nl _ inst 1 = |
| 532 | 536 |
let all_nodes = getOnline nl |
| 533 | 537 |
sols = foldl' (\cstate -> |
| 534 | 538 |
concatAllocs cstate . allocateOnSingle nl inst |
| 535 |
) ([], 0, Nothing) all_nodes
|
|
| 539 |
) ([], 0, []) all_nodes
|
|
| 536 | 540 |
in return sols |
| 537 | 541 |
|
| 538 | 542 |
tryAlloc _ _ _ reqn = fail $ "Unsupported number of allocation \ |
| ... | ... | |
| 559 | 563 |
applyMove nl inst (ReplaceSecondary x) |
| 560 | 564 |
return (mnl, i, [Container.find x mnl]) |
| 561 | 565 |
in concatAllocs cstate em |
| 562 |
) ([], 0, Nothing) valid_idxes
|
|
| 566 |
) ([], 0, []) valid_idxes
|
|
| 563 | 567 |
in return sols1 |
| 564 | 568 |
|
| 565 | 569 |
tryReloc _ _ _ reqn _ = fail $ "Unsupported number of relocation \ |
| b/hail.hs | ||
|---|---|---|
| 50 | 50 |
processResults :: (Monad m) => Cluster.AllocSolution -> m (String, [Node.Node]) |
| 51 | 51 |
processResults (fstats, successes, sols) = |
| 52 | 52 |
case sols of |
| 53 |
Nothing -> fail "No valid allocation solutions"
|
|
| 54 |
Just (best, (_, _, w)) ->
|
|
| 53 |
[] -> fail "No valid allocation solutions"
|
|
| 54 |
(best, (_, _, w)):[] ->
|
|
| 55 | 55 |
let tfails = length fstats |
| 56 | 56 |
info = printf "successes %d, failures %d,\ |
| 57 | 57 |
\ best score: %.8f for node(s) %s" |
| 58 | 58 |
successes tfails |
| 59 | 59 |
best (intercalate "/" . map Node.name $ w)::String |
| 60 | 60 |
in return (info, w) |
| 61 |
_ -> fail "Internal error: multiple allocation solutions" |
|
| 61 | 62 |
|
| 62 | 63 |
-- | Process a request and return new node lists |
| 63 | 64 |
processRequest :: Request |
| b/hspace.hs | ||
|---|---|---|
| 131 | 131 |
Bad s -> Bad s |
| 132 | 132 |
Ok (errs, _, sols3) -> |
| 133 | 133 |
case sols3 of |
| 134 |
Nothing -> Ok (Cluster.collapseFailures errs, nl, ixes)
|
|
| 135 |
Just (_, (xnl, xi, _)) ->
|
|
| 134 |
[] -> Ok (Cluster.collapseFailures errs, nl, ixes)
|
|
| 135 |
(_, (xnl, xi, _)):[] ->
|
|
| 136 | 136 |
iterateDepth xnl il newinst nreq $! (xi:ixes) |
| 137 |
_ -> Bad "Internal error: multiple solutions for single\ |
|
| 138 |
\ allocation" |
|
| 137 | 139 |
|
| 138 | 140 |
tieredAlloc :: Node.List |
| 139 | 141 |
-> Instance.List |
Also available in: Unified diff